From 77644ee620b6a79cf8c538abaf7cd301a875528d Mon Sep 17 00:00:00 2001 From: markm Date: Sun, 2 May 1999 14:33:17 +0000 Subject: Maintenance releace 3 of perl5.005. Includes support for threads. --- contrib/perl5/Changes | 3444 ++++++++++++++++++++++++- contrib/perl5/Configure | 801 ++++-- contrib/perl5/Copying | 6 +- contrib/perl5/EXTERN.h | 2 +- contrib/perl5/INSTALL | 141 +- contrib/perl5/INTERN.h | 2 +- contrib/perl5/MANIFEST | 56 +- contrib/perl5/Makefile.SH | 87 +- contrib/perl5/Porting/Glossary | 170 +- contrib/perl5/Porting/patching.pod | 54 +- contrib/perl5/Porting/pumpkin.pod | 10 + contrib/perl5/README | 6 +- contrib/perl5/README.threads | 24 +- contrib/perl5/Todo | 5 +- contrib/perl5/Todo-5.005 | 31 +- contrib/perl5/XSUB.h | 70 +- contrib/perl5/XSlock.h | 21 +- contrib/perl5/av.c | 36 +- contrib/perl5/av.h | 2 +- contrib/perl5/bytecode.h | 2 +- contrib/perl5/cc_runtime.h | 2 +- contrib/perl5/config_h.SH | 71 +- contrib/perl5/configure.com | 2 +- contrib/perl5/cop.h | 29 +- contrib/perl5/cv.h | 11 +- contrib/perl5/deb.c | 2 +- contrib/perl5/doio.c | 65 +- contrib/perl5/doop.c | 7 +- contrib/perl5/dump.c | 5 +- contrib/perl5/eg/ADB | 8 + contrib/perl5/eg/README | 22 + contrib/perl5/eg/cgi/RunMeFirst | 36 + contrib/perl5/eg/cgi/caution.xbm | 12 + contrib/perl5/eg/cgi/clickable_image.cgi | 26 + contrib/perl5/eg/cgi/cookie.cgi | 88 + contrib/perl5/eg/cgi/crash.cgi | 6 + contrib/perl5/eg/cgi/customize.cgi | 92 + contrib/perl5/eg/cgi/diff_upload.cgi | 68 + contrib/perl5/eg/cgi/dna.small.gif.uu | 63 + contrib/perl5/eg/cgi/file_upload.cgi | 69 + contrib/perl5/eg/cgi/frameset.cgi | 81 + contrib/perl5/eg/cgi/index.html | 118 + contrib/perl5/eg/cgi/internal_links.cgi | 33 + contrib/perl5/eg/cgi/javascript.cgi | 105 + contrib/perl5/eg/cgi/monty.cgi | 84 + contrib/perl5/eg/cgi/multiple_forms.cgi | 54 + contrib/perl5/eg/cgi/nph-clock.cgi | 18 + contrib/perl5/eg/cgi/nph-multipart.cgi | 10 + contrib/perl5/eg/cgi/popup.cgi | 32 + contrib/perl5/eg/cgi/save_state.cgi | 67 + contrib/perl5/eg/cgi/tryit.cgi | 37 + contrib/perl5/eg/cgi/wilogo.gif.uu | 13 + contrib/perl5/eg/changes | 34 + contrib/perl5/eg/client | 34 + contrib/perl5/eg/down | 30 + contrib/perl5/eg/dus | 22 + contrib/perl5/eg/findcp | 53 + contrib/perl5/eg/findtar | 17 + contrib/perl5/eg/g/gcp | 114 + contrib/perl5/eg/g/gcp.man | 77 + contrib/perl5/eg/g/ged | 21 + contrib/perl5/eg/g/ghosts | 33 + contrib/perl5/eg/g/gsh | 117 + contrib/perl5/eg/g/gsh.man | 80 + contrib/perl5/eg/muck | 141 + contrib/perl5/eg/muck.man | 21 + contrib/perl5/eg/myrup | 29 + contrib/perl5/eg/nih | 11 + contrib/perl5/eg/relink | 82 + contrib/perl5/eg/rename | 74 + contrib/perl5/eg/rmfrom | 7 + contrib/perl5/eg/scan/scan_df | 51 + contrib/perl5/eg/scan/scan_last | 57 + contrib/perl5/eg/scan/scan_messages | 222 ++ contrib/perl5/eg/scan/scan_passwd | 30 + contrib/perl5/eg/scan/scan_ps | 32 + contrib/perl5/eg/scan/scan_sudo | 54 + contrib/perl5/eg/scan/scan_suid | 84 + contrib/perl5/eg/scan/scanner | 87 + contrib/perl5/eg/server | 27 + contrib/perl5/eg/shmkill | 24 + contrib/perl5/eg/sysvipc/README | 9 + contrib/perl5/eg/sysvipc/ipcmsg | 47 + contrib/perl5/eg/sysvipc/ipcsem | 46 + contrib/perl5/eg/sysvipc/ipcshm | 50 + contrib/perl5/eg/travesty | 46 + contrib/perl5/eg/unuc | 186 ++ contrib/perl5/eg/uudecode | 15 + contrib/perl5/eg/van/empty | 45 + contrib/perl5/eg/van/unvanish | 66 + contrib/perl5/eg/van/vanexp | 21 + contrib/perl5/eg/van/vanish | 65 + contrib/perl5/eg/who | 13 + contrib/perl5/eg/wrapsuid | 104 + contrib/perl5/embed.h | 3 + contrib/perl5/embed.pl | 14 +- contrib/perl5/embedvar.h | 4 + contrib/perl5/ext/B/B.pm | 10 +- contrib/perl5/ext/B/B.xs | 14 +- contrib/perl5/ext/B/B/Assembler.pm | 4 +- contrib/perl5/ext/B/B/C.pm | 81 +- contrib/perl5/ext/B/B/CC.pm | 27 +- contrib/perl5/ext/B/B/Disassembler.pm | 2 +- contrib/perl5/ext/B/Makefile.PL | 2 +- contrib/perl5/ext/B/README | 4 +- contrib/perl5/ext/DB_File/Changes | 29 + contrib/perl5/ext/DB_File/DB_File.pm | 168 +- contrib/perl5/ext/DB_File/DB_File.xs | 128 +- contrib/perl5/ext/DB_File/Makefile.PL | 2 +- contrib/perl5/ext/DB_File/dbinfo | 2 +- contrib/perl5/ext/DB_File/hints/dynixptx.pl | 3 + contrib/perl5/ext/DB_File/typemap | 6 +- contrib/perl5/ext/Data/Dumper/Changes | 18 + contrib/perl5/ext/Data/Dumper/Dumper.pm | 171 +- contrib/perl5/ext/Data/Dumper/Dumper.xs | 253 +- contrib/perl5/ext/Data/Dumper/Makefile.PL | 2 +- contrib/perl5/ext/Data/Dumper/Todo | 2 + contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL | 3 +- contrib/perl5/ext/DynaLoader/Makefile.PL | 2 +- contrib/perl5/ext/DynaLoader/dl_beos.xs | 115 + contrib/perl5/ext/DynaLoader/dl_cygwin32.xs | 10 +- contrib/perl5/ext/DynaLoader/dl_mpeix.xs | 11 +- contrib/perl5/ext/DynaLoader/dl_next.xs | 3 +- contrib/perl5/ext/DynaLoader/dl_vms.xs | 2 +- contrib/perl5/ext/Errno/Errno_pm.PL | 66 +- contrib/perl5/ext/Errno/Makefile.PL | 3 +- contrib/perl5/ext/Fcntl/Makefile.PL | 2 +- contrib/perl5/ext/GDBM_File/Makefile.PL | 2 +- contrib/perl5/ext/GDBM_File/hints/sco.pl | 2 + contrib/perl5/ext/IO/IO.xs | 3 +- contrib/perl5/ext/IO/Makefile.PL | 2 +- contrib/perl5/ext/IO/lib/IO/Pipe.pm | 10 +- contrib/perl5/ext/IO/lib/IO/Seekable.pm | 2 +- contrib/perl5/ext/IO/lib/IO/Socket.pm | 2 +- contrib/perl5/ext/IPC/SysV/Makefile.PL | 1 + contrib/perl5/ext/IPC/SysV/Msg.pm | 4 +- contrib/perl5/ext/IPC/SysV/SysV.xs | 54 +- contrib/perl5/ext/NDBM_File/Makefile.PL | 2 +- contrib/perl5/ext/ODBM_File/Makefile.PL | 2 +- contrib/perl5/ext/Opcode/Makefile.PL | 2 +- contrib/perl5/ext/Opcode/Opcode.xs | 3 +- contrib/perl5/ext/Opcode/Safe.pm | 4 +- contrib/perl5/ext/Opcode/ops.pm | 2 +- contrib/perl5/ext/POSIX/Makefile.PL | 2 +- contrib/perl5/ext/POSIX/POSIX.pm | 110 +- contrib/perl5/ext/POSIX/POSIX.pod | 7 +- contrib/perl5/ext/POSIX/POSIX.xs | 73 +- contrib/perl5/ext/POSIX/hints/dynixptx.pl | 4 + contrib/perl5/ext/POSIX/hints/mint.pl | 2 + contrib/perl5/ext/SDBM_File/Makefile.PL | 2 +- contrib/perl5/ext/SDBM_File/sdbm/sdbm.c | 1 + contrib/perl5/ext/Socket/Makefile.PL | 2 +- contrib/perl5/ext/Socket/Socket.pm | 20 + contrib/perl5/ext/Socket/Socket.xs | 112 +- contrib/perl5/ext/Thread/Makefile.PL | 2 +- contrib/perl5/ext/Thread/Thread.xs | 37 +- contrib/perl5/ext/Thread/create.t | 11 +- contrib/perl5/ext/attrs/Makefile.PL | 2 +- contrib/perl5/ext/attrs/attrs.xs | 6 +- contrib/perl5/ext/re/Makefile.PL | 2 +- contrib/perl5/ext/re/re.pm | 6 +- contrib/perl5/form.h | 2 +- contrib/perl5/global.sym | 3 + contrib/perl5/gv.c | 25 +- contrib/perl5/gv.h | 2 +- contrib/perl5/handy.h | 2 +- contrib/perl5/hints/aix.sh | 71 +- contrib/perl5/hints/apollo.sh | 8 +- contrib/perl5/hints/beos.sh | 14 +- contrib/perl5/hints/dec_osf.sh | 45 +- contrib/perl5/hints/dos_djgpp.sh | 16 +- contrib/perl5/hints/dynixptx.sh | 49 +- contrib/perl5/hints/freebsd.sh | 132 +- contrib/perl5/hints/gnu.sh | 33 + contrib/perl5/hints/hpux.sh | 86 +- contrib/perl5/hints/irix_4.sh | 11 + contrib/perl5/hints/irix_5.sh | 11 + contrib/perl5/hints/irix_6.sh | 115 +- contrib/perl5/hints/irix_6_0.sh | 15 +- contrib/perl5/hints/irix_6_1.sh | 16 +- contrib/perl5/hints/linux.sh | 59 +- contrib/perl5/hints/mint.sh | 94 + contrib/perl5/hints/mpeix.sh | 4 +- contrib/perl5/hints/netbsd.sh | 71 +- contrib/perl5/hints/next_3.sh | 10 + contrib/perl5/hints/next_4.sh | 17 +- contrib/perl5/hints/openbsd.sh | 10 + contrib/perl5/hints/os2.sh | 29 +- contrib/perl5/hints/os390.sh | 5 + contrib/perl5/hints/sco.sh | 279 +- contrib/perl5/hints/solaris_2.sh | 53 +- contrib/perl5/hints/ultrix_4.sh | 8 +- contrib/perl5/hints/uwin.sh | 36 + contrib/perl5/hv.c | 35 +- contrib/perl5/hv.h | 2 +- contrib/perl5/installman | 2 +- contrib/perl5/installperl | 12 +- contrib/perl5/intrpvar.h | 1 + contrib/perl5/iperlsys.h | 7 +- contrib/perl5/lib/AutoLoader.pm | 4 +- contrib/perl5/lib/AutoSplit.pm | 4 +- contrib/perl5/lib/Benchmark.pm | 14 + contrib/perl5/lib/CGI.pm | 411 +-- contrib/perl5/lib/CGI/Apache.pm | 2 +- contrib/perl5/lib/CGI/Carp.pm | 64 +- contrib/perl5/lib/CGI/Cookie.pm | 15 +- contrib/perl5/lib/CGI/Fast.pm | 21 +- contrib/perl5/lib/CGI/Push.pm | 18 +- contrib/perl5/lib/CPAN.pm | 1179 ++++++--- contrib/perl5/lib/CPAN/FirstTime.pm | 315 ++- contrib/perl5/lib/CPAN/Nox.pm | 3 + contrib/perl5/lib/Carp.pm | 10 +- contrib/perl5/lib/Cwd.pm | 4 +- contrib/perl5/lib/Dumpvalue.pm | 600 +++++ contrib/perl5/lib/English.pm | 9 + contrib/perl5/lib/ExtUtils/Command.pm | 4 +- contrib/perl5/lib/ExtUtils/Embed.pm | 2 +- contrib/perl5/lib/ExtUtils/Install.pm | 2 +- contrib/perl5/lib/ExtUtils/Liblist.pm | 20 +- contrib/perl5/lib/ExtUtils/MM_OS2.pm | 33 + contrib/perl5/lib/ExtUtils/MM_Unix.pm | 73 +- contrib/perl5/lib/ExtUtils/MM_VMS.pm | 110 +- contrib/perl5/lib/ExtUtils/MM_Win32.pm | 31 +- contrib/perl5/lib/ExtUtils/MakeMaker.pm | 203 +- contrib/perl5/lib/ExtUtils/Manifest.pm | 4 +- contrib/perl5/lib/ExtUtils/Mkbootstrap.pm | 4 +- contrib/perl5/lib/ExtUtils/Mksymlists.pm | 50 +- contrib/perl5/lib/ExtUtils/typemap | 30 +- contrib/perl5/lib/ExtUtils/xsubpp | 35 +- contrib/perl5/lib/Fatal.pm | 12 +- contrib/perl5/lib/File/Copy.pm | 6 +- contrib/perl5/lib/File/Find.pm | 12 +- contrib/perl5/lib/File/Path.pm | 7 +- contrib/perl5/lib/File/Spec.pm | 4 +- contrib/perl5/lib/File/Spec/Mac.pm | 4 +- contrib/perl5/lib/FindBin.pm | 47 +- contrib/perl5/lib/Getopt/Long.pm | 11 +- contrib/perl5/lib/Getopt/Std.pm | 5 +- contrib/perl5/lib/IPC/Open3.pm | 53 +- contrib/perl5/lib/Math/BigFloat.pm | 2 +- contrib/perl5/lib/Math/BigInt.pm | 8 +- contrib/perl5/lib/Math/Complex.pm | 37 +- contrib/perl5/lib/Math/Trig.pm | 24 +- contrib/perl5/lib/Net/hostent.pm | 2 +- contrib/perl5/lib/Net/netent.pm | 2 +- contrib/perl5/lib/Pod/Html.pm | 34 +- contrib/perl5/lib/Pod/Text.pm | 8 +- contrib/perl5/lib/SelfLoader.pm | 4 +- contrib/perl5/lib/Symbol.pm | 2 +- contrib/perl5/lib/Term/Complete.pm | 24 +- contrib/perl5/lib/Term/ReadLine.pm | 2 +- contrib/perl5/lib/Test.pm | 142 +- contrib/perl5/lib/Test/Harness.pm | 15 +- contrib/perl5/lib/Text/ParseWords.pm | 2 +- contrib/perl5/lib/Text/Wrap.pm | 121 +- contrib/perl5/lib/Tie/Array.pm | 12 +- contrib/perl5/lib/Tie/Hash.pm | 2 +- contrib/perl5/lib/Tie/SubstrHash.pm | 2 +- contrib/perl5/lib/Time/Local.pm | 22 +- contrib/perl5/lib/Time/gmtime.pm | 2 +- contrib/perl5/lib/Time/localtime.pm | 2 +- contrib/perl5/lib/User/grent.pm | 2 +- contrib/perl5/lib/User/pwent.pm | 2 +- contrib/perl5/lib/constant.pm | 14 + contrib/perl5/lib/diagnostics.pm | 2 +- contrib/perl5/lib/fields.pm | 4 +- contrib/perl5/lib/overload.pm | 31 +- contrib/perl5/lib/perl5db.pl | 74 +- contrib/perl5/makedepend.SH | 12 +- contrib/perl5/malloc.c | 34 +- contrib/perl5/mg.c | 98 +- contrib/perl5/mg.h | 7 +- contrib/perl5/miniperlmain.c | 6 + contrib/perl5/objXSUB.h | 14 +- contrib/perl5/objpp.h | 10 + contrib/perl5/op.c | 290 ++- contrib/perl5/op.h | 2 +- contrib/perl5/opcode.h | 6 +- contrib/perl5/opcode.pl | 6 +- contrib/perl5/patchlevel.h | 2 +- contrib/perl5/perl.c | 116 +- contrib/perl5/perl.h | 152 +- contrib/perl5/perl_exp.SH | 27 +- contrib/perl5/perlio.c | 166 +- contrib/perl5/perlvars.h | 5 +- contrib/perl5/perly.c | 22 +- contrib/perl5/perly.y | 10 +- contrib/perl5/perly_c.diff | 104 +- contrib/perl5/pod/Makefile | 21 + contrib/perl5/pod/buildtoc | 6 +- contrib/perl5/pod/perl.pod | 99 +- contrib/perl5/pod/perl5004delta.pod | 2 +- contrib/perl5/pod/perlcall.pod | 18 +- contrib/perl5/pod/perldata.pod | 4 +- contrib/perl5/pod/perldebug.pod | 8 +- contrib/perl5/pod/perldelta.pod | 122 +- contrib/perl5/pod/perldiag.pod | 74 +- contrib/perl5/pod/perldsc.pod | 2 +- contrib/perl5/pod/perlembed.pod | 30 +- contrib/perl5/pod/perlfaq.pod | 651 ++++- contrib/perl5/pod/perlfaq1.pod | 185 +- contrib/perl5/pod/perlfaq2.pod | 200 +- contrib/perl5/pod/perlfaq3.pod | 122 +- contrib/perl5/pod/perlfaq4.pod | 466 +++- contrib/perl5/pod/perlfaq5.pod | 177 +- contrib/perl5/pod/perlfaq6.pod | 129 +- contrib/perl5/pod/perlfaq7.pod | 48 +- contrib/perl5/pod/perlfaq8.pod | 65 +- contrib/perl5/pod/perlfaq9.pod | 30 +- contrib/perl5/pod/perlform.pod | 9 + contrib/perl5/pod/perlfunc.pod | 1305 ++++++---- contrib/perl5/pod/perlguts.pod | 183 +- contrib/perl5/pod/perlhist.pod | 29 +- contrib/perl5/pod/perlipc.pod | 77 +- contrib/perl5/pod/perllocale.pod | 61 +- contrib/perl5/pod/perllol.pod | 2 +- contrib/perl5/pod/perlmod.pod | 2 +- contrib/perl5/pod/perlmodinstall.pod | 30 +- contrib/perl5/pod/perlmodlib.pod | 175 +- contrib/perl5/pod/perlobj.pod | 19 +- contrib/perl5/pod/perlop.pod | 276 +- contrib/perl5/pod/perlopentut.pod | 862 +++++++ contrib/perl5/pod/perlpod.pod | 5 +- contrib/perl5/pod/perlport.pod | 292 ++- contrib/perl5/pod/perlre.pod | 19 +- contrib/perl5/pod/perlref.pod | 14 +- contrib/perl5/pod/perlreftut.pod | 416 +++ contrib/perl5/pod/perlrun.pod | 20 +- contrib/perl5/pod/perlstyle.pod | 2 +- contrib/perl5/pod/perlsub.pod | 35 +- contrib/perl5/pod/perlsyn.pod | 14 +- contrib/perl5/pod/perlthrtut.pod | 1063 ++++++++ contrib/perl5/pod/perltie.pod | 11 +- contrib/perl5/pod/perltoc.pod | 5 +- contrib/perl5/pod/perlvar.pod | 96 +- contrib/perl5/pod/perlxs.pod | 22 +- contrib/perl5/pod/perlxstut.pod | 2 +- contrib/perl5/pod/pod2html.PL | 2 +- contrib/perl5/pod/pod2man.PL | 9 +- contrib/perl5/pod/roffitall | 4 + contrib/perl5/pp.c | 172 +- contrib/perl5/pp.h | 8 +- contrib/perl5/pp_ctl.c | 239 +- contrib/perl5/pp_hot.c | 83 +- contrib/perl5/pp_sys.c | 282 +- contrib/perl5/proto.h | 21 +- contrib/perl5/regcomp.c | 49 +- contrib/perl5/regexec.c | 22 +- contrib/perl5/run.c | 5 +- contrib/perl5/scope.c | 36 +- contrib/perl5/scope.h | 5 +- contrib/perl5/sv.c | 155 +- contrib/perl5/sv.h | 5 +- contrib/perl5/t/base/lex.t | 31 +- contrib/perl5/t/cmd/for.t | 14 +- contrib/perl5/t/cmd/while.t | 21 +- contrib/perl5/t/comp/package.t | 16 +- contrib/perl5/t/comp/proto.t | 12 +- contrib/perl5/t/comp/require.t | 6 +- contrib/perl5/t/io/argv.t | 21 +- contrib/perl5/t/io/fs.t | 28 +- contrib/perl5/t/lib/cgi-html.t | 7 +- contrib/perl5/t/lib/complex.t | 18 +- contrib/perl5/t/lib/db-recno.t | 10 +- contrib/perl5/t/lib/dumper.t | 207 +- contrib/perl5/t/lib/fatal.t | 27 + contrib/perl5/t/lib/h2ph.pht | 4 +- contrib/perl5/t/lib/io_udp.t | 2 +- contrib/perl5/t/lib/parsewords.t | 7 +- contrib/perl5/t/lib/posix.t | 2 +- contrib/perl5/t/lib/safe2.t | 12 +- contrib/perl5/t/lib/searchdict.t | 38 +- contrib/perl5/t/lib/textfill.t | 96 + contrib/perl5/t/lib/textwrap.t | 136 +- contrib/perl5/t/lib/thread.t | 2 +- contrib/perl5/t/op/array.t | 7 +- contrib/perl5/t/op/die_exit.t | 6 +- contrib/perl5/t/op/eval.t | 98 +- contrib/perl5/t/op/goto.t | 23 +- contrib/perl5/t/op/grep.t | 31 + contrib/perl5/t/op/local.t | 43 +- contrib/perl5/t/op/misc.t | 30 +- contrib/perl5/t/op/mkdir.t | 2 +- contrib/perl5/t/op/oct.t | 5 +- contrib/perl5/t/op/pack.t | 168 +- contrib/perl5/t/op/pat.t | 7 +- contrib/perl5/t/op/range.t | 11 +- contrib/perl5/t/op/re_tests | 6 + contrib/perl5/t/op/repeat.t | 53 +- contrib/perl5/t/op/runlevel.t | 20 + contrib/perl5/t/op/sort.t | 36 +- contrib/perl5/t/op/sysio.t | 40 +- contrib/perl5/t/op/taint.t | 5 +- contrib/perl5/t/op/tie.t | 13 + contrib/perl5/t/op/tiehandle.t | 18 +- contrib/perl5/t/op/tr.t | 33 + contrib/perl5/t/op/undef.t | 11 +- contrib/perl5/t/op/write.t | 25 +- contrib/perl5/t/pragma/constant.t | 18 +- contrib/perl5/t/pragma/locale.t | 6 +- contrib/perl5/t/pragma/overload.t | 14 +- contrib/perl5/t/pragma/subs.t | 4 +- contrib/perl5/t/pragma/warn-1global | 8 + contrib/perl5/t/pragma/warning.t | 25 +- contrib/perl5/taint.c | 12 +- contrib/perl5/thread.h | 106 +- contrib/perl5/toke.c | 142 +- contrib/perl5/universal.c | 15 +- contrib/perl5/unixish.h | 2 +- contrib/perl5/util.c | 279 +- contrib/perl5/util.h | 2 +- contrib/perl5/utils/h2ph.PL | 102 +- contrib/perl5/utils/h2xs.PL | 16 +- contrib/perl5/utils/perlbug.PL | 34 +- contrib/perl5/utils/perldoc.PL | 13 +- contrib/perl5/x2p/Makefile.SH | 6 +- contrib/perl5/x2p/s2p.PL | 4 +- contrib/perl5/x2p/walk.c | 4 +- 418 files changed, 22733 insertions(+), 4951 deletions(-) create mode 100644 contrib/perl5/eg/ADB create mode 100644 contrib/perl5/eg/README create mode 100755 contrib/perl5/eg/cgi/RunMeFirst create mode 100644 contrib/perl5/eg/cgi/caution.xbm create mode 100644 contrib/perl5/eg/cgi/clickable_image.cgi create mode 100644 contrib/perl5/eg/cgi/cookie.cgi create mode 100644 contrib/perl5/eg/cgi/crash.cgi create mode 100644 contrib/perl5/eg/cgi/customize.cgi create mode 100644 contrib/perl5/eg/cgi/diff_upload.cgi create mode 100644 contrib/perl5/eg/cgi/dna.small.gif.uu create mode 100644 contrib/perl5/eg/cgi/file_upload.cgi create mode 100644 contrib/perl5/eg/cgi/frameset.cgi create mode 100644 contrib/perl5/eg/cgi/index.html create mode 100644 contrib/perl5/eg/cgi/internal_links.cgi create mode 100644 contrib/perl5/eg/cgi/javascript.cgi create mode 100644 contrib/perl5/eg/cgi/monty.cgi create mode 100644 contrib/perl5/eg/cgi/multiple_forms.cgi create mode 100644 contrib/perl5/eg/cgi/nph-clock.cgi create mode 100755 contrib/perl5/eg/cgi/nph-multipart.cgi create mode 100644 contrib/perl5/eg/cgi/popup.cgi create mode 100644 contrib/perl5/eg/cgi/save_state.cgi create mode 100644 contrib/perl5/eg/cgi/tryit.cgi create mode 100644 contrib/perl5/eg/cgi/wilogo.gif.uu create mode 100644 contrib/perl5/eg/changes create mode 100755 contrib/perl5/eg/client create mode 100755 contrib/perl5/eg/down create mode 100644 contrib/perl5/eg/dus create mode 100644 contrib/perl5/eg/findcp create mode 100644 contrib/perl5/eg/findtar create mode 100644 contrib/perl5/eg/g/gcp create mode 100644 contrib/perl5/eg/g/gcp.man create mode 100644 contrib/perl5/eg/g/ged create mode 100644 contrib/perl5/eg/g/ghosts create mode 100644 contrib/perl5/eg/g/gsh create mode 100644 contrib/perl5/eg/g/gsh.man create mode 100644 contrib/perl5/eg/muck create mode 100644 contrib/perl5/eg/muck.man create mode 100644 contrib/perl5/eg/myrup create mode 100644 contrib/perl5/eg/nih create mode 100644 contrib/perl5/eg/relink create mode 100755 contrib/perl5/eg/rename create mode 100644 contrib/perl5/eg/rmfrom create mode 100644 contrib/perl5/eg/scan/scan_df create mode 100644 contrib/perl5/eg/scan/scan_last create mode 100644 contrib/perl5/eg/scan/scan_messages create mode 100644 contrib/perl5/eg/scan/scan_passwd create mode 100644 contrib/perl5/eg/scan/scan_ps create mode 100644 contrib/perl5/eg/scan/scan_sudo create mode 100644 contrib/perl5/eg/scan/scan_suid create mode 100644 contrib/perl5/eg/scan/scanner create mode 100755 contrib/perl5/eg/server create mode 100644 contrib/perl5/eg/shmkill create mode 100644 contrib/perl5/eg/sysvipc/README create mode 100644 contrib/perl5/eg/sysvipc/ipcmsg create mode 100644 contrib/perl5/eg/sysvipc/ipcsem create mode 100644 contrib/perl5/eg/sysvipc/ipcshm create mode 100644 contrib/perl5/eg/travesty create mode 100755 contrib/perl5/eg/unuc create mode 100644 contrib/perl5/eg/uudecode create mode 100644 contrib/perl5/eg/van/empty create mode 100644 contrib/perl5/eg/van/unvanish create mode 100644 contrib/perl5/eg/van/vanexp create mode 100644 contrib/perl5/eg/van/vanish create mode 100644 contrib/perl5/eg/who create mode 100755 contrib/perl5/eg/wrapsuid create mode 100644 contrib/perl5/ext/DB_File/hints/dynixptx.pl create mode 100644 contrib/perl5/ext/DynaLoader/dl_beos.xs create mode 100644 contrib/perl5/ext/GDBM_File/hints/sco.pl create mode 100644 contrib/perl5/ext/POSIX/hints/dynixptx.pl create mode 100644 contrib/perl5/ext/POSIX/hints/mint.pl create mode 100644 contrib/perl5/hints/gnu.sh create mode 100644 contrib/perl5/hints/mint.sh create mode 100644 contrib/perl5/hints/uwin.sh create mode 100644 contrib/perl5/lib/Dumpvalue.pm create mode 100644 contrib/perl5/pod/perlopentut.pod create mode 100644 contrib/perl5/pod/perlreftut.pod create mode 100644 contrib/perl5/pod/perlthrtut.pod create mode 100755 contrib/perl5/t/lib/fatal.t create mode 100755 contrib/perl5/t/lib/textfill.t create mode 100755 contrib/perl5/t/op/grep.t create mode 100755 contrib/perl5/t/op/tr.t (limited to 'contrib/perl5') diff --git a/contrib/perl5/Changes b/contrib/perl5/Changes index 325ffeb..00a38d5 100644 --- a/contrib/perl5/Changes +++ b/contrib/perl5/Changes @@ -20,7 +20,6 @@ current addresses (as of July 1998): Abigail Kenneth Albanowski Russ Allbery - Graham Barr Spider Boardman Tom Christiansen Hallvard B Furuseth @@ -50,10 +49,11 @@ current addresses (as of July 1998): And the Keepers of the Patch Pumpkin: Charles Bailey + Graham Barr Malcolm Beattie Tim Bunce Andy Dougherty - Gurusamy Sarathy + Gurusamy Sarathy Chip Salzenberg And, of course, the Author of Perl: @@ -74,6 +74,3446 @@ indicator: ---------------- +Version 5.005_03 Third maintenance release of 5.005 +---------------- + +____________________________________________________________________________ +[ 3198] By: gbarr on 1999/03/28 22:21:49 + Log: redo #3193 which #3195 undid + Branch: maint-5.005/perl + ! pod/perlhist.pod +____________________________________________________________________________ +[ 3197] By: gbarr on 1999/03/28 21:04:04 + Log: Updated CPAN.pm to 1.48 + Branch: maint-5.005/perl + ! lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm +____________________________________________________________________________ +[ 3196] By: gbarr on 1999/03/28 17:21:27 + Log: AIX hints update from Jarkko + Branch: maint-5.005/perl + ! hints/aix.sh +____________________________________________________________________________ +[ 3195] By: jhi on 1999/03/28 16:42:54 + Log: Update perlhist on 5_03. + Branch: maint-5.005/perl + ! pod/perlhist.pod +____________________________________________________________________________ +[ 3193] By: gsar on 1999/03/28 09:46:29 + Log: =end needs matching =begin (or installhtml will croak) + Branch: maint-5.005/perl + ! pod/perlhist.pod +____________________________________________________________________________ +[ 3192] By: gsar on 1999/03/28 09:10:15 + Log: update pod/Makefile + Branch: maint-5.005/perl + ! pod/Makefile +____________________________________________________________________________ +[ 3191] By: gsar on 1999/03/28 08:43:47 + Log: integrate change#3180 from mainline + + fix bogus OPf_REF context for the BLOCK in C + (sometimes caused bizarreness in the BLOCK) + Branch: maint-5.005/perl + +> t/op/grep.t + !> MANIFEST op.c +____________________________________________________________________________ +[ 3190] By: gsar on 1999/03/28 08:29:51 + Log: integrate change#3147 from mainline + + warn about newfangled vfork() caveats + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 3189] By: gsar on 1999/03/28 08:22:00 + Log: various pod niggles + Branch: maint-5.005/perl + ! pod/perl.pod pod/perldebug.pod pod/perldiag.pod + ! pod/perlfunc.pod pod/perlhist.pod +____________________________________________________________________________ +[ 3188] By: gsar on 1999/03/28 07:37:43 + Log: integrate binary compatible variant of change#3098 from mainline + Branch: maint-5.005/perl + ! op.c perl.h t/base/lex.t toke.c +____________________________________________________________________________ +[ 3187] By: gsar on 1999/03/28 07:31:16 + Log: regularize CAPI declarations (CAPI extensions now build under + the Borland compiler) + Branch: maint-5.005/perl + ! win32/GenCAPI.pl +____________________________________________________________________________ +[ 3186] By: gsar on 1999/03/28 07:26:33 + Log: ensure XS_LOCKS stuff happens *before* XSUB is entered under + -DPERL_CAPI + Branch: maint-5.005/perl + ! XSlock.h win32/GenCAPI.pl win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 3185] By: gbarr on 1999/03/28 06:37:41 + Log: integrate change #2846 from mainline + + a modified version of suggested patch for pack template 'Z'; added docs + From: "Valeriy E. Ushakov" + Date: Mon, 16 Jun 1997 03:00:31 +0400 (MSD) + Message-ID: <%lOHpzIuGV@snark.ptc.spbu.ru> + Subject: lack of pack/unpack letter with useful symmetry for C null delimited strings + Branch: maint-5.005/perl + ! pod/perldelta.pod pod/perlfunc.pod pp.c + !> t/op/pack.t +____________________________________________________________________________ +[ 3184] By: gbarr on 1999/03/28 06:35:50 + Log: integrate change # 3160 from mainline + + better description of OP_UNSTACK (s/unstack/iteration finalizer/) + Branch: maint-5.005/perl + ! opcode.h opcode.pl +____________________________________________________________________________ +[ 3182] By: gbarr on 1999/03/28 03:40:28 + Log: Integrate changes #3067 and #3106 from mainline + + exempt $foo::a,$foo::b from warnings only if sort() was seen in package foo + From: Graham Barr + Date: Wed, 3 Mar 1999 17:23:56 -0600 + Message-ID: <19990303172356.F7442@dal.asp.ti.com> + Subject: Re: 'use strict' doesn't work for one-letter variables + + change#3067 failed package.t due to needless creation of $a and $b; + fixed to do that only for C, not C + Branch: maint-5.005/perl + ! gv.c op.c t/pragma/warn-1global +____________________________________________________________________________ +[ 3179] By: gsar on 1999/03/28 02:14:04 + Log: fix thread segfault when passing large number of arguments to child + a la Cnew($foo, 1..1000)> + Branch: maint-5.005/perl + ! ext/Thread/Thread.xs t/lib/thread.t +____________________________________________________________________________ +[ 3178] By: gbarr on 1999/03/28 01:39:23 + Log: fix $Config{'usethreads'} typo in perlthrtut + + From: Ian Maloney + Date: Thu, 25 Mar 1999 16:40:14 +0100 (MET) + Message-Id: <199903251540.QAA02439@wsblob.> + Subject: perlthrtut documentation error + Branch: maint-5.005/perl + ! pod/perlthrtut.pod +____________________________________________________________________________ +[ 3177] By: gbarr on 1999/03/28 01:09:59 + Log: Integrate #2910 from mainline + + slurping an empty file should return '' rather than undef, with + commensurate effects on ARGV processing + Branch: maint-5.005/perl + ! pod/perldelta.pod pp_hot.c sv.h + !> t/io/argv.t +____________________________________________________________________________ +[ 3176] By: gbarr on 1999/03/28 00:00:30 + Log: Integrate relevant doc changes from mainline + Branch: maint-5.005/perl + !> (integrate 34 files) +____________________________________________________________________________ +[ 3175] By: gbarr on 1999/03/27 19:20:32 + Log: Integrated #2352 and #2397 from mainline + + Implement $^C to allow perl access to -c flag - I think this + was agreed once... + + Update docs and English.pm for $^C + Branch: maint-5.005/perl + ! gv.c mg.c + !> lib/English.pm +____________________________________________________________________________ +[ 3174] By: gbarr on 1999/03/27 18:21:01 + Log: Update Copyright year + Branch: maint-5.005/perl + ! EXTERN.h INTERN.h README av.c av.h cop.h cv.h deb.c doio.c + ! doop.c dump.c form.h gv.c gv.h handy.h hv.c hv.h mg.c mg.h + ! op.c op.h perl.h perly.y pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c + ! regcomp.c regexec.c run.c scope.c sv.c sv.h toke.c util.c + ! util.h +____________________________________________________________________________ +[ 3173] By: gbarr on 1999/03/27 18:19:47 + Log: Update Test.pm to VERSION 1.122 from CPAN + Branch: maint-5.005/perl + ! lib/Test.pm +____________________________________________________________________________ +[ 3154] By: jhi on 1999/03/24 21:40:51 + Log: Reword the shared library search path (LD_LIBRARY_PATH) info + based on suggestions from Andy Dougherty. + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 3146] By: jhi on 1999/03/24 09:20:14 + Log: Bring in changes #2808 and #2812 (from mainline perl) + that enhance the perlbug checklist. + Branch: maint-5.005/perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 3130] By: jhi on 1999/03/23 22:02:23 + Log: Don't use config.msg to remind about the + LD_LIBRARY_PATH because Makefile.SH takes + care of that. + + Use shrplib in DEC O^W^Digital U^W^WTru64 UNIX. + This used to be the default but in some MT or another it + was dropped because of some transient error or another. + Branch: maint-5.005/perl + ! Configure hints/dec_osf.sh +____________________________________________________________________________ +[ 3122] By: jhi on 1999/03/19 21:12:14 + Log: Describe the new Benchmark feature in more detail. + Branch: cfgperl + ! pod/perldelta.pod + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 3121] By: jhi on 1999/03/19 08:16:12 + Log: AVAILABILITY tuning. + Branch: cfgperl + ! pod/perl.pod + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 3119] By: jhi on 1999/03/17 14:33:43 + Log: More Apollo fixes. + Branch: maint-5.005/perl + ! README.apollo hints/apollo.sh t/lib/io_udp.t +____________________________________________________________________________ +[ 3118] By: jhi on 1999/03/16 17:23:39 + Log: Nada. + Branch: maint-5.005/perl + ! README.apollo +____________________________________________________________________________ +[ 3117] By: jhi on 1999/03/16 17:18:49 + Log: Apollo DomainOS AVAILABILITY. + Branch: cfgperl + ! pod/perl.pod + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 3116] By: jhi on 1999/03/16 17:14:00 + Log: Apollo DomainOS patch + From: Johann Klasek + Subject: Re: DomainPerl + Date: Tue, 16 Mar 1999 17:46:32 +0100 + Message-ID: <19990316174632.A19759@euklid.auto.tuwien.ac.at> + Branch: maint-5.005/perl + + README.apollo apollo/netinet/in.h + ! MANIFEST hints/apollo.sh +____________________________________________________________________________ +[ 3115] By: jhi on 1999/03/16 14:23:54 + Log: From: Paul Marquess + To: Gurusamy Sarathy , + Graham Barr + Cc: Perl5 Porters , + "Paul.Marquess" + Subject: [PATCH 5.005_56 & 5.005_03_T6] Upgrade DB_File to version 1.65 + Date: Sun, 14 Mar 1999 14:43:57 -0000 + Message-Id: <199903141841.NAA17040@defender.perl.org> + Branch: maint-5.005/perl + ! ext/DB_File/Changes ext/DB_File/DB_File.pm + ! ext/DB_File/DB_File.xs ext/DB_File/typemap +____________________________________________________________________________ +[ 3114] By: jhi on 1999/03/16 12:42:20 + Log: Mention Rhapsody in 5.005_5X perldelta, + and in Rhapsody and Netware in 5.005_0X and 5.005_5X + *planned* AVAILABILITY. + Branch: cfgperl + ! pod/perl.pod pod/perldelta.pod + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 3113] By: jhi on 1999/03/16 10:38:53 + Log: perldelta niggling. + Branch: cfgperl + ! pod/perldelta.pod + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 3111] By: jhi on 1999/03/16 10:28:10 + Log: AVAILABILITY update: still mention PowerUX, + Novell Netware now has sources available. + Branch: cfgperl + ! pod/perl.pod + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 3105] By: jhi on 1999/03/12 15:54:57 + Log: Recognize the NetBSD packages collection. + Branch: maint-5.005/perl + ! hints/netbsd.sh +____________________________________________________________________________ +[ 3104] By: jhi on 1999/03/12 09:07:04 + Log: From: pvhp@forte.com (Peter Prymmer) + To: jhi@iki.fi, perl-mvs@perl.org, perlbug@perl.com + Subject: [PATCH MT6,_56] was Re: Not OK: perl 5.00503 +MAINT_TRIAL_6 on os390 06.00 (UNINSTALLED) + Date: Thu, 11 Mar 99 14:24:54 PST + Message-Id: <9903112224.AA24346@forte.com> + Branch: maint-5.005/perl + ! README.os390 t/lib/posix.t +____________________________________________________________________________ +[ 3102] By: jhi on 1999/03/10 11:01:20 + Log: From: pvhp@forte.com (Peter Prymmer) + To: perl5-porters@perl.org + Subject: [5.005_03-MT6]Patch: time passes + Date: Tue, 9 Mar 99 18:42:17 PST + Message-Id: <9903100242.AA29057@forte.com> + Branch: maint-5.005/perl + ! perl.c +____________________________________________________________________________ +[ 3101] By: jhi on 1999/03/10 10:30:15 + Log: From: Mark-Jason Dominus + To: perl5-porters@perl.com + Subject: Minor fix to perlfunc.pod + Date: Mon, 08 Mar 1999 20:05:53 -0500 + Message-ID: <19990309010553.13757.qmail@plover.com> + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 3094] By: jhi on 1999/03/06 16:16:15 + Log: From: Mark Kettenis + To: jhi@iki.fi + Subject: Oops + Date: Sat, 6 Mar 1999 17:15:35 +0100 (CET) + Message-Id: <199903061615.RAA00207@delius.kettenis.nl> + Branch: maint-5.005/perl + ! README.hurd +____________________________________________________________________________ +[ 3093] By: jhi on 1999/03/06 15:59:46 + Log: From: Mark Kettenis + To: jhi@iki.fi + Subject: New Hurd README + Date: Sat, 6 Mar 1999 16:46:12 +0100 (CET) + Message-Id: <199903061601.RAA00185@delius.kettenis.nl> + Branch: maint-5.005/perl + ! README.hurd +____________________________________________________________________________ +[ 3092] By: jhi on 1999/03/06 12:52:06 + Log: From: Paul_Green@stratus.com + To: perl5-porters@perl.org + Cc: jhi@iki.fi, Paul_Green@stratus.com + Subject: [PATCH 5.005_03-MAINT_TRIAL_6]: platform: vos -- updates to VOS port of Perl5 + Date: Fri, 5 Mar 1999 18:08:49 -0500 + Message-ID: <1D1A4EF7AD4DD211A80D00A0C9D7DB665A035A@exna1.stratus.com> + Branch: maint-5.005/perl + ! vos/config.h vos/config_h.SH_orig +____________________________________________________________________________ +[ 3091] By: jhi on 1999/03/06 12:42:21 + Log: From: Dan Sugalski + To: perl5-porters@perl.org, vmsperl@perl.org + Subject: [PATCH 5.005_03-MT6]VMS build patch + Date: Fri, 05 Mar 1999 12:36:19 -0800 + Message-Id: <3.0.6.32.19990305123619.02d326a0@ous.edu> + Branch: maint-5.005/perl + ! vms/subconfigure.com +____________________________________________________________________________ +[ 3090] By: gsar on 1999/03/06 04:40:03 + Log: integrate change#3089 from mainline + + tolerate CRs after options + Branch: maint-5.005/perl + !> perl.c +____________________________________________________________________________ +[ 3086] By: gbarr on 1999/03/05 01:48:05 + Log: #3085 was a bit premature, this is MT6 as 2 files were + missing from MANIFEST + Branch: maint-5.005/perl + ! MANIFEST +____________________________________________________________________________ +[ 3085] By: gbarr on 1999/03/05 01:41:06 + Log: Trial release 6 + Branch: maint-5.005/perl + ! Changes +____________________________________________________________________________ +[ 3084] By: gbarr on 1999/03/05 01:34:07 + Log: Don't process - as a file in Errno_pm.PL + + From: Jarkko Hietaniemi + Date: Thu, 4 Mar 1999 13:29:23 +0200 (EET) + Message-ID: <14046.28307.561693.849859@alpha.hut.fi> + Subject: Re: maint-5.005 + Branch: maint-5.005/perl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 3081] By: gsar on 1999/03/05 00:14:33 + Log: protect against doubled backslashes + Branch: maint-5.005/perl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 3080] By: gsar on 1999/03/04 23:37:20 + Log: pick up AIX hints from mainline + Branch: maint-5.005/perl + !> hints/aix.sh +____________________________________________________________________________ +[ 3079] By: gsar on 1999/03/04 21:09:43 + Log: tweak cast and crew + Branch: maint-5.005/perl + ! Changes +____________________________________________________________________________ +[ 3078] By: gsar on 1999/03/04 21:03:04 + Log: update patchlevel, Changes + Branch: maint-5.005/perl + ! Changes README.win32 patchlevel.h + !> pod/perlhist.pod +____________________________________________________________________________ +[ 3075] By: gsar on 1999/03/04 07:36:53 + Log: integrate changes#3037,3041 from mainline + + fix longstanding bug: searches for lexicals originating within eval'' + weren't stopping at the subroutine boundary correctly + -- + fix subtle bug in eval'' testsuite + Branch: maint-5.005/perl + !> op.c proto.h t/op/eval.t +____________________________________________________________________________ +[ 3074] By: gsar on 1999/03/04 07:32:15 + Log: integrate change#3048 from mainline + + updated HP-UX notes from Jeff Okamoto + Branch: maint-5.005/perl + !> MANIFEST README.hpux +____________________________________________________________________________ +[ 3073] By: gsar on 1999/03/04 07:29:43 + Log: integrate changes#3014,3015,3021,3032,3034,3045 from mainline + + more "correct" utbuf for utime() + -- + avoid modifying readonly values from qw() + -- + ansify perlio.c, fix PerlIO-ish typos + -- + add README.hpux + -- + s/print STDERR/warn/ suggested by abigail@fnx.com; add $VERSION + -- + destroy PL_svref_mutex in perl_destruct() + Branch: maint-5.005/perl + +> README.hpux + !> MANIFEST doio.c ext/DynaLoader/dl_beos.xs + !> ext/DynaLoader/dl_cygwin32.xs iperlsys.h + !> lib/ExtUtils/MM_Unix.pm lib/Getopt/Std.pm perl.c perlio.c +____________________________________________________________________________ +[ 3072] By: gsar on 1999/03/04 07:12:15 + Log: integrate changes#2978,2979 from mainline + + bring '*' prototype closer to how it behaves internally + -- + doc for change#2978 + Branch: maint-5.005/perl + +> t/lib/fatal.t + !> MANIFEST lib/Fatal.pm op.c pod/perlsub.pod t/comp/proto.t +____________________________________________________________________________ +[ 3071] By: gsar on 1999/03/04 07:05:50 + Log: integrate changes#2919,2920,2921,2928,2932,2933 from mainline + + applied suggested patch, with several language/readability tweaks + From: Ilya Zakharevich + Date: Fri, 29 Jan 1999 00:25:02 -0500 + Message-ID: <19990129002502.C2898@monk.mps.ohio-state.edu> + Subject: Re: [PATCH 5.005_*] Better parsing docs + -- + tweak READ() docs to mention $buffer must be altered by reference + -- + use New() et al., rather than safemalloc() et al. + From: jan.dubois@ibm.net (Jan Dubois) + Date: Fri, 29 Jan 1999 23:27:22 +0100 + Message-ID: <36bd33f2.51029616@smtp1.ibm.net> + Subject: [PATCH _03-MT5] POSIX.xs memory API + -- + allow the Carp routines to pass through exception objects + -- + clarify what a "line" is + -- + From: "J. van Krieken" + Date: Thu, 4 Feb 1999 17:25:25 +0100 (MET) + Message-Id: <199902041625.RAA14489@atcmpg.ATComputing.nl> + Subject: s2p incorrectly handles hold space commands + Branch: maint-5.005/perl + !> ext/POSIX/POSIX.xs lib/Carp.pm pod/perlfunc.pod pod/perlop.pod + !> pod/perltie.pod pod/perlvar.pod x2p/s2p.PL +____________________________________________________________________________ +[ 3070] By: gsar on 1999/03/04 06:43:57 + Log: integrate changes#2748,2753,2754,2819,2824,2855,2866,2867,2869,2885,2888,2889 + from mainline + + From: "Jonathan I. Kamens" + Date: Thu, 3 Dec 1998 15:10:17 -0500 + Message-Id: <199812032010.PAA09692@jik.shore.net> + Subject: sample checksum code in "perlfunc" man page is wrong + -- + Todo tweaks + -- + Todo updates from Andy Dougherty + -- + avoid garbage in db->dirbuf + From: Masahiro KAJIURA + Date: Sat, 05 Dec 1998 14:14:54 +0900 + Message-Id: <199812050514.OAA23268@toshiba.co.jp> + Subject: SDBM bug + -- + tweak doc on bitwise ops + -- + applied suggested patch; added tests + From: Adam Krolnik + Date: Sat, 12 Dec 98 15:30:18 -0600 + Message-Id: <9812122130.AA03717@gypsy.eng.cyrix.com> + Subject: Range operation doesn't handle IV_MAX + -- + display full pathname of unreadable files + -- + av_extend() doc tweak from Jan Dubois + -- + update win32/pod.mak + -- + note how to find REG_INFTY limit + -- + add note about test-notty target + -- + tweak PERL_STRICT_CR notes + Branch: maint-5.005/perl + !> Porting/pumpkin.pod README.win32 Todo Todo-5.005 + !> ext/SDBM_File/sdbm/sdbm.c pod/perldelta.pod pod/perlfunc.pod + !> pod/perlguts.pod pod/perlop.pod pod/perlre.pod pp_ctl.c + !> t/op/range.t utils/perldoc.PL win32/pod.mak +____________________________________________________________________________ +[ 3069] By: gsar on 1999/03/04 06:02:29 + Log: integrate change#2747 from mainline + + typos in Pod/Text.pm + Branch: maint-5.005/perl + !> lib/Pod/Text.pm +____________________________________________________________________________ +[ 3059] By: jhi on 1999/03/03 22:46:43 + Log: Document HP-UX 11 Y2K patch effect, based on + + From: "Richard L. England" + To: perlbug@perl.com + CC: "England, Richard" + Subject: test io/fs.t number 18 fails on HPUX 11.0 when Y2K patch installed. + Date: Fri, 26 Feb 1999 15:35:49 -0800 + Message-ID: <36D72FD4.4136C84F@mentorg.com> + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 3057] By: jhi on 1999/03/03 21:42:22 + Log: The *symbols patch (for Kurt's h2ph fixes) haunted us in AIX. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 3056] By: jhi on 1999/03/03 21:21:46 + Log: Fixed the pthreads_created_joinable test messed up + by the Mach cthreads change. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 3055] By: jhi on 1999/03/03 18:17:55 + Log: Configure and make gotchas. + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 3051] By: jhi on 1999/03/02 08:24:52 + Log: From: Dan Sugalski + To: perl5-porters@perl.org, vmsperl@perl.org + Subject: [PATCH 5.005_0x and 5.005_5x]Minor update to README.VMS + Date: Mon, 01 Mar 1999 16:10:57 -0800 + Message-Id: <3.0.6.32.19990301161057.03b1fc00@ous.edu> + Branch: cfgperl + ! README.vms + Branch: maint-5.005/perl + ! README.vms +____________________________________________________________________________ +[ 3049] By: jhi on 1999/03/02 07:34:21 + Log: From: Spider Boardman + To: perl5-porters@perl.org + Subject: [PATCH] Eliminate (valid) warning in byterun.c + Date: Mon, 01 Mar 1999 17:27:59 -0500 + Message-Id: <199903012227.RAA00181@leggy.zk3.dec.com> + Branch: cfgperl + ! bytecode.h + Branch: maint-5.005/perl + ! bytecode.h +____________________________________________________________________________ +[ 3028] By: jhi on 1999/02/26 14:40:00 + Log: HP-UX 11 threads. + + From: Jeff Okamoto + To: perl5-porters@perl.org + Cc: jhi@cc.hut.fi + Subject: Maint 5 and _54 with threading on HP-UX 11.00 + Date: Wed, 3 Feb 1999 12:57:18 -0800 (PST) + Message-Id: <199902032057.MAA10218@xfiles.intercon.hp.com> + + NOTE from jhi: the hpux hints could still be more robust by + disabling gdbm when necessary. + + Currently if there's a libgdbm.sl (gdbm 1.7.3) which is pre-11, + linking -lgdbm -lpthread creates an executable that instantly + core dumps on a pthreads internal panic: + + ./gdpt + + Pthread internal error: message: __libc_reinit() failed, file: ../pthreads/pthread.c, line: 1096 + Return Pointer is 0xc082bf33 + 17639 quit (core dumped) ./gdpt + + You don't have to *use* either gdbm or pthreads in the executable, + just linking them together is enough. Workaround is to recompile + the GDBM under HP-UX 11, that makes the problem to go away. + Branch: maint-5.005/perl + ! hints/hpux.sh thread.h +____________________________________________________________________________ +[ 3027] By: jhi on 1999/02/26 09:04:29 + Log: From: abigail@fnx.com + To: perl5-porters@perl.org (Perl Porters) + Subject: [PATCH 5.005_02 Getopt::Std] warn() instead of print STDERR. + Date: Thu, 25 Feb 1999 22:08:41 -0500 (EST) + Message-ID: <19990226030841.5985.qmail@alexandra.wayne.fnx.com> + Branch: maint-5.005/perl + ! lib/Getopt/Std.pm +____________________________________________________________________________ +[ 3026] By: jhi on 1999/02/26 08:18:26 + Log: full_ar wasn't propagated. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 3013] By: jhi on 1999/02/22 19:27:44 + Log: Fix MacPerl version, change PowerUX to PowerMAX. + + From: Chris Nandor + To: jhi@iki.fi + Cc: perl5-porters@perl.org + Subject: Re: perl current availability as documented by perl.pod + Date: Sun, 21 Feb 1999 11:06:03 -0500 + Message-Id: + + From: Tom Horsley + To: jhi@iki.fi + Cc: perl5-porters@perl.org + Subject: Re: perl current availability as documented by perl.pod + Date: Mon, 22 Feb 1999 13:08:30 GMT + Message-Id: <199902221308.NAA19971@cleo.ccur.com> + Branch: cfgperl + ! pod/perl.pod + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 3010] By: jhi on 1999/02/22 10:21:55 + Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + To: gbarr@pobox.com (Graham Barr) + Cc: perl5-porters@perl.org + Subject: [PATCH 5.005_03-MT5] DB_File 1.64 patch + Date: Mon, 22 Feb 1999 10:12:34 +0000 (GMT) + Message-Id: <9902221012.AA17784@claudius.bfsec.bt.co.uk> + Branch: maint-5.005/perl + ! ext/DB_File/Changes ext/DB_File/DB_File.pm + ! ext/DB_File/DB_File.xs ext/DB_File/typemap t/lib/db-recno.t +____________________________________________________________________________ +[ 3005] By: jhi on 1999/02/22 08:35:30 + Log: Configure/Perl knew how to look for use Mach cthreads + but Configure didn't let them to be used ($osname 'next'). + Branch: cfgperl + ! Configure config_h.SH + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 3004] By: jhi on 1999/02/21 15:46:02 + Log: Update Acorn AVAILABILITY. + Branch: cfgperl + ! pod/perl.pod + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 3003] By: jhi on 1999/02/21 14:50:42 + Log: From: rjk@linguist.dartmouth.edu (Ronald J. Kimball) + To: perl5-porters@perl.org (Perl 5 Porters) + Subject: PATCH: perlref.pod - symbolic ref example + Date: Sat, 20 Feb 1999 17:32:11 -0500 (EST) + Message-Id: <199902202232.RAA62306@linguist.dartmouth.edu> + Branch: cfgperl + ! pod/perlref.pod + Branch: maint-5.005/perl + ! pod/perlref.pod +____________________________________________________________________________ +[ 3000] By: jhi on 1999/02/21 14:15:31 + Log: pack s/l for negative numbers was broken on platforms + where sizeof(short) != 2 or sizeof(long) != 4 (Alpha, Cray). + pack v was broken for sizeof(short) == 8 big-endian platforms + (Cray), only zeros were produced. + Branch: maint-5.005/perl + ! perl.h pod/perlfunc.pod pp.c t/op/pack.t +____________________________________________________________________________ +[ 2997] By: jhi on 1999/02/20 14:00:26 + Log: Glossary update. + Branch: maint-5.005/perl + ! Porting/Glossary +____________________________________________________________________________ +[ 2995] By: jhi on 1999/02/20 12:25:10 + Log: Document #2893, Mach cthreads support. + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 2986] By: jhi on 1999/02/19 23:26:34 + Log: Remove the unnecessary osf1 -D__LANGUAGE_C__. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2983] By: jhi on 1999/02/19 20:35:51 + Log: Mach cthreads: + From: brie@corp.home.net (Brian Harrison) + Subject: perl5.005_02 patch for mthreads + To: perl5-porters@perl.org + Date: Fri, 23 Oct 1998 14:20:57 -0700 (PDT) + Message-ID: + Branch: maint-5.005/perl + ! Configure Porting/Glossary config_h.SH malloc.c perl.h + ! thread.h +____________________________________________________________________________ +[ 2981] By: jhi on 1999/02/19 19:49:03 + Log: From: "Kurt D. Starsinic" + To: Chaim Frenkel , + Russ Allbery , + Jarkko Hietaniemi , + Gurusamy Sarathy , + Graham Barr + Cc: bdensch@ameritech.net, perlbug@perl.com + Subject: [PATCH] Re: Solaris 7 for Intel + Message-ID: <19990219124404.A30182@O2.chapin.edu> + + and Glossary update. + Branch: maint-5.005/perl + ! Configure Makefile.SH Porting/Glossary +____________________________________________________________________________ +[ 2980] By: gbarr on 1999/02/19 16:06:53 + Log: Make result of h2xs work when user adds C + Branch: maint-5.005/perl + ! utils/h2xs.PL +____________________________________________________________________________ +[ 2976] By: gsar on 1999/02/18 21:54:09 + Log: integrate change#2975 from mainline + + distinguish eval'' from BEGIN|INIT|END CVs (fixes buggy propagation + of lexical searches in BEGIN|INIT|END) + Branch: maint-5.005/perl + !> cop.h cv.h op.c perly.c perly.y pp_ctl.c t/op/misc.t + !> vms/perly_c.vms +____________________________________________________________________________ +[ 2971] By: jhi on 1999/02/18 11:14:24 + Log: AIX syscalls.exp scan missed explicitly 32/64-bit syscalls. + + From: Joe Buehler + To: perl5-porters@perl.org + Subject: setsid not detected by perl 5.005_02 configure under AIX 4.3 + Date: 12 Feb 1999 11:25:21 -0500 + Message-ID: + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2967] By: jhi on 1999/02/17 23:12:59 + Log: Make SCO/Unixware scan to work in Unixware, too. + + From: Tom Hughes + To: perlbug@perl.com + Subject: Not OK: perl 5.00555 on i386-svr4 [actually Unixware 2.1] (UNINSTALLED) + Date: 17 Feb 1999 15:34:15 +0000 + Message-ID: + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2956] By: jhi on 1999/02/15 21:03:28 + Log: OpenBSD sparc SHMLBA (like change #2945). + Branch: maint-5.005/perl + ! ext/IPC/SysV/SysV.xs +____________________________________________________________________________ +[ 2950] By: jhi on 1999/02/15 13:37:28 + Log: AVAILABILITY sync. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2906] By: jhi on 1999/02/13 14:55:47 + Log: AVAILABILITY sync. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2905] By: gsar on 1999/02/13 00:12:53 + Log: integrate change#2898 from mainline + + support win32_putenv() + Branch: maint-5.005/perl + !> mg.c util.c win32/GenCAPI.pl win32/makedef.pl win32/perlhost.h + !> win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 2904] By: jhi on 1999/02/12 21:23:30 + Log: Add README.hurd, from Mark Kettenis . + Branch: maint-5.005/perl + + README.hurd + ! MANIFEST +____________________________________________________________________________ +[ 2900] By: jhi on 1999/02/12 12:07:28 + Log: SCO ODT/OSR release scanning. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2897] By: jhi on 1999/02/12 11:24:25 + Log: Undo a big bad paste from change #2884. + Branch: maint-5.005/perl + ! hints/openbsd.sh +____________________________________________________________________________ +[ 2896] By: jhi on 1999/02/12 11:19:52 + Log: Update the error message of db-recno.t to DB version 1.86 + and the URL to www.sleepycat.com instead of www.bostic.com. + Branch: maint-5.005/perl + ! t/lib/db-recno.t +____________________________________________________________________________ +[ 2895] By: gsar on 1999/02/12 11:18:59 + Log: integrate change#2854 from mainline + + compatibility fix: magic non-propagation in foreach implicit localization + Branch: maint-5.005/perl + !> pp_ctl.c t/op/local.t +____________________________________________________________________________ +[ 2884] By: jhi on 1999/02/12 08:36:14 + Log: OpenBSD pthreads awareness, thanks to + David Leonard + Branch: maint-5.005/perl + ! Configure hints/openbsd.sh +____________________________________________________________________________ +[ 2883] By: jhi on 1999/02/12 08:29:51 + Log: AVAILABILITY sync. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2878] By: jhi on 1999/02/11 22:00:50 + Log: Replace changes #2783, #2784, #2785, with a single tested + patch from Francois Desarmenien . + Branch: maint-5.005/perl + ! MANIFEST ext/GDBM_File/hints/sco.pl ext/IPC/SysV/SysV.xs + ! hints/sco.sh +____________________________________________________________________________ +[ 2876] By: jhi on 1999/02/11 20:43:17 + Log: From: Chris Nandor + To: perl5-porters@perl.org + Subject: [PATCH] perlport.pod 1.39 + Date: Thu, 11 Feb 1999 12:28:35 -0500 + Message-Id: + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 2875] By: jhi on 1999/02/11 20:35:08 + Log: The fpsetmask() really is SCO5 only. + Branch: maint-5.005/perl + ! unixish.h +____________________________________________________________________________ +[ 2874] By: jhi on 1999/02/11 20:32:06 + Log: Change #2783 missed these. + Branch: maint-5.005/perl + ! ext/IPC/SysV/SysV.xs unixish.h +____________________________________________________________________________ +[ 2873] By: jhi on 1999/02/11 20:27:45 + Log: Import the change #2810 from cfgperl. + Branch: maint-5.005/perl + + ext/GDBM_File/hints/sco.pl + ! MANIFEST hints/sco.sh unixish.h +____________________________________________________________________________ +[ 2872] By: jhi on 1999/02/11 19:57:37 + Log: Sync the current AVAILABILITY. + Branch: maint-5.005/perl + ! pod/perl.pod pod/perldelta.pod +____________________________________________________________________________ +[ 2871] By: jhi on 1999/02/11 19:42:54 + Log: Copied the GNU/Hurd hints file over from cfgperl + because it works well enough (there are still some + rough edges in Hurd), verified via private + email from Mark Kettenis + Branch: maint-5.005/perl + + hints/gnu.sh +____________________________________________________________________________ +[ 2864] By: jhi on 1999/02/11 08:45:00 + Log: From: Spider Boardman + To: perlbug@perl.com + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on RISC-ultrix 4.4 (UNINSTALLED) + Date: Wed, 10 Feb 1999 23:33:31 -0500 + Message-Id: <9902110433.AA12816@abyss.zk3.dec.com> + Branch: maint-5.005/perl + ! doio.c ext/IPC/SysV/SysV.xs hints/ultrix_4.sh +____________________________________________________________________________ +[ 2863] By: jhi on 1999/02/11 08:35:35 + Log: AVAILABILITY. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2858] By: gsar on 1999/02/11 07:10:59 + Log: remove dup hunk + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 2857] By: gsar on 1999/02/11 07:09:20 + Log: sync with parent version of perldelta.pod + Branch: maint-5.005/perl + !> pod/perldelta.pod +____________________________________________________________________________ +[ 2853] By: gsar on 1999/02/11 00:33:06 + Log: integrate change#2816 from mainline + + minor bug in dumping blessed subrefs + Branch: maint-5.005/perl + !> ext/Data/Dumper/Dumper.pm +____________________________________________________________________________ +[ 2852] By: gsar on 1999/02/10 23:17:49 + Log: fair warning about -Dusethreads + Branch: maint-5.005/perl + ! Configure INSTALL README.threads +____________________________________________________________________________ +[ 2851] By: jhi on 1999/02/10 23:00:39 + Log: Snapshot of the ongoing AVAILABILITY discussion. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2850] By: jhi on 1999/02/10 16:07:32 + Log: OS390 and Windows AVAILABILITY entries enhanced. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2849] By: jhi on 1999/02/10 12:39:46 + Log: AS/400 and Mac were not described right. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2848] By: jhi on 1999/02/10 09:13:49 + Log: Added AVAILABILITY section. + Branch: maint-5.005/perl + ! pod/perl.pod +____________________________________________________________________________ +[ 2837] By: jhi on 1999/02/08 14:51:39 + Log: Fix typo introduced in change #2836. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2836] By: jhi on 1999/02/08 14:44:31 + Log: Augment change #2809, the h2ph-*symbols patch. + Branch: maint-5.005/perl + ! Configure t/lib/h2ph.pht +____________________________________________________________________________ +[ 2815] By: gsar on 1999/02/05 03:44:50 + Log: integrate change#2242 from mainline + + fix skipspace() to properly account for newlines in eval''-ed + strings (caused bogus line numbers in diagnostics and debugger) + Branch: maint-5.005/perl + !> toke.c +____________________________________________________________________________ +[ 2814] By: jhi on 1999/02/04 21:21:39 + Log: Stratus perlport update. + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 2813] By: jhi on 1999/02/04 21:16:54 + Log: Stratus VOS update. + + From: Paul_Green@stratus.com + To: jhi@iki.fi + Subject: RE: VOS changes for Perl5.005_03 are ready! + Date: Thu, 4 Feb 1999 14:51:07 -0500 + Message-ID: <1D1A4EF7AD4DD211A80D00A0C9D7DB665A0168@exna1.stratus.com> + Branch: maint-5.005/perl + + vos/vos_accept.c + ! MANIFEST README.vos perl.c pod/perlport.pod vos/Changes + ! vos/build.cm vos/compile_perl.cm vos/config.h + ! vos/config_h.SH_orig vos/perl.bind vos/test_vos_dummies.c + ! vos/vos_dummies.c vos/vosish.h +____________________________________________________________________________ +[ 2809] By: jhi on 1999/02/03 19:54:16 + Log: h2ph fixes + Configure patch to support them. + + From: "Kurt D. Starsinic" + To: Graham Barr , Jarkko Hietaniemi , + Gurusamy Sarathy + Cc: perl5-porters@perl.org + Subject: [PATCH 5.00503_MT5] h2ph.PL + Date: Tue, 2 Feb 1999 19:48:06 -0500 + Message-ID: <19990202194806.E10647@O2.chapin.edu> + Branch: maint-5.005/perl + ! Configure utils/h2ph.PL +____________________________________________________________________________ +[ 2802] By: jhi on 1999/02/02 17:41:23 + Log: From: John Bley + To: perlbug@perl.org + Subject: [PATCH]5.005_54 (DOC) fix minor typos + Date: Tue, 2 Feb 1999 07:52:52 -0500 (EST) + Message-ID: + Branch: maint-5.005/perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 2790] By: jhi on 1999/02/02 16:51:45 + Log: Re-introduce the typo corrections (update to CGI 2.46 + overran them). + Branch: maint-5.005/perl + ! lib/CGI.pm +____________________________________________________________________________ +[ 2781] By: jhi on 1999/02/02 14:27:01 + Log: Update the MkLinux note. + Branch: maint-5.005/perl + ! hints/linux.sh +____________________________________________________________________________ +[ 2775] By: jhi on 1999/02/02 13:13:24 + Log: Mention lib/Dumpvalue.pm. + Branch: maint-5.005/perl + ! pod/roffitall +____________________________________________________________________________ +[ 2767] By: jhi on 1999/02/02 12:29:57 + Log: Demangle spaces to tab+space. + Branch: maint-5.005/perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 2758] By: jhi on 1999/02/02 10:51:26 + Log: Detypo. + Branch: maint-5.005/perl + ! lib/Math/Trig.pm +____________________________________________________________________________ +[ 2755] By: jhi on 1999/02/02 09:07:51 + Log: Make FreeBSD 2.2.7 work with -Duseshrplib -ders. + Branch: maint-5.005/perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 2752] By: jhi on 1999/02/01 22:15:12 + Log: Add perlthrtut.pod. + + From: Dan Sugalski + To: perl5-porters@perl.org + Subject: perlthrtut.pod + Date: Mon, 01 Feb 1999 10:57:11 -0800 + Message-Id: <3.0.6.32.19990201105711.02e62540@ous.edu> + Branch: maint-5.005/perl + + pod/perlthrtut.pod + ! MANIFEST pod/Makefile pod/buildtoc pod/perldelta.pod + ! pod/roffitall +____________________________________________________________________________ +[ 2741] By: gbarr on 1999/02/01 03:00:42 + Log: Fix typecasts in #2728 + + From: "G. Del Merritt" + Date: Fri, 29 Jan 1999 11:47:25 -0700 + Message-Id: <199901291847.LAA04828@jhereg.perl.com> + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on MSWin32-x86-object 4.0 (PATCH included) + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 2740] By: gsar on 1999/02/01 02:43:07 + Log: CAPI inheritance tweak and doc + Branch: maint-5.005/perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 2739] By: jhi on 1999/01/31 18:31:54 + Log: Undo changes #2730 and #2731 and replace them + with an extensively tested patch from + Anton Berezin (via private email). + Branch: maint-5.005/perl + ! Makefile.SH hints/freebsd.sh +____________________________________________________________________________ +[ 2738] By: gsar on 1999/01/31 05:04:32 + Log: fix bogus CAPI inheritance from change#2541 + Branch: maint-5.005/perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 2737] By: gsar on 1999/01/31 04:55:06 + Log: remove the big ugly thing jhi sneezed into INSTALL :-) + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 2736] By: jhi on 1999/01/30 12:57:06 + Log: From: pvhp@forte.com (Peter Prymmer) + To: perl-mvs@perl.org, perlbug@perl.com + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on os390 05.00 (UNINSTALLED) + Date: Fri, 29 Jan 99 19:22:31 PST + Message-Id: <9901300322.AA19136@forte.com> + + (slighty edited at the end) + Branch: maint-5.005/perl + ! README.os390 +____________________________________________________________________________ +[ 2735] By: jhi on 1999/01/30 11:49:54 + Log: Undo 5.005-devel random, srandom mention. + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 2734] By: jhi on 1999/01/29 22:22:00 + Log: Add perlreftut. + Branch: maint-5.005/perl + + pod/perlreftut.pod + ! MANIFEST pod/perl.pod pod/perldelta.pod pod/roffitall +____________________________________________________________________________ +[ 2732] By: gsar on 1999/01/29 20:09:44 + Log: integrate change#2720 from mainline + + missing space while munging CCFLAGS for PERL_CAPI + Branch: maint-5.005/perl + !> lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 2731] By: jhi on 1999/01/29 14:33:12 + Log: FreeBSD version numbers can be like "2.2.8-release". + Branch: maint-5.005/perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 2730] By: jhi on 1999/01/29 12:40:38 + Log: FreeBSD hints iteration (hopefully convergent). + usethreads: require at least FreeBSD 2.2.8. + signal type: mirror change #2429 in cfgperl. + Branch: maint-5.005/perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 2729] By: gbarr on 1999/01/29 05:06:32 + Log: Trial release 5 + Branch: maint-5.005/perl + ! Changes patchlevel.h pod/perlhist.pod +____________________________________________________________________________ +[ 2728] By: gbarr on 1999/01/29 04:10:37 + Log: From: Ted Law + Date: Wed, 27 Jan 1999 14:54:03 -0500 (EST) + Message-Id: <199901271954.OAA07391@dcm2.cibcwg.com> + Subject: POSIX::strftime buffer overflow problem + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 2728] By: gbarr on 1999/01/29 04:10:37 + Log: From: Ted Law + Date: Wed, 27 Jan 1999 14:54:03 -0500 (EST) + Message-Id: <199901271954.OAA07391@dcm2.cibcwg.com> + Subject: POSIX::strftime buffer overflow problem + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 2727] By: gbarr on 1999/01/29 04:09:57 + Log: From: Tom Spindler + Date: Thu, 28 Jan 1999 17:15:11 -0800 + Message-ID: <19990128171510.A11778@isi.net> + Subject: [PATCH] BeOS dynamic loading support for perl5.005_03_MT4 + Branch: maint-5.005/perl + + ext/DynaLoader/dl_beos.xs + ! Configure MANIFEST Makefile.SH README.beos hints/beos.sh + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 2726] By: gbarr on 1999/01/29 03:30:51 + Log: Remove use of File::Slurp in t/lib/textfill.t + Branch: maint-5.005/perl + ! t/lib/textfill.t +____________________________________________________________________________ +[ 2725] By: gbarr on 1999/01/29 03:11:41 + Log: From: Gurusamy Sarathy + Date: Wed, 27 Jan 1999 23:14:33 -0800 + Message-Id: <199901280714.XAA10176@activestate.com> + Subject: Re: NOT OK: "@INC contains: ." after make install - MAINT_TRIAL_4 - 5.005_03 maintenance trial 4 MSWin32-x86-object + Branch: maint-5.005/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 2724] By: jhi on 1999/01/28 19:27:15 + Log: Change jhi@iki.fi to perlbug@perl.com. + Cosmetic change in semctl probing messages. + Branch: maint-5.005/perl + ! Configure hints/freebsd.sh +____________________________________________________________________________ +[ 2723] By: jhi on 1999/01/28 17:27:49 + Log: Yet another typo in a test program. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2722] By: jhi on 1999/01/28 17:13:52 + Log: The pthreads_created_joinable test had a typo, + by blind luck the default value works almost anywhere. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2721] By: jhi on 1999/01/28 13:04:23 + Log: MinT support, adapted from change #2594. + Branch: maint-5.005/perl + + README.mint ext/POSIX/hints/mint.pl hints/mint.sh + + mint/Makefile mint/README mint/errno.h mint/pwd.c mint/stdio.h + + mint/sys/time.h mint/time.h + ! MANIFEST doio.c malloc.c miniperlmain.c perl.c + ! pod/perldelta.pod t/io/fs.t t/lib/safe2.t t/op/groups.t + ! t/op/mkdir.t t/op/taint.t +____________________________________________________________________________ +[ 2719] By: jhi on 1999/01/27 19:49:49 + Log: From: "M.J.T. Guy" + To: perl5-porters@perl.org + Subject: Re: [PATCH] perl5.005_03-MAINT_TRIAL_3: clarify Sv[INU]V versus Sv[INU]VX in perlguts + Date: Tue, 26 Jan 1999 22:25:07 +0000 + Message-Id: + Branch: maint-5.005/perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 2718] By: jhi on 1999/01/27 19:46:04 + Log: io/fs.t fails test #18 (sense of tests appears to have been + changed incompletely; this patch just skips the test attached, + a la test #17 preceding it). + + From: "G. Del Merritt" + To: perlbug@perl.com + Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on MSWin32-x86-object (PATCHES included) + Date: Tue, 26 Jan 1999 12:09:09 -0700 + Message-Id: <199901261909.MAA25525@jhereg.perl.com> + Branch: maint-5.005/perl + ! t/io/fs.t +____________________________________________________________________________ +[ 2717] By: jhi on 1999/01/27 19:44:46 + Log: Miniperl fails to build (pp_sys.c was changed and iperlsys.h wasn't) + + From: "G. Del Merritt" + To: perlbug@perl.com + Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on MSWin32-x86-object (PATCHES included) + Date: Tue, 26 Jan 1999 12:09:09 -0700 + Message-Id: <199901261909.MAA25525@jhereg.perl.com> + Branch: maint-5.005/perl + ! iperlsys.h +____________________________________________________________________________ +[ 2716] By: jhi on 1999/01/27 19:38:36 + Log: From: Dan Sugalski + To: perlbug@perl.com, vmsperl@perl.org + Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on VMSAXP (Patch included, of course) + Date: Tue, 26 Jan 1999 14:40:38 -0800 + Message-Id: <3.0.6.32.19990126144038.02e5d650@ous.edu> + + From: Dan Sugalski + To: perl5-porters@perl.org, vmsperl@perl.org + Subject: [PATCH 5.005_03-MAILT_TRIAL_4]VMS test patches + Date: Tue, 26 Jan 1999 14:55:29 -0800 + Message-Id: <3.0.6.32.19990126145529.02f22280@ous.edu> + Branch: maint-5.005/perl + ! t/lib/textfill.t t/lib/textwrap.t vms/ext/Stdio/test.pl + ! vms/subconfigure.com +____________________________________________________________________________ +[ 2715] By: jhi on 1999/01/27 19:34:28 + Log: From: Mark Bixby + To: perl5-porters@perl.org + Subject: [PATCH perl5.005_03-MAINT_TRIAL_4] MPE port tweaks + Date: Tue, 26 Jan 1999 16:32:18 -0800 (PST) + Message-Id: <199901270032.QAA13395@spock.dis.cccd.edu> + Branch: maint-5.005/perl + ! hints/mpeix.sh mpeix/relink +____________________________________________________________________________ +[ 2714] By: jhi on 1999/01/27 19:32:41 + Log: NetBSD does not do setruid, setrgid. + Branch: maint-5.005/perl + ! hints/netbsd.sh +____________________________________________________________________________ +[ 2713] By: jhi on 1999/01/27 19:28:53 + Log: FreeBSD usethreads, based on private email with + Anton Berezin . + Branch: maint-5.005/perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 2712] By: jhi on 1999/01/27 19:26:17 + Log: From: Ilya Zakharevich + To: Mailing list Perl5 + Subject: [PATCH 5.005_*] OS/2 threads + Date: Tue, 26 Jan 1999 13:39:46 -0500 + Message-ID: <19990126133946.A11594@monk.mps.ohio-state.edu> + Branch: maint-5.005/perl + ! os2/os2ish.h +____________________________________________________________________________ +[ 2711] By: jhi on 1999/01/27 19:24:28 + Log: "make ok", "make okfile", and "make nok" were broken + with -Duseshrplib, because of a shared typo. + + From: Spider Boardman + To: perlbug@perl.com + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED) + Date: Wed, 27 Jan 1999 12:27:15 -0500 + Message-Id: <199901271727.MAA233455@web.zk3.dec.com> + Branch: maint-5.005/perl + ! Makefile.SH +____________________________________________________________________________ +[ 2710] By: jhi on 1999/01/27 19:22:23 + Log: Errno fixes: + + From: Spider Boardman + To: perlbug@perl.com + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED) + Date: Wed, 27 Jan 1999 12:27:15 -0500 + Message-Id: <199901271727.MAA233455@web.zk3.dec.com> + + From: Spider Boardman + To: perlbug@perl.com + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED) + Date: Wed, 27 Jan 1999 13:31:16 -0500 + Message-Id: <199901271831.NAA241001@web.zk3.dec.com> + Branch: maint-5.005/perl + ! Configure ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 2709] By: jhi on 1999/01/27 19:17:35 + Log: Fix Configure installusrbinperl: + + From: Spider Boardman + To: jhi@iki.fi + cc: perl5-porters@perl.org + Subject: Re: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED) + Date: Wed, 27 Jan 1999 13:03:35 -0500 + Message-Id: <199901271803.NAA238257@web.zk3.dec.com> + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2708] By: gbarr on 1999/01/26 04:14:42 + Log: Trial release 4 + Branch: maint-5.005/perl + ! Changes patchlevel.h pod/perlhist.pod +____________________________________________________________________________ +[ 2707] By: gbarr on 1999/01/26 02:06:17 + Log: Add redef IO::Handle::* for setv?buf() + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.pm +____________________________________________________________________________ +[ 2706] By: jhi on 1999/01/24 22:26:12 + Log: Better AIX libc nm scan. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2703] By: jhi on 1999/01/24 14:26:18 + Log: Minor Configure adjustments. + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2702] By: jhi on 1999/01/24 13:57:33 + Log: Use usethreads.cbu consistently. + Branch: maint-5.005/perl + ! Configure hints/aix.sh hints/dec_osf.sh hints/dos_djgpp.sh + ! hints/freebsd.sh hints/hpux.sh hints/irix_4.sh hints/irix_5.sh + ! hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh + ! hints/linux.sh hints/os2.sh hints/solaris_2.sh +____________________________________________________________________________ +[ 2701] By: jhi on 1999/01/24 13:55:43 + Log: Mention year-1900 and month 0..11 also here. + Branch: maint-5.005/perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 2700] By: jhi on 1999/01/24 13:52:36 + Log: Document Configure -Uinstallusrbinperl. + Branch: maint-5.005/perl + ! INSTALL pod/perldelta.pod +____________________________________________________________________________ +[ 2699] By: jhi on 1999/01/24 13:01:57 + Log: perlopentut was missing. + Branch: maint-5.005/perl + + pod/perlopentut.pod + ! MANIFEST pod/perldelta.pod +____________________________________________________________________________ +[ 2697] By: jhi on 1999/01/24 12:31:33 + Log: Remove t/op/grent.t (t/op/pwent.t was removed by #2685). + Branch: maint-5.005/perl + - t/op/grent.t + ! MANIFEST +____________________________________________________________________________ +[ 2696] By: gsar on 1999/01/24 11:39:39 + Log: integrate changes#2255,2694 from mainline + + another win32 portability fix: make sysread() and syswrite() + work on sockets + + better notes on 'make' on win32 + Branch: maint-5.005/perl + ! README.win32 pp_sys.c win32/win32.h +____________________________________________________________________________ +[ 2693] By: gbarr on 1999/01/24 00:53:31 + Log: Integrate changes #2646,2647 from cfgperl + + Show LANGUAGE env var when needed. (Augment change #2645). + + SHMLBA strikes back in NetBSD/sparc. + + From: Dave Nelson + To: jhi@iki.fi + Subject: perl5.005_02 + IPC::SysV + NetBSD/Sparc + Date: Mon, 18 Jan 1999 22:07:56 -0600 + Message-Id: <199901190407.WAA02543@longhorn.bellcow.com> + Branch: maint-5.005/perl + ! util.c utils/perlbug.PL + !> ext/IPC/SysV/SysV.xs +____________________________________________________________________________ +[ 2692] By: gbarr on 1999/01/24 00:28:52 + Log: Integrate #2630 from mainline and an errno save fix + Branch: maint-5.005/perl + !> doio.c +____________________________________________________________________________ +[ 2691] By: gbarr on 1999/01/24 00:28:37 + Log: Update CGI modules to 2.46 and Getopt::Long to 2.19 + Branch: maint-5.005/perl + ! lib/CGI.pm lib/CGI/Carp.pm lib/CGI/Cookie.pm lib/CGI/Fast.pm + ! lib/CGI/Push.pm lib/Getopt/Long.pm t/lib/cgi-html.t +____________________________________________________________________________ +[ 2690] By: gbarr on 1999/01/23 23:35:39 + Log: Integrate #2681 from cfgperl + + Better (I hope) LANGUAGE documentation. + Branch: maint-5.005/perl + !> pod/perllocale.pod +____________________________________________________________________________ +[ 2689] By: gbarr on 1999/01/23 23:31:59 + Log: More nosuid patches + + From: Jarkko Hietaniemi + Date: Fri, 22 Jan 1999 12:12:45 +0200 (EET) + Message-ID: <13992.20253.269284.841300@alpha.hut.fi> + Subject: Re: [PATCH] 5.005*: the "nosuid" problem: v2 + Branch: maint-5.005/perl + ! Configure config_h.SH perl.c perl.h pod/perldelta.pod + ! pod/perldiag.pod +____________________________________________________________________________ +[ 2688] By: gbarr on 1999/01/23 23:03:39 + Log: From: Anton Berezin + Date: 21 Jan 1999 17:07:28 +0100 + Message-ID: <86emood2yn.fsf@lion.plab.ku.dk> + Subject: [PATCH 5.005_54] hints/freebsd.sh - reflect the birth of version 4.0 + Branch: maint-5.005/perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 2687] By: gbarr on 1999/01/23 22:52:58 + Log: overload syntax is no longer experimental + Branch: maint-5.005/perl + ! lib/overload.pm +____________________________________________________________________________ +[ 2685] By: gbarr on 1999/01/23 22:15:46 + Log: Remove t/op/pwent.t added from cfgperl, but is not robust. + Branch: maint-5.005/perl + - t/op/pwent.t + ! MANIFEST +____________________________________________________________________________ +[ 2684] By: gbarr on 1999/01/23 22:13:07 + Log: More doc typos from Abigail, and undo some in lib/diagnostics.pm + from change #2672 + + From: abigail@fnx.com + Date: Tue, 19 Jan 1999 19:32:42 -0500 (EST) + Message-Id: <19990120003242.19938.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/CGI.pm] Typos + + From: abigail@fnx.com + Date: Tue, 19 Jan 1999 19:40:41 -0500 (EST) + Message-Id: <19990120004041.20052.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/CPAN.pm] Typos + Branch: maint-5.005/perl + ! lib/CGI.pm lib/CPAN.pm lib/diagnostics.pm +____________________________________________________________________________ +[ 2677] By: gbarr on 1999/01/22 03:38:07 + Log: Integrate #2645, #2648 and update patching.pod + + Document the GNU LANGUAGE env var. + + Mention /usr/share/locale. + + From: Daniel Grisinger + Date: 21 Jan 1999 00:17:35 -0700 + Message-Id: + Subject: [PATCH] patching.pod, misc fixes (was Re: Which ? What ? Why ? When ?) + Branch: maint-5.005/perl + ! Porting/patching.pod + !> pod/perllocale.pod +____________________________________________________________________________ +[ 2676] By: gbarr on 1999/01/22 01:54:02 + Log: Fixup FindBin to use File::Spec + + Message-Id: <19990120185157.D24479@west-tip.transeda.com> + Date: Wed, 20 Jan 1999 18:51:57 +0000 + From: Paul Johnson + Subject: Re: [PATCH] 5005_54 Make FindBin work with UNC paths + Branch: maint-5.005/perl + ! lib/FindBin.pm +____________________________________________________________________________ +[ 2675] By: gbarr on 1999/01/22 01:38:31 + Log: Add new config values added for nosuid fix into VMS configure + + From: Dan Sugalski + Date: Wed, 20 Jan 1999 12:05:18 -0800 + Message-Id: <3.0.6.32.19990120120518.00a98470@ous.edu> + Subject: [PATCH 5.005_03MT3]VMS configure tweak + Branch: maint-5.005/perl + ! vms/subconfigure.com +____________________________________________________________________________ +[ 2674] By: gbarr on 1999/01/22 01:36:35 + Log: Fix for buggy compiler optimization on dec for pack("I",...) + + From: Achim Bohnet + Date: Wed, 20 Jan 1999 20:25:53 +0100 + Message-Id: <199901201925.UAA16940@o06.xray.mpe.mpg.de> + Subject: [PATCH] Not OK: perl 5.00503 +MAINT_TRIAL_3 on alpha-dec_osf 4.0 + Branch: maint-5.005/perl + ! pp.c +____________________________________________________________________________ +[ 2673] By: gbarr on 1999/01/22 01:29:37 + Log: OS/2 patches from Ilya + + Date: Thu, 21 Jan 1999 02:08:27 -0500 + From: Ilya Zakharevich + Subject: [PATCH 5.00*] makedepend + Message-Id: <19990121020827.A25509@monk.mps.ohio-state.edu> + + Date: Thu, 21 Jan 1999 02:46:34 -0500 + From: Ilya Zakharevich + Subject: [PATCH 5.005_*] Errno.pm suffers from \\ too + Message-Id: <19990121024634.A25600@monk.mps.ohio-state.edu> + + Date: Thu, 21 Jan 1999 02:50:16 -0500 + From: Ilya Zakharevich + Subject: [PATCH 5.005_03] Resend of OS/2 patch + Message-Id: <19990121025016.A25612@monk.mps.ohio-state.edu> + + Date: Thu, 21 Jan 1999 03:58:29 -0500 + From: Ilya Zakharevich + Subject: [PATCH 5.005_*] OS2::PrfDB was exploiting a bug in U32 XSUBs + Message-Id: <19990121035829.A25822@monk.mps.ohio-state.edu> + Branch: maint-5.005/perl + ! ext/Errno/Errno_pm.PL makedepend.SH os2/Changes + ! os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.xs os2/os2.c +____________________________________________________________________________ +[ 2672] By: gbarr on 1999/01/22 01:05:45 + Log: More doc typo patches from Abigail + + From: abigail@fnx.com + Message-Id: <19990120001410.19645.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL 3 lib/AutoLoader.pm] Typos + Date: Tue, 19 Jan 1999 19:14:10 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120004312.20152.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/Carp.pm] Typo + Date: Tue, 19 Jan 1999 19:43:12 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120004429.20190.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/Cwd.pm] Typo + Date: Tue, 19 Jan 1999 19:44:29 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120005241.20693.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/Safe.pm] Typo + Date: Tue, 19 Jan 1999 19:52:41 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120005525.20788.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/SelfLoader.pm] Typos + Date: Tue, 19 Jan 1999 19:55:25 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120005821.20926.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/Symbol.pm] Typo + Date: Tue, 19 Jan 1999 19:58:21 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120010002.20973.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/Test.pm] Typo + Date: Tue, 19 Jan 1999 20:00:02 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120013823.23015.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/diagnostics.pm] Typos (ignore + Date: Tue, 19 Jan 1999 20:38:23 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120013909.23085.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/ops.pm] Typo + Date: Tue, 19 Jan 1999 20:39:09 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120015817.24306.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/overload.pm] Typos + Date: Tue, 19 Jan 1999 20:58:16 -0500 (EST) + + From: abigail@fnx.com + Message-Id: <19990120020326.24373.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL3 lib/re.pm] Typos + Date: Tue, 19 Jan 1999 21:03:26 -0500 (EST) + Branch: maint-5.005/perl + ! ext/Opcode/Safe.pm ext/Opcode/ops.pm ext/re/re.pm + ! lib/AutoLoader.pm lib/Carp.pm lib/Cwd.pm lib/SelfLoader.pm + ! lib/Symbol.pm lib/Test.pm lib/diagnostics.pm lib/overload.pm +____________________________________________________________________________ +[ 2671] By: gbarr on 1999/01/22 00:40:13 + Log: Fix win32 for Borland compiler and spaces in paths + + From: Gurusamy Sarathy + Date: Mon, 18 Jan 1999 20:33:17 -0800 + Message-Id: <199901190433.UAA03656@activestate.com> + Subject: [PATCH] 5.005_03-trial3 win32 issues + Branch: maint-5.005/perl + ! README.win32 win32/Makefile win32/config_sh.PL + ! win32/makefile.mk win32/runperl.c +____________________________________________________________________________ +[ 2637] By: gbarr on 1999/01/18 02:52:18 + Log: Update DB_File to 1.63 + + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Date: Tue, 29 Dec 1998 16:23:54 +0000 (GMT) + Message-Id: <9812291623.AA20884@claudius.bfsec.bt.co.uk> + Subject: PATCH DB_File 1.63 for 5.005_54 & 5.005_03 + Branch: maint-5.005/perl + ! ext/DB_File/Changes ext/DB_File/DB_File.pm + ! ext/DB_File/DB_File.xs ext/DB_File/dbinfo ext/DB_File/typemap +____________________________________________________________________________ +[ 2636] By: gbarr on 1999/01/17 18:03:31 + Log: Trial release 3 + Branch: maint-5.005/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 2635] By: gbarr on 1999/01/17 17:32:01 + Log: Update to CPAN-1.44 + + From: Mark-Jason Dominus + Date: Sat, 16 Jan 1999 17:22:06 -0500 + Message-ID: <19990116222206.3674.qmail@plover.com> + Subject: Re: DOC PATCH (5.005_54 perlsub.pod) + Branch: maint-5.005/perl + ! lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm + ! pod/perlsub.pod +____________________________________________________________________________ +[ 2634] By: gbarr on 1999/01/17 17:27:12 + Log: Fix for suidperl when script is on a nosuid filesystem + + From: Jarkko Hietaniemi + Date: Sun, 17 Jan 1999 16:27:06 +0200 (EET) + Message-ID: <13985.62266.324824.292401@alpha.hut.fi> + Subject: [PATCH] 5.005*: the "nosuid" problem: v2 + Branch: maint-5.005/perl + ! Configure config_h.SH perl.c perl.h pod/perldiag.pod +____________________________________________________________________________ +[ 2618] By: gbarr on 1999/01/16 19:18:26 + Log: Added Dumpvalue.pm + + From: Ilya Zakharevich + Date: Mon, 7 Dec 1998 02:44:25 -0500 (EST) + Message-Id: <199812070744.CAA18949@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Dumpvar.pm + Branch: maint-5.005/perl + + lib/Dumpvalue.pm + ! MANIFEST pod/perldelta.pod +____________________________________________________________________________ +[ 2617] By: gbarr on 1999/01/16 19:09:36 + Log: Minor change to perlxstut and added perlopentut.pod + + From: Nathan Torkington + Date: Sat, 26 Dec 1998 14:28:21 +1300 (NZDT) + Message-ID: <13956.15285.933914.320849@localhost.frii.com> + Subject: [PATCH] perlxstut.pod fix + + From: Tom Christiansen + Date: Sat, 09 Jan 1999 08:13:18 -0700 + Message-Id: <199901091513.IAA17512@jhereg.perl.com> + Subject: perlopentut.pod + Branch: maint-5.005/perl + ! MANIFEST pod/perl.pod pod/perldelta.pod pod/perlxstut.pod + ! pod/roffitall +____________________________________________________________________________ +[ 2616] By: gbarr on 1999/01/16 18:59:55 + Log: Win32 changes from Jan + + From: jan.dubois@ibm.net (Jan Dubois) + Date: Fri, 15 Jan 1999 23:38:35 +0100 + Message-ID: <36a7c10d.16311905@smtp1.ibm.net> + Subject: [PATCH 5.005_03m2] Win32 Makefile patches + + From: jan.dubois@ibm.net (Jan Dubois) + Date: Sat, 16 Jan 1999 13:02:45 +0100 + Message-ID: <36a07da6.10722337@smtp1.ibm.net> + Subject: [PATCH 5.005_03m2] minor tweaks to README.win32 + Branch: maint-5.005/perl + ! README.win32 win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 2615] By: gbarr on 1999/01/16 18:48:48 + Log: Jumbo patch from Sarathy for PERL_OBJECT & USE_THREADS + + From: Gurusamy Sarathy + Date: Thu, 07 Jan 1999 00:12:00 -0500 + Message-Id: <199901070512.AAA23568@aatma.engin.umich.edu> + Subject: Re: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds + + From: Gurusamy Sarathy + Date: Thu, 14 Jan 1999 19:21:46 -0500 + Message-Id: <199901150021.TAA01886@aatma.engin.umich.edu> + Subject: Re: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds + Branch: maint-5.005/perl + ! embed.h global.sym lib/ExtUtils/MM_Unix.pm objXSUB.h objpp.h + ! op.c perl.c perl.h perly.c perly.y perly_c.diff pp.c proto.h + ! sv.c t/io/fs.t toke.c win32/GenCAPI.pl win32/config.bc + ! win32/makedef.pl win32/runperl.c win32/win32.c +____________________________________________________________________________ +[ 2614] By: gbarr on 1999/01/16 16:48:38 + Log: From: Jarkko Hietaniemi + Date: Fri, 15 Jan 1999 17:28:34 +0200 (EET) + Message-Id: <199901151528.RAA08785@alpha.hut.fi> + Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: NetBSD patches + + From: Jarkko Hietaniemi + Date: Fri, 15 Jan 1999 18:44:19 +0200 (EET) + Message-Id: <199901151644.SAA08184@alpha.hut.fi> + Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: allow skipping the "install also as /usr/bin/perl" question of installperl + + From: Jarkko Hietaniemi + Date: Fri, 15 Jan 1999 18:52:29 +0200 (EET) + Message-Id: <199901151652.SAA11259@alpha.hut.fi> + Subject: the promised "installusrbinperl + NetBSD" fix + Branch: maint-5.005/perl + ! Configure Makefile.SH hints/netbsd.sh installperl + ! makedepend.SH unixish.h +____________________________________________________________________________ +[ 2613] By: gbarr on 1999/01/16 16:28:40 + Log: From: Laszlo Molnar + Date: Thu, 14 Jan 1999 22:37:26 +0100 + Message-ID: <19990114223726.A177@beeblebrox> + Subject: [PATCH for 5.005_03-MAINT_TRIAL_2] dos-djgpp update + Branch: maint-5.005/perl + ! djgpp/config.over djgpp/djgpp.c +____________________________________________________________________________ +[ 2612] By: gbarr on 1999/01/16 16:27:25 + Log: Hints for sco.sh to automatically support dynamic linking + + From: Peter Wolfe + Date: Mon, 11 Jan 1999 11:50:20 -0800 (PST) + Message-Id: <199901111950.LAA01703@titan.teloseng.com> + Subject: SCO 3.2v5 patch for perl5.005_03-MAINT_TRIAL_1 + Branch: maint-5.005/perl + ! hints/sco.sh +____________________________________________________________________________ +[ 2610] By: gbarr on 1999/01/14 03:07:33 + Log: Fix login in installperl for pods + + From: Robin Barker + Date: Mon, 4 Jan 1999 13:50:10 GMT + Message-Id: <199901041350.NAA19665@cyclone.cise.npl.co.uk> + Subject: PATCH to installperl + Branch: maint-5.005/perl + ! installperl +____________________________________________________________________________ +[ 2609] By: gbarr on 1999/01/14 03:04:37 + Log: Fix incorrect "used only once" warnings + + From: Ilya Zakharevich + Date: Fri, 8 Jan 1999 04:37:10 -0500 + Message-ID: <19990108043710.A14390@monk.mps.ohio-state.edu> + Subject: Re: change#965 flakiness + Branch: maint-5.005/perl + ! gv.c +____________________________________________________________________________ +[ 2608] By: gbarr on 1999/01/14 02:56:46 + Log: Fixed double GLOB de-reference + + From: Gurusamy Sarathy + Date: Sat, 09 Jan 1999 23:40:24 -0500 + Message-Id: <199901100440.XAA12360@aatma.engin.umich.edu> + Subject: Re: IO::Pipe with perl -d (on HPUX) + Branch: maint-5.005/perl + ! ext/IO/lib/IO/Pipe.pm +____________________________________________________________________________ +[ 2607] By: gbarr on 1999/01/14 02:53:40 + Log: Added Carp::cluck to perldelta.pod + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 2606] By: gbarr on 1999/01/14 02:44:04 + Log: New perlfaq*.pod from Tom (private mail) + Branch: maint-5.005/perl + ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod + ! pod/perlfaq9.pod +____________________________________________________________________________ +[ 2584] By: gbarr on 1999/01/08 04:50:56 + Log: implemented Ilya's suggested fix, and added a testcase + + From: Ilya Zakharevich + Date: Tue, 5 Jan 1999 00:56:01 -0500 (EST) + Message-Id: <199901050556.AAA02597@monk.mps.ohio-state.edu> + Subject: Re: Text::ParseWords: regex fix + Branch: maint-5.005/perl + ! lib/Text/ParseWords.pm t/lib/parsewords.t +____________________________________________________________________________ +[ 2583] By: gbarr on 1999/01/08 04:50:03 + Log: From: Jarkko Hietaniemi + Date: Thu, 7 Jan 1999 12:47:38 +0200 (EET) + Message-Id: <199901071047.MAA24100@alpha.hut.fi> + Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: ext/Errno_pm.PL: understand wrapper cppstdins + Branch: maint-5.005/perl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 2582] By: gbarr on 1999/01/08 03:37:55 + Log: More doc changes from Abigail, and included change #2575 from cfgperl + + From: abigail@fnx.com + Message-ID: <19990107041434.22326.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Time/gmtime.pm] Typo fix + Date: Wed, 6 Jan 1999 23:14:34 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107041746.22376.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Time/localtime.pm] Typo fix + Date: Wed, 6 Jan 1999 23:17:46 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107042105.22527.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/User/grent.pm] Typo fix + Date: Wed, 6 Jan 1999 23:21:05 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107042254.22624.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/User/pwent.pw] Typo fix + Date: Wed, 6 Jan 1999 23:22:54 -0500 (EST) + Branch: maint-5.005/perl + ! lib/Math/Trig.pm lib/Time/gmtime.pm lib/Time/localtime.pm + ! lib/User/grent.pm lib/User/pwent.pm +____________________________________________________________________________ +[ 2578] By: gbarr on 1999/01/07 04:30:26 + Log: From: Dan Sugalski + Date: Wed, 06 Jan 1999 13:47:34 -0800 + Message-Id: <3.0.6.32.19990106134734.0334d260@ous.edu> + Subject: [PATCH 5.005_02-MT2, 5.005_5x]VMS.C tweak for occasional system() error + Branch: maint-5.005/perl + ! vms/vms.c +____________________________________________________________________________ +[ 2577] By: gbarr on 1999/01/07 04:26:28 + Log: Another set of doc patches from Abigail + + From: abigail@fnx.com + Message-ID: <19990107032132.20124.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRAIL2 lib/Net/hostent.pm] Typo fix + Date: Wed, 6 Jan 1999 22:21:32 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107032445.20178.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Net/netent.pm] Typo fix + Date: Wed, 6 Jan 1999 22:24:45 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107032834.20362.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRAIL2 lib/Term/Complete.pm] Typo fix + Date: Wed, 6 Jan 1999 22:28:34 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107033136.20440.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRAIL2 lib/Term/ReadLine.pm] Typo fix + Date: Wed, 6 Jan 1999 22:31:36 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107033351.20540.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/CGI/Apache.pm] Typo fix + Date: Wed, 6 Jan 1999 22:33:51 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107033933.20707.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/CGI/Push.pm] Typo fix + Date: Wed, 6 Jan 1999 22:39:33 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107034548.20936.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/File/Copy.pm] Typo fixes + Date: Wed, 6 Jan 1999 22:45:48 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107034856.21056.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/File/Spec.pm] Typo fix + Date: Wed, 6 Jan 1999 22:48:56 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107035113.21174.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/File/Spec/Mac.pm] Typo fixes + Date: Wed, 6 Jan 1999 22:51:13 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107035612.21522.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Math/BigFloat.pm] Typo fix + Date: Wed, 6 Jan 1999 22:56:12 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107035842.21585.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Math/BigInt.pm] Typo fixes + Date: Wed, 6 Jan 1999 22:58:41 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107040644.22009.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Text/Wrap.pm] Typo fixes + Date: Wed, 6 Jan 1999 23:06:44 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107040955.22087.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Tie/Array.pm] Typo fixes + Date: Wed, 6 Jan 1999 23:09:55 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990107041136.22174.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/Tie/Hash.pm] Typo fix + Date: Wed, 6 Jan 1999 23:11:36 -0500 (EST) + Branch: maint-5.005/perl + ! lib/CGI/Apache.pm lib/CGI/Push.pm lib/File/Copy.pm + ! lib/File/Spec.pm lib/File/Spec/Mac.pm lib/Math/BigFloat.pm + ! lib/Math/BigInt.pm lib/Net/hostent.pm lib/Net/netent.pm + ! lib/Term/Complete.pm lib/Term/ReadLine.pm lib/Text/Wrap.pm + ! lib/Tie/Array.pm lib/Tie/Hash.pm +____________________________________________________________________________ +[ 2568] By: gbarr on 1999/01/06 03:13:15 + Log: From: jan.dubois@ibm.net (Jan Dubois) + Date: Wed, 06 Jan 1999 01:24:09 +0100 + Message-ID: <3696aa85.18259325@smtp1.ibm.net> + Subject: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds + Branch: maint-5.005/perl + ! embed.h global.sym objXSUB.h objpp.h perl.c proto.h + ! win32/GenCAPI.pl win32/makedef.pl +____________________________________________________________________________ +[ 2567] By: gbarr on 1999/01/06 02:31:28 + Log: From: Dan Sugalski + Date: Tue, 05 Jan 1999 16:47:31 -0800 + Message-Id: <3.0.6.32.19990105164731.00b5b2d0@ous.edu> + Subject: [PATCH 5.005_03-MAINT_TRIAL_2]taint.c fix for VMS + Branch: maint-5.005/perl + ! taint.c +____________________________________________________________________________ +[ 2566] By: gbarr on 1999/01/06 02:29:05 + Log: From: "W. Phillip Moore" + Date: Tue, 5 Jan 1999 12:40:27 -0500 (EST) + Message-ID: <13970.20107.190314.549471@zappa> + Subject: [PATCH] POSIX getpgrp is not -w clean + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.pm +____________________________________________________________________________ +[ 2565] By: gbarr on 1999/01/06 02:19:00 + Log: From: Slaven Rezic + Date: Mon, 4 Jan 1999 23:01:46 +0100 (CET) + Message-Id: <199901042201.XAA01875@cabulja.herceg.de> + Subject: FindBin.pm on Win32 systems + Branch: maint-5.005/perl + ! lib/FindBin.pm +____________________________________________________________________________ +[ 2564] By: gbarr on 1999/01/06 02:13:23 + Log: From: Mark Bixby + Date: Mon, 4 Jan 1999 13:34:58 -0800 (PST) + Message-Id: <199901042134.NAA18852@spock.dis.cccd.edu> + Subject: [PATCH 5.005_03-MAINT_TRIAL_2] t/op/sysio.t for MPE/iX + Branch: maint-5.005/perl + ! t/op/sysio.t +____________________________________________________________________________ +[ 2563] By: gbarr on 1999/01/06 02:03:44 + Log: From: Jarkko Hietaniemi + Date: Mon, 4 Jan 1999 19:25:03 +0200 (EET) + Message-Id: <199901041725.TAA30462@alpha.hut.fi> + Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: undo untrue HP-UX 64-bitness (mostly harmless but misleading) + Branch: maint-5.005/perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 2562] By: gbarr on 1999/01/06 02:02:18 + Log: Jumbo doc patch from Abigail + + From: abigail@fnx.com + Message-ID: <19990105170142.4889.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03-TRIAL2 lib/ExtUtils/Liblist.pm] pod fixes + Date: Tue, 5 Jan 1999 12:01:42 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105172855.5115.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 MAINT2 lib/ExtUtils/Commands.pm] Typo fix. + Date: Tue, 5 Jan 1999 12:28:55 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105173808.5260.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH perl5.005_03 MAINT3 lib/ExtUtils/Embed.pm] Typo fix + Date: Tue, 5 Jan 1999 12:38:08 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105174859.5533.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 MAINT2 lib/ExtUtils/Install.pm] Typo fix + Date: Tue, 5 Jan 1999 12:48:59 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105174947.5547.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 lib/ExtUtils/MM_Unix.pm] Typo fixes + Date: Tue, 5 Jan 1999 12:49:46 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105182301.5966.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 lib/ExtUtils/MakeMaker.pm] Typos fixes. + Date: Tue, 5 Jan 1999 13:23:00 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105183344.6065.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/ExtUtils/Manifest.pm] Typo fixes + Date: Tue, 5 Jan 1999 13:33:44 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990105184028.6220.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/ExtUtils/Mksymlists.pm] Typo fix + Date: Tue, 5 Jan 1999 13:40:28 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990106012015.9451.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/IO/Pipe.pm] Typo fixes. + Date: Tue, 5 Jan 1999 20:20:15 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990106012047.9459.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRAIL2 lib/IO/Seekable.pm] Typo fixes + Date: Tue, 5 Jan 1999 20:20:47 -0500 (EST) + + From: abigail@fnx.com + Message-ID: <19990106012338.9536.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_03 TRIAL2 lib/IO/Socket.pm] Typo fix + Date: Tue, 5 Jan 1999 20:23:38 -0500 (EST) + Branch: maint-5.005/perl + ! ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm + ! ext/IO/lib/IO/Socket.pm lib/ExtUtils/Command.pm + ! lib/ExtUtils/Embed.pm lib/ExtUtils/Install.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm + ! lib/ExtUtils/Mksymlists.pm +____________________________________________________________________________ +[ 2560] By: gbarr on 1999/01/03 16:59:01 + Log: Trial release 2 + Branch: maint-5.005/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 2559] By: gbarr on 1999/01/02 15:37:35 + Log: From: Blair Zajac + Date: Wed, 23 Dec 1998 17:13:32 -0800 + Message-ID: <3681953C.8B6A90AA@geostaff.com> + Subject: Tie::SubstrHash patch + Branch: maint-5.005/perl + ! lib/Tie/SubstrHash.pm +____________________________________________________________________________ +[ 2558] By: gbarr on 1999/01/02 15:30:01 + Log: integrate change #2544 + + From: Tim Bunce + Subject: bug in pod2man search for perl binary [5.005_5x] + Date: Sat, 12 Dec 1998 23:08:51 +0000 + Message-ID: <19981212230851.A20578@ig.co.uk> + Branch: maint-5.005/perl + !> pod/pod2man.PL +____________________________________________________________________________ +[ 2557] By: gbarr on 1999/01/02 15:20:42 + Log: integrate change #2548 + + From: Hugo van der Sanden + To: perl5-porters@perl.org + cc: hv@crypt0.demon.co.uk + Subject: [bug 5.004_54] duplicate error message + Date: Thu, 31 Dec 1998 04:05:25 +0000 + Message-Id: <199812310405.EAA00386@crypt.compulink.co.uk> + + Message-ID: <13963.60672.134591.383377@alias-2.pr.mcs.net> + From: Stephen McCamant + To: hv@crypt0.demon.co.uk + Cc: perl5-porters@perl.org + Subject: [PATCH _54] Re: duplicate error message + Date: Thu, 31 Dec 1998 16:10:13 -0600 (CST) + + Message-Id: <199901010732.HAA02926@crypt.compulink.co.uk> + From: Hugo van der Sanden + To: Stephen McCamant + cc: hv@crypt0.demon.co.uk, perl5-porters@perl.org + Subject: [TEST PATCH _54] Re: duplicate error message + Date: Fri, 01 Jan 1999 07:32:14 +0000 + Branch: maint-5.005/perl + ! op.c t/pragma/warn-1global taint.c +____________________________________________________________________________ +[ 2556] By: gbarr on 1999/01/02 15:18:58 + Log: From: abigail@fnx.com + Date: Mon, 28 Dec 1998 14:16:12 -0500 (EST) + Message-ID: <19981228191612.8380.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_02; lib/fields.pm] Typos in pod. + Branch: maint-5.005/perl + ! lib/fields.pm +____________________________________________________________________________ +[ 2555] By: gbarr on 1999/01/02 15:11:45 + Log: intregrate change #2547 + + From: Chris Nandor + Subject: Re: [PATCH] perlport.pod 1.38 + Date: Thu, 31 Dec 1998 09:06:48 -0500 + Message-Id: + Branch: maint-5.005/perl + !> pod/perlport.pod +____________________________________________________________________________ +[ 2543] By: gbarr on 1998/12/31 06:17:13 + Log: integrated relevant parts og changes #2385 & #2387 from mainline + + various fixes for race conditions under threads: mutex locks based + on PL_threadnum were seriously flawed, since it means more than one + thread could enter the critical region; PL_na was global instead of + thread-local; child thread could finish and free thr structures + before Thread->new() got around to creating the Thread object; + cv_clone() needed locking, as it mucks with PL_comppad and other + global data; new_struct_thread() needed to lock template-thread's + mutex while copying its data + + another threads reliability fix: serialize writes to thr->threadsv + avoid most uses of PL_na (which is much more inefficient than a + simple local); update docs to suit; PL_na now being thr->Tna may + be a minor compatibility issue for extensions--will require dTHR + outside of XSUBs (those get automatic dTHR) + Branch: maint-5.005/perl + ! XSUB.h djgpp/djgpp.c doio.c doop.c dump.c embedvar.h + ! ext/DynaLoader/dl_next.xs ext/IO/IO.xs ext/Opcode/Opcode.xs + ! ext/POSIX/POSIX.xs ext/Thread/Thread.xs ext/attrs/attrs.xs + ! gv.c malloc.c mg.c objXSUB.h op.c os2/OS2/REXX/REXX.xs + ! os2/os2.c perl.c perlvars.h perly.c perly.y pod/perlcall.pod + ! pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod pp.c pp.h + ! pp_ctl.c pp_hot.c pp_sys.c run.c sv.c taint.c thread.h toke.c + ! universal.c util.c vms/ext/Stdio/Stdio.xs vms/perly_c.vms + ! vms/vms.c win32/win32.c win32/win32thread.c +____________________________________________________________________________ +[ 2542] By: gbarr on 1998/12/30 14:46:40 + Log: doc updates + + From: abigail@fnx.com + Date: Wed, 23 Dec 1998 22:32:07 -0500 (EST) + Message-ID: <19981224033207.16751.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_02] Typo in documentation of pod2html. + + From: abigail@fnx.com + Date: Wed, 23 Dec 1998 22:59:59 -0500 (EST) + Message-ID: <19981224035959.16994.qmail@alexandra.wayne.fnx.com> + Subject: [PATCH 5.005_02] Re: m// doc is buggy (was Re: m'$foo' is undocumented) + + pod/perldelta.pod from: + From: Jarkko Hietaniemi + Date: Thu, 17 Dec 1998 16:13:34 +0200 (EET) + Message-ID: <13945.4494.140163.973953@alpha.hut.fi> + Subject: Re: important UNDOC issues for 5.005_54 + Branch: maint-5.005/perl + ! pod/perldelta.pod pod/perlop.pod pod/pod2html.PL +____________________________________________________________________________ +[ 2541] By: gbarr on 1998/12/30 14:37:14 + Log: From: jan.dubois@ibm.net (Jan Dubois) + Date: Wed, 23 Dec 1998 21:26:38 +0100 + Message-ID: <36895086.8849224@smtp1.ibm.net> + Subject: [PATCH 5.005_03m1] subdirectory Makefiles should inherit CAPI setting from command line + Branch: maint-5.005/perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 2538] By: gbarr on 1998/12/29 14:41:29 + Log: From: Jarkko Hietaniemi + Date: Tue, 22 Dec 1998 10:57:48 +0200 (EET) + Message-ID: <13951.24332.932827.831376@alpha.hut.fi> + Subject: Re: x operator broken in DEC Alpha for 8-bit characters (Re: Digest-MD5-2.00 test fails on DEC Alpha - a patch) + Branch: maint-5.005/perl + ! t/op/repeat.t util.c +____________________________________________________________________________ +[ 2535] By: gbarr on 1998/12/29 14:27:56 + Log: From: Jarkko Hietaniemi + Date: Fri, 18 Dec 1998 16:39:27 +0200 (EET) + Message-ID: <13946.26911.140905.387070@alpha.hut.fi> + Subject: Math::Trig, Math::Complex, Fcntl, addressed (Re: Undocumentation Issues for 5.005) + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 2534] By: gbarr on 1998/12/29 14:23:02 + Log: From: Jarkko Hietaniemi + Date: Tue, 15 Dec 1998 17:52:32 +0200 (EET) + Message-ID: <13942.34240.66558.169330@alpha.hut.fi> + Subject: some doc link fixes + Branch: maint-5.005/perl + ! pod/perlcall.pod pod/perldata.pod pod/perldiag.pod + ! pod/perlfaq5.pod pod/perlfaq7.pod pod/perlfunc.pod + ! pod/perlguts.pod pod/perllocale.pod pod/perlobj.pod + ! pod/perlsub.pod pod/perlvar.pod +____________________________________________________________________________ +[ 2533] By: gbarr on 1998/12/29 14:23:00 + Log: From: Chris Nandor + Date: Sat, 19 Dec 1998 12:54:34 -0500 + Message-Id: + Subject: [PATCH] perlport.pod v1.37 + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 2531] By: gbarr on 1998/12/29 14:12:25 + Log: change in_pod pattern to /^=\w/ from /^=/ + From: Frank Ridderbusch + Date: Tue, 15 Dec 1998 16:23:12 +0100 (MET) + Message-ID: <13942.32480.700000.640927@utensil> + Subject: Minor Bug in AutoSplit.qm in 5.005 and 5.004 + Branch: maint-5.005/perl + ! lib/AutoSplit.pm +____________________________________________________________________________ +[ 2530] By: gbarr on 1998/12/29 14:09:51 + Log: undo the "perlsyn intrusion" into perlfunc + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 2529] By: gbarr on 1998/12/29 14:04:35 + Log: From: Jarkko Hietaniemi + Date: Sun, 13 Dec 1998 14:54:56 +0200 (EET) + Message-Id: <199812131254.OAA24494@koah.research.nokia.com> + Subject: ignore_versioned_libs isn't used anywhere (it became ignore_versioned_solibs) + Branch: maint-5.005/perl + ! hints/linux.sh +____________________________________________________________________________ +[ 2528] By: gbarr on 1998/12/29 13:59:49 + Log: From: Ilya Zakharevich + Date: Wed, 28 Oct 1998 01:20:33 -0500 (EST) + Message-Id: <199810280620.BAA06893@monk.mps.ohio-state.edu> + Subject: [PATCH 5.00552] Make sort respect overloading + Branch: maint-5.005/perl + ! pp_ctl.c t/pragma/overload.t +____________________________________________________________________________ +[ 2527] By: gbarr on 1998/12/29 13:58:56 + Log: doc update, quads only work on 64-but platforms + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 2526] By: gbarr on 1998/12/29 13:49:55 + Log: From: Andy Dougherty + Date: Tue, 1 Dec 1998 12:50:27 -0500 (EST) + Message-Id: + Subject: [PATCH 5.005_xx] erroneous 'none' in lddlflags + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2512] By: gbarr on 1998/12/28 14:56:36 + Log: change t/op/pwent.t to ignore NIS includes + From: achampio@lehman.com (Alan Champion) + Date: Tue, 1 Dec 1998 15:18:03 GMT + Message-Id: <9812011518.AA00005@lonhpov1.lehman.com> + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_1 on sun4-solaris 2.3 (UNINSTALLED) + + From: pvhp@forte.com (Peter Prymmer) + Date: Fri, 4 Dec 98 17:11:41 PST + Message-Id: <9812050111.AA16778@forte.com> + Subject: [PATCH 5.005_03-MAINT_TRIAL_1 && 5.005_54]dumper and searchdict ebcdic style + Branch: maint-5.005/perl + ! t/lib/dumper.t t/lib/searchdict.t t/op/pwent.t +____________________________________________________________________________ +[ 2511] By: gbarr on 1998/12/28 14:55:28 + Log: From: jan.dubois@ibm.net (Jan Dubois) + Date: Tue, 01 Dec 1998 00:07:33 +0100 + Message-ID: <366921b5.14512598@smtp1.ibm.net> + Subject: Re: 5.005_03-MAINT-TRIAL1, [PATCH] to compile on Win32 + + From: jan.dubois@ibm.net (Jan Dubois) + Date: Wed, 02 Dec 1998 00:24:54 +0100 + Message-ID: <366a77bb.19498126@smtp1.ibm.net> + Subject: Re: 5.005_03-MAINT-TRIAL1, [PATCH] spaces in filenames support + Branch: maint-5.005/perl + ! perl.h proto.h taint.c win32/GenCAPI.pl win32/Makefile + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_sh.PL win32/makedef.pl +____________________________________________________________________________ +[ 2510] By: gbarr on 1998/12/28 14:37:35 + Log: From: Ilya Zakharevich + Date: Tue, 1 Dec 1998 00:34:08 -0500 (EST) + Message-Id: <199812010534.AAA21371@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Debugger 'v' command + Branch: maint-5.005/perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 2478] By: gbarr on 1998/12/13 16:02:24 + Log: From: pvhp@forte.com (Peter Prymmer) + Date: Mon, 30 Nov 98 21:08:36 PST + Message-Id: <9812010508.AA07791@forte.com> + Subject: [PATCH 5.005_03t1 && 5.005_54]dll linkage side decks for OS/390 + Branch: maint-5.005/perl + ! hints/os390.sh +____________________________________________________________________________ +[ 2477] By: gbarr on 1998/12/13 16:00:23 + Log: From: Dan Sugalski + Date: Mon, 30 Nov 1998 17:08:12 -0800 + Message-Id: <3.0.6.32.19981130170812.00b12b70@ous.edu> + Subject: [PATCH 5.005_03]Minor VMS patches needed to build + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_VMS.pm vms/subconfigure.com +____________________________________________________________________________ +[ 2476] By: gbarr on 1998/12/13 15:30:58 + Log: From: pvhp@forte.com (Peter Prymmer) + Date: Fri, 4 Dec 98 00:37:32 PST + Message-Id: <9812040837.AA10908@forte.com> + Subject: Re: [PATCH 5.005_03-MAINT-TRIAL1] some tweaks to the build process for OS/390 + Branch: maint-5.005/perl + ! Makefile.SH regcomp.c +____________________________________________________________________________ +[ 2472] By: gbarr on 1998/12/12 17:12:28 + Log: undo changes to Exporter.pm from #2312 + Branch: maint-5.005/perl + ! lib/Exporter.pm +____________________________________________________________________________ +[ 2471] By: gbarr on 1998/12/12 17:09:39 + Log: integrate change#2459 from cfgperl + + enclose case want_vtbl_collxfrm with #ifdef USE_LOCALE_COLLATE + + From: hansm@icgroup.nl + Subject: Not OK: perl 5.00503 +MAINT_TRIAL_1 on OPENSTEP-Mach 4_1 (UNINSTALLED) + Date: Sun, 6 Dec 98 22:19:54 +0100 + Message-Id: <9812062116.AA26445@icgned.icgroup.nl> + Branch: maint-5.005/perl + ! util.c +____________________________________________________________________________ +[ 2470] By: gbarr on 1998/12/12 16:46:03 + Log: re-sync'd Text::Wrap with new version from CPAN + Branch: maint-5.005/perl + +> t/lib/textfill.t + ! MANIFEST + !> lib/Text/Wrap.pm t/lib/textwrap.t +____________________________________________________________________________ +[ 2469] By: gbarr on 1998/12/12 15:58:43 + Log: integrate changes#2435,2436 from cfgperl + + Pod::Html and Pod::Text were not locale-savvy: + for example in =head1 all non-ASCII-\w-runs were + turned into underscores in NAME tags. This could + result in several NAME tags becoming identical. + Reported by: + + From: Fyodor Krasnov + Subject: pod2html vs Russian Characters + To: Tom.Christiansen@snn.aha.ru, tchrist@perl.com + Date: Tue, 24 Nov 1998 19:00:36 +0300 (MSK) + Message-Id: <199811241600.TAA05149@stat.aha.ru> + + One paste too many in #2435. + Branch: maint-5.005/perl + !> lib/Pod/Html.pm lib/Pod/Text.pm +____________________________________________________________________________ +[ 2468] By: gbarr on 1998/12/12 15:01:58 + Log: redirect trail program to error msg file in Configure + + From: Andy Dougherty + Date: Tue, 1 Dec 1998 13:40:12 -0500 (EST) + Message-Id: + Subject: [PATCH 5.005_xx] Missing redirection of simple test program + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2467] By: gbarr on 1998/12/12 14:52:24 + Log: Change reall_srchlen back to an int from a #define + + From: Graham Barr + Date: Mon, 30 Nov 1998 14:29:14 -0600 + Message-ID: <19981130142914.X1504@asic.sc.ti.com> + Subject: [PATCH 5.005_03-MT!] Re: one compilation warning from 5_03-MT1 + Branch: maint-5.005/perl + ! malloc.c +____________________________________________________________________________ +[ 2466] By: gbarr on 1998/12/12 14:40:56 + Log: s/SCM_CREDENTIALSS/SCM_CREDENTIALs/ in Socket.xs + + From: Andy Dougherty + Date: Thu, 3 Dec 1998 11:26:25 -0500 (EST) + Message-Id: + Subject: [PATCH 5.005_03-MAINT_TRIAL_1] Trivial grammar patch + Branch: maint-5.005/perl + ! Porting/Glossary + !> ext/Socket/Socket.xs +____________________________________________________________________________ +[ 2456] By: gsar on 1998/12/06 13:49:02 + Log: branch perldelta.pod + Branch: maint-5.005/perl + +> pod/perldelta.pod +____________________________________________________________________________ +[ 2455] By: gsar on 1998/12/06 13:47:21 + Log: clobber perldelta.pod to reestablish branch from perl5005delta.pod + Branch: maint-5.005/perl + - pod/perldelta.pod +____________________________________________________________________________ +[ 2415] By: gbarr on 1998/11/30 02:31:15 + Log: Chnages,patchlevel.h etc... + Branch: maint-5.005/perl + ! Changes MANIFEST patchlevel.h t/op/tr.t win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 2411] By: gbarr on 1998/11/30 01:31:22 + Log: integrated changes#2323,2353,2369 + + From: maeda@src.ricoh.co.jp + Date: Tue, 24 Nov 1998 10:37:45 +0900 + Message-Id: <199811240137.KAA05867@luna.src.ricoh.co.jp> + Subject: format "..." bug + + Locale collation, ctype, and numeric, were initialized wrong + (if LC_ALL or LANG were unset, so were the collation/ctype/numeric), + as reported by + + From: Ilya.Sandler@etak.com (Ilya Sandler) + Subject: a bug in locale handling: LC_COLLATE ignored sometimes + Date: 25 Nov 1998 04:53:52 +0200 + Message-ID: + + allow final period in a file (not followed by a newline) to + terminate format spec + Branch: maint-5.005/perl + ! pp_ctl.c toke.c util.c + !> t/op/write.t +____________________________________________________________________________ +[ 2408] By: gbarr on 1998/11/30 01:29:19 + Log: integrated ext/B/... changes from mainline + Branch: maint-5.005/perl + !> ext/B/B.pm ext/B/B.xs ext/B/B/Assembler.pm ext/B/B/C.pm + !> ext/B/B/Disassembler.pm +____________________________________________________________________________ +[ 2404] By: gbarr on 1998/11/30 00:26:36 + Log: integrate some of change#2318 from mainline + Branch: maint-5.005/perl + +> t/op/grent.t t/op/pwent.t + !> ext/DB_File/Changes ext/DB_File/DB_File.pm + !> ext/DB_File/DB_File.xs ext/POSIX/hints/dynixptx.pl + !> ext/Socket/Socket.pm ext/Socket/Socket.xs lib/Benchmark.pm + !> pod/perldata.pod t/op/sort.t +____________________________________________________________________________ +[ 2398] By: gbarr on 1998/11/29 22:11:16 + Log: integrate changes#2254,2259,2335,2345,2348,2361,2368,2380 from mainline + + win32_recvfrom() compatibility fix + + From: "Kurt D. Starsinic" + Subject: Re: [PATCH] Re: pod2man bug in date generated line + To: Albert Dvornik , "Larry W. Virden" + Cc: perlbug@perl.com + Date: 20 Nov 1998 21:30:17 +0200 + Message-ID: + + make $1 et al readonly under threads; make C fail like + C<$1 = undef> does + + fix typo in pp_defined() causing C to fail + + more conservative version of changes#2345,2346,2347; those break + C which seems to be extensively used in + the libs :-( + + fix uninitialized warnings + From: Brian Callaghan + Date: Thu, 19 Nov 1998 17:49:10 -0800 + Message-Id: <3654CA96.B64FCAEB@itginc.com> + Subject: Complete.pm patch (version 1.1) + + Liblist tweak suggested by Swen Thuemmler ; + add C<$Config{installarchlib}/CORE> to the default locations searched + on win32 + + prefer IO::Handle for IO if FileHandle:: is empty (as suggested by + Tim Bunce) + Branch: maint-5.005/perl + ! gv.c op.c pp.c + !> lib/ExtUtils/Liblist.pm lib/Term/Complete.pm pod/perlfaq4.pod + !> pod/pod2man.PL t/op/undef.t win32/win32sck.c +____________________________________________________________________________ +[ 2315] By: gbarr on 1998/11/27 05:16:50 + Log: integrate change#2246 from mainline, while still allowing + C + + allow C + Branch: maint-5.005/perl + ! op.c sv.c + !> t/op/sort.t +____________________________________________________________________________ +[ 2314] By: gbarr on 1998/11/27 04:03:58 + Log: integrate change#2159 from mainline + + Data::Dumper update + Branch: maint-5.005/perl + !> ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm + !> ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Todo t/lib/dumper.t +____________________________________________________________________________ +[ 2313] By: gbarr on 1998/11/27 03:04:21 + Log: Fix typo in change#2312 + Branch: maint-5.005/perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 2312] By: gbarr on 1998/11/27 03:03:03 + Log: integrate change#1837,1967,1986,2060,2068,2146,2214,2224,2300,2301 from mainline + + (via private mail) + From: Charles Bailey + Date: Sat, 05 Sep 1998 01:23:58 -0400 (EDT) + Message-id: <01J1FH7R43NS002F14@cor.newman.upenn.edu> + Subject: [Patch 5.005_02] Miscellaneous VMS cleanup + + correct bugs exposed in MM_Unix.pm by commenting out Selfloader + (MAN3PODS cannot be set to ' '; stray stricture violation) + + qualify names of builtins + + handle '::' in section names properly + From: Graham Barr + Date: Sat, 17 Oct 1998 12:57:54 -0500 + Message-ID: <19981017125754.C510@pobox.com> + Subject: Re: pod2html + + From: Zachary Miller + Date: Tue, 20 Oct 1998 20:52:20 -0500 + Message-Id: <199810210152.UAA07792@simon.er.usgs.gov> + Subject: Exporter.pm's export_to_level() argument handling buggy + + hand-apply whitespace-mutiliated patch + From: "vishal bhatia" + Date: Wed, 28 Oct 1998 23:45:32 PST + Message-ID: <19981029074534.2334.qmail@hotmail.com> + Subject: [PATCH 5.005_52]Compiling modules,more bugfixes for B + + typo in newHVhv() + + avoid endless loops in Text::Wrap (from a suggestion by Lupe + Christoph ) + + properly free temporaries created by threads + + fix PL_defoutgv leak under threads + Branch: maint-5.005/perl + !> (integrate 31 files) +____________________________________________________________________________ +[ 2311] By: gbarr on 1998/11/27 01:31:36 + Log: integrate change#2210 from mainline + + fix AvREALISH bogusness + Branch: maint-5.005/perl + ! av.c + !> t/op/array.t +____________________________________________________________________________ +[ 2310] By: gbarr on 1998/11/27 00:20:21 + Log: integrate changes#2235,2299,2300 from mainline + + catch a neophyte trap: open(), close() etc. + + fix C misoptimization that fails + to set the package for the block properly + + properly free temporaries created by threads + Branch: maint-5.005/perl + ! ext/Thread/Thread.xs op.c perl.h util.c + !> t/comp/package.t +____________________________________________________________________________ +[ 2309] By: gbarr on 1998/11/27 00:16:36 + Log: integrate change#2298 from mainline + Branch: maint-5.005/perl + !> universal.c +____________________________________________________________________________ +[ 2308] By: gbarr on 1998/11/27 00:11:44 + Log: Updates for MPE/iX DynaLoader and installperl, via private mail + forwarded by Jarkko Hietaniemi from Mark Bixby + Branch: maint-5.005/perl + ! ext/DynaLoader/dl_mpeix.xs installperl +____________________________________________________________________________ +[ 2307] By: gbarr on 1998/11/27 00:07:27 + Log: Remove docs for feature not in _0* + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 2306] By: gbarr on 1998/11/26 23:44:47 + Log: Allow PL_FILES to have multiple targets from one source by allowing + an array ref as the value in the hash + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 2305] By: gbarr on 1998/11/26 23:38:06 + Log: fix unsigned variables to use SvUV and sv_setuv + Branch: maint-5.005/perl + ! lib/ExtUtils/typemap +____________________________________________________________________________ +[ 2304] By: gbarr on 1998/11/26 23:36:17 + Log: Fix embeded \n in ABSTRACT and <> in AUTHOR + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 2302] By: gbarr on 1998/11/26 15:27:03 + Log: integrate changes#2177,2189,2228,2229 from cfgperl + + 0**0 = 1, from + + From: d-lewart@uiuc.edu (Daniel S. Lewart) + Subject: Math::Complex 0**0 patches + Date: Sun, 1 Nov 1998 19:21:48 -0600 (CST) + Message-Id: <199811020121.TAA28310@staff2.cso.uiuc.edu> + + sysio.t failure: fix undefined order of evaluation, from + + From: Spider Boardman + Subject: Not OK: perl 5.00553 on alpha-thread 5.0 [PATCH] + Date: 4 Nov 1998 01:22:30 +0200 + Message-ID: + + From: "Martin J. Bligh" + Message-ID: <187803647.910720870@w-186d219.rhe.sequent.com> + Subject: Re: Making Perl work on DYNIX/ptx + Date: Tue, 10 Nov 1998 18:01:10 -0800 + + From: "Martin J. Bligh" + Subject: Re: Making Perl work on DYNIX/ptx + Date: Tue, 10 Nov 1998 16:24:26 -0800 + Message-ID: <181999655.910715066@w-186d219.rhe.sequent.com> + Branch: maint-5.005/perl + +> ext/DB_File/hints/dynixptx.pl ext/POSIX/hints/dynixptx.pl + ! pp_sys.c + !> hints/dynixptx.sh lib/Math/Complex.pm t/lib/complex.t +____________________________________________________________________________ +[ 2297] By: gbarr on 1998/11/24 02:32:38 + Log: integrate change#2266 from cfgperl + From: John Tobey + Subject: [PATCH] perlfaq typos + To: perl5-porters@perl.com + Date: 22 Nov 1998 04:25:15 +0200 + Message-ID: + Branch: maint-5.005/perl + !> pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + !> pod/perlfaq7.pod pod/perlfaq8.pod +____________________________________________________________________________ +[ 2296] By: gbarr on 1998/11/24 01:39:18 + Log: integrated changes#2011,2092,2106,2108,2143 from cfgperl + + More robust yacc/bison failure output handling. + + More robustness. + + Bison says 'parse error', not 'parser error'. + + The "parse error" must be converted to "syntax error", + just matching it aint' enough. + + There can be multiple yacc/bison errors. + Branch: maint-5.005/perl + !> t/comp/require.t t/op/misc.t t/pragma/subs.t + !> t/pragma/warning.t +____________________________________________________________________________ +[ 2295] By: gbarr on 1998/11/24 00:49:28 + Log: integrate change#1823 from mainline + From: Joe Buehler + Date: 29 Aug 1998 17:13:28 -0400 + Message-ID: + Subject: patches for perl 5.005_51 under U/WIN + Branch: maint-5.005/perl + +> hints/uwin.sh + ! Configure + !> installman makedepend.SH t/lib/posix.t +____________________________________________________________________________ +[ 2258] By: gbarr on 1998/11/21 20:48:02 + Log: Another Configure patch from Jarkko + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 2257] By: gbarr on 1998/11/21 17:23:13 + Log: Big Configure patch from Jarkko Hietaniemi via + private mail + Branch: maint-5.005/perl + ! Configure Makefile.SH config_h.SH hints/dec_osf.sh + ! hints/freebsd.sh hints/irix_6.sh hints/linux.sh + ! hints/next_3.sh hints/os390.sh pp_sys.c +____________________________________________________________________________ +[ 2239] By: gbarr on 1998/11/14 03:59:58 + Log: more doc changes from mainline + Branch: maint-5.005/perl + ! pod/perldiag.pod pod/perlfunc.pod pod/perlre.pod + !> INSTALL README.vms vms/ext/Stdio/Stdio.pm +____________________________________________________________________________ +[ 2238] By: gbarr on 1998/11/14 02:51:51 + Log: integrate doc changes from mainline, including + changes#1796,1811,1830,1831,1844,1846,1876,1905,2149,2152 + Branch: maint-5.005/perl + !> README.os390 pod/perl.pod pod/perldelta.pod pod/perlfaq1.pod + !> pod/perlform.pod pod/perlfunc.pod pod/perlguts.pod + !> pod/perlipc.pod pod/perllocale.pod pod/perlport.pod + !> pod/perlref.pod pod/perlrun.pod pod/perlvar.pod pod/perlxs.pod + !> pod/pod2man.PL +____________________________________________________________________________ +[ 2237] By: gbarr on 1998/11/14 02:51:49 + Log: integrate change#1847 from mainline + From: Roderick Schertler + Date: Wed, 09 Sep 1998 23:52:48 -0400 + Message-ID: <20567.905399568@eeyore.ibcinc.com> + Subject: seed srand from /dev/urandom when possible + Branch: maint-5.005/perl + ! pp.c +____________________________________________________________________________ +[ 2232] By: gbarr on 1998/11/13 03:12:37 + Log: integrate change#2215 from mainline + set close-on-exec bit on pipe() FDs + Branch: maint-5.005/perl + ! pod/perlfunc.pod pod/perlvar.pod pp_sys.c +____________________________________________________________________________ +[ 2231] By: gbarr on 1998/11/13 02:16:03 + Log: integrate change#2188 from mainline + fix return value of win32_pclose() + Branch: maint-5.005/perl + !> win32/win32.c +____________________________________________________________________________ +[ 2218] By: gbarr on 1998/11/08 16:48:44 + Log: From: Graham Barr + Date: Mon, 2 Nov 1998 07:38:52 -0600 + Message-ID: <19981102073852.A12751@asic.sc.ti.com> + Subject: [PATCH 5.005_*] Re: IPC::Msg 1.03 + Branch: maint-5.005/perl + ! ext/IPC/SysV/Msg.pm +____________________________________________________________________________ +[ 2217] By: gbarr on 1998/11/08 05:22:39 + Log: fix changes in 2213 not to break binary compat + Branch: maint-5.005/perl + ! pp_ctl.c proto.h +____________________________________________________________________________ +[ 2216] By: gbarr on 1998/11/08 04:21:01 + Log: integrate change#2192 from mainline + indeterminate order-of-evaluation fixes + Branch: maint-5.005/perl + ! mg.c +____________________________________________________________________________ +[ 2213] By: gbarr on 1998/11/08 00:39:44 + Log: integrate change#2051 from mainline + properly restore PL_rsfp_filters after require + Branch: maint-5.005/perl + ! embed.h global.sym objXSUB.h objpp.h pp_ctl.c proto.h scope.c + ! scope.h +____________________________________________________________________________ +[ 2212] By: gbarr on 1998/11/07 23:13:29 + Log: integrate changes#1914,1925,1926,1945,1956,1987 from mainline + + normalize tm struct passed to strftime() with mktime() + From: Spider Boardman + Date: Wed, 30 Sep 1998 15:12:09 -0400 + Message-Id: <199809301912.PAA26119@Orb.Nashua.NH.US> + Subject: [PATCH 5.005_52] Re: POSIX::strftime returns incorrect date + + disable USE_THREADS when PERL_OBJECT is enabled + + From: Mark-Jason Dominus + Date: Sun, 04 Oct 1998 14:48:11 -0400 + Message-ID: <19981004184811.16048.qmail@plover.com> + Subject: PATCH: perldoc -f does not locate -e, -r, -x, etc. + + defer "deep recursion" warnings until CXt_SUB context is properly + set up + + Mutexen should be initialized only once. + + perldoc pod update + From: Daniel Grisinger + Date: 06 Oct 1998 23:56:51 -0600 + Message-ID: + Subject: [PATCH _02 and _52] perldoc + Branch: maint-5.005/perl + ! gv.c op.c pp_hot.c + !> ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs utils/perldoc.PL + !> win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 2207] By: gbarr on 1998/11/06 01:36:17 + Log: integrate changes#1912,1948 from mainline + change warning about glob process failure + Branch: maint-5.005/perl + ! pod/perldiag.pod pp_hot.c +____________________________________________________________________________ +[ 2200] By: gbarr on 1998/11/05 04:26:26 + Log: integrate changes#1840,1855,1860,1882,1884,1891,1900,1907 from mainline + pl2bat tweak from Tye McQueen + + reset errno after C search (as suggested by Larry) + + upgrade to CPAN-1.40 + + missing file in last submit (1881) + + temporarily disable perl malloc for a2p until we clean up + conflicting malloc() declarations everywhere + + Fixed apostrophe problem from Mark Knutsen. + + use SETERRNO() to reset errno (suggested by Charles Bailey) + + applied patches, but retained old behavior for win32 (where compilers + can't read from stdin at all) + From: Graham Barr + Date: Mon, 28 Sep 1998 09:41:49 -0500 + Message-ID: <19980928094149.B26576@asic.sc.ti.com> + Subject: Re: 5.005_51 Errno invokes cpprun incorrectly + -- + Date: Tue, 29 Sep 1998 12:35:43 -0500 + Message-ID: <19980929123543.Z26576@asic.sc.ti.com> + Subject: Re: 5.005_51 Errno invokes cpprun incorrectly + + and ext/Errno/Errno_pm.PL from change#2050 + Branch: maint-5.005/perl + ! perl.h pp_ctl.c proto.h sv.h + !> ext/Errno/Errno_pm.PL lib/CPAN.pm lib/CPAN/FirstTime.pm + !> win32/bin/pl2bat.pl x2p/Makefile.SH +____________________________________________________________________________ +[ 2199] By: gbarr on 1998/11/05 03:35:00 + Log: integrate changes#1817,1856,1869,1909 from mainline + updated usethreads hints for hpux 10.X + From: Matthew T Harden + Date: Fri, 28 Aug 1998 14:10:42 GMT + Message-Id: <199808281410.AA11058@mthard1.monsanto.com> + Subject: Re: OK: perl 5.00502 on PA-RISC1.1-thread 10.20 (UNINSTALLED) + + update hints for OPENSTEP 4.2 on i386 + From: Gerben Wierda + Date: Sun, 20 Sep 1998 01:03:18 +0200 + Message-Id: <9809192303.AA29190@Spike> + Subject: Perl 5.005_02 compilation problems + + use STRICT_ALIGNMENT on IRIX to allow usemymalloc=y again + From: Scott Henry + Date: 13 Aug 1998 09:52:15 PDT + Message-Id: + Subject: [PATCH] Irix USE_LONG_LONG/malloc.c incompatibility (was...) + + update SCO hints for dynamic loading + From: Andy Dougherty + Date: Mon, 28 Sep 1998 16:50:38 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_04-MAINT_TRIAL_5 and 5.005_xx] Re: Perl on SCO_SV + -- + Date: Tue, 29 Sep 1998 16:48:55 -0400 (EDT) + Message-Id: + Subject: Re: [PATCH 5.004_04-MAINT_TRIAL_5 and 5.005_xx] Re: Perl on SCO_SV + Branch: maint-5.005/perl + !> hints/hpux.sh hints/irix_6.sh hints/next_4.sh hints/sco.sh +____________________________________________________________________________ +[ 2198] By: gbarr on 1998/11/05 03:00:51 + Log: integrate OS2 changes from mainline, change#1836,1930,1996,2063 + and os2/os2,c from #2145 + + From: Ilya Zakharevich + Date: Sat, 5 Sep 1998 00:14:51 -0400 (EDT) + Message-Id: <199809050414.AAA19801@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] OS/2 spawning typos + + From: Ilya Zakharevich + Message-Id: <199810050637.CAA07781@monk.mps.ohio-state.edu> + Date: Mon, 5 Oct 1998 02:37:43 -0400 (EDT) + Subject: [PATCH 5.005_52] Cumulative OS/2-related patch + + From: Ilya Zakharevich + Date: Tue, 13 Oct 1998 04:46:00 -0400 (EDT) + Message-Id: <199810130846.EAA00769@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_52] Memory overrun in os2.c + + From: Ilya Zakharevich + Date: Sun, 18 Oct 1998 23:20:57 -0400 (EDT) + Message-Id: <199810190320.XAA28249@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Improve sbrk() on OS/2 + + remaining PL_foo stragglers + Branch: maint-5.005/perl + ! mg.c perl_exp.SH util.c + !> hints/os2.sh os2/Changes os2/Makefile.SHs os2/os2.c +____________________________________________________________________________ +[ 2197] By: gbarr on 1998/11/05 02:15:53 + Log: integrate changes#1826,1862 from mainline + + From: Jarkko Hietaniemi + Date: Wed, 12 Aug 1998 22:41:37 +0300 (EET DST) + Message-Id: <199808121941.WAA06263@alpha.hut.fi> + Subject: [PATCH] 5.004_50 or 5.005_02: get rid of interp.sym because not even AIX needs it + + remove bogus warn() + Branch: maint-5.005/perl + - interp.sym + ! MANIFEST Makefile.SH embed.pl perl_exp.SH +____________________________________________________________________________ +[ 2194] By: gbarr on 1998/11/05 01:26:46 + Log: integarte malloc.c changes from mainline change#1807,2112,2133 + Branch: maint-5.005/perl + !> malloc.c +____________________________________________________________________________ +[ 2193] By: gbarr on 1998/11/05 01:25:31 + Log: integrate changes#1763,1778,1801,1804 from mainline + + From: Stephen McCamant + Date: Sun, 2 Aug 1998 16:33:18 -0500 (CDT) + Message-ID: <13764.55116.921952.837027@alias-2.pr.mcs.net> + Subject: [PATCH] Eliminate superfluous RV2p[AH]Vs in oops[AH]V() + + Implicit require during compile reset line numbering + + silence redefined warning for XS(INIT) {} + + From: Laszlo Molnar + Date: Sun, 9 Aug 1998 22:38:23 +0200 + Message-ID: <19980809223823.A215@cdata.tvnet.hu> + Subject: [PATCH 5.5002] dos-djgpp update + Branch: maint-5.005/perl + ! op.c pp_ctl.c + !> t/io/fs.t +____________________________________________________________________________ +[ 2176] By: gbarr on 1998/11/02 04:51:48 + Log: integrate change#2030 from mainline + + fix handling of mayhaps-extended @_ in goto &sub + Branch: maint-5.005/perl + ! av.c pp_ctl.c + !> t/op/goto.t +____________________________________________________________________________ +[ 2175] By: gbarr on 1998/11/02 04:32:02 + Log: integrate chnage#1934,1935 from mainline + fix USE_THREADS coredump due to uninitialized PL_hv_fetch_ent_mh + add test for previous fix + Branch: maint-5.005/perl + ! util.c + !> ext/Thread/create.t +____________________________________________________________________________ +[ 2174] By: gbarr on 1998/11/02 04:22:20 + Log: integrate change#1863,1881 from mainline + + provide locked access to string table for USE_THREADS + + serial access to PL_x[inpr]v_root for USE_THREADS + Branch: maint-5.005/perl + ! embedvar.h objXSUB.h perl.c proto.h sv.c + !> hv.c intrpvar.h thread.h +____________________________________________________________________________ +[ 2173] By: gbarr on 1998/11/02 04:10:46 + Log: integrate change#1990 from mainline + + provide option to enable optimization with VC (suggested by Jan + Dubois) + Branch: maint-5.005/perl + !> win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 2172] By: gbarr on 1998/11/02 02:52:29 + Log: integrate changes#1944,1948,1966 from mainline + + change#1614 merely disabled earlier fix (doh!); undo it and properly + fixup the cop_seq value that must be seen by lexical lookups that + emanate within eval'' + + tweak to make fix in change#1944 behave correctly for closures + created within eval'' + Branch: maint-5.005/perl + ! op.c pp_ctl.c pp_hot.c scope.c + !> cop.h t/op/eval.t +____________________________________________________________________________ +[ 2171] By: gbarr on 1998/11/01 03:59:39 + Log: integrate changes 1835,2003,2067 and File::Find change in 1938 + warn on C + + silence -w noises (suggested by Greg Bacon) Term::Complete + + From: jan.dubois@ibm.net (Jan Dubois) + Date: Wed, 21 Oct 1998 00:55:51 +0200 + Message-ID: <36380269.55370608@smtp1.ibm.net> + Subject: Make _really_ sure Dynaloader.xs code is initialized only once + Branch: maint-5.005/perl + ! op.c pod/perldiag.pod + !> ext/DynaLoader/DynaLoader_pm.PL lib/File/Find.pm + !> lib/Term/Complete.pm +____________________________________________________________________________ +[ 2170] By: gbarr on 1998/11/01 03:48:38 + Log: integrate change 1992 from mainline + + applied suggested patch with small doc tweak + From: Gisle Aas + Date: 11 Oct 1998 12:53:13 +0200 + Message-ID: + Subject: Re: [PATCH 5.005_52] Optional syswrite LENGTH argument + Branch: maint-5.005/perl + ! pod/perlfunc.pod pp_sys.c + !> opcode.h opcode.pl t/op/sysio.t t/op/tiehandle.t +____________________________________________________________________________ +[ 2168] By: gbarr on 1998/11/01 01:58:58 + Log: From: jan.dubois@ibm.net (Jan Dubois) + Date: Fri, 09 Oct 1998 23:28:31 +0200 + Message-ID: <36217b7f.3193091@smtp1.ibm.net> + Subject: [PATCH 5.005_02] Allow XS access to vtbl_*s when compiled with PERL_OBJECT + Branch: maint-5.005/perl + ! XSUB.h +____________________________________________________________________________ +[ 2167] By: gbarr on 1998/11/01 01:22:41 + Log: integrate change#2029 from mainline + restore sanity to "constant" references + Branch: maint-5.005/perl + ! op.c pod/perldiag.pod + !> lib/constant.pm t/pragma/constant.t +____________________________________________________________________________ +[ 2166] By: gbarr on 1998/11/01 01:04:24 + Log: integrate changes#1895,1896,2066,2147,2148 from mainline + fix win32_stat() to do the right thing for share names + + small tweak on last change + + recognize '%' as a shell metachar for win32 + From: jan.dubois@ibm.net (Jan Dubois) + Date: Tue, 20 Oct 1998 21:57:35 +0200 + Message-ID: <3636ea31.49170453@smtp1.ibm.net> + Subject: [PATCH 5.005_02, Win32] Re: %ENV% not expanded in backquotes? + + tweaked version of suggested patch + From: Anton Berezin + Date: 29 Oct 1998 14:48:54 +0100 + Message-ID: <86yapzv5q1.fsf@lion.plab.ku.dk> + Subject: [PATCH 5.005_52] One more problem with win32_stat and MSVC + + From: Anton Berezin + Date: 29 Oct 1998 17:06:25 +0100 + Message-ID: <86pvbbuzcu.fsf@lion.plab.ku.dk> + Subject: [PATCH 5.005_52] win32_opendir() fails on empty drives + Branch: maint-5.005/perl + !> win32/win32.c +____________________________________________________________________________ +[ 2165] By: gbarr on 1998/11/01 00:10:15 + Log: integrated changes#1941,1942,1943,1975,2061,2111,2151 from mainline + + don't longjmp() in pp_goto() (regressive bug from old single-stack + implementation) + + force copy of substrings when matching against temporaries + + ensure recursive attempts to findlex()icals know enough about where + the last eval'' context was encountered + + propagate typeness of lexicals while cloning them + + From: Graham Barr + Date: Sat, 17 Oct 1998 22:22:02 -0500 + Message-ID: <19981017222202.J510@pobox.com> + Subject: Re: '*' prototype does not allow bareword with strict + + smarter C<$SIG{FOO} = BAREWORD;> warning + + From: Mark-Jason Dominus + Date: Fri, 30 Oct 1998 14:24:23 EST + Message-Id: <19981030192423.27276.qmail@plover.com> + Subject: PATCH: (5.005_02) a2p should use `chomp' instead of `chop' + Branch: maint-5.005/perl + ! op.c pp_ctl.c pp_hot.c t/op/pat.t toke.c + !> t/op/eval.t t/op/runlevel.t x2p/walk.c +____________________________________________________________________________ +[ 2158] By: gbarr on 1998/10/31 05:03:02 + Log: integrate changes#1821 & 1857 from mainline + + s/runops/CALLRUNOPS/ + + From: Ilya Zakharevich + Date: Tue, 22 Sep 1998 17:30:16 -0400 (EDT) + Message-Id: <199809222130.RAA17034@monk.mps.ohio-state.edu> + Subject: More verbose Test::Harness [PATCH] + Branch: maint-5.005/perl + !> cc_runtime.h lib/Test/Harness.pm +____________________________________________________________________________ +[ 2157] By: gbarr on 1998/10/31 02:35:07 + Log: integrate change#1839 from mainline + From: Drago Goricanec + Date: Mon, 7 Sep 1998 17:36:09 +0900 + Message-Id: <199809070836.RAA14631@raptor.otsd.ts.fujitsu.co.jp> + Subject: Thread::cond_wait bug in 5.005.51 causes deadlock + Branch: maint-5.005/perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 2156] By: gbarr on 1998/10/31 02:22:11 + Log: integrate change#1829 from mainline + fix problematic typecast in filter_del() + From: Mark P Lutz + Date: Mon, 31 Aug 1998 21:13:11 GMT + Message-Id: <199808312113.VAA53356@triton.ca.boeing.com> + Subject: perl5.005_02 does not build on Cray T90 + Branch: maint-5.005/perl + ! toke.c +____________________________________________________________________________ +[ 2155] By: gbarr on 1998/10/31 01:59:08 + Log: integrate chnages#1824,2118 from mainline + From: Ilya Zakharevich + Date: Sat, 29 Aug 1998 17:38:30 -0400 (EDT) + Message-Id: <199808292138.RAA18359@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Protect debugger from nonlocal exits + + From: Ilya Zakharevich + Date: Wed, 28 Oct 1998 01:23:27 -0500 (EST) + Message-Id: <199810280623.BAA06968@monk.mps.ohio-state.edu> + Subject: [PATCH 5.00552] Minor debugger tweaks + Branch: maint-5.005/perl + !> lib/perl5db.pl +____________________________________________________________________________ +[ 2154] By: gbarr on 1998/10/31 01:06:35 + Log: integrate all lib/ExtUtils/... changes from mainline + Branch: maint-5.005/perl + !> lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm + !> lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm + !> lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mkbootstrap.pm + !> lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 2139] By: gbarr on 1998/10/30 04:17:53 + Log: apply chnage#2071 from mainline + From: Graham Barr + Date: Sat, 17 Oct 1998 20:42:41 -0500 + Message-ID: <19981017204241.G510@pobox.com> + Subject: Re: taint checking for: use lib "$ENV{'EVIL'}" + Branch: maint-5.005/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 2138] By: gbarr on 1998/10/30 04:14:35 + Log: apply change#2077 from mainline + From: Graham Barr + Date: Sat, 24 Oct 1998 21:45:50 -0500 + Message-ID: <19981024214550.C508@pobox.com> + Subject: Re: die with a reference should use overload "" operator + Branch: maint-5.005/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 2137] By: gbarr on 1998/10/30 04:01:06 + Log: integrate change#1937 from mainline + fix $/ init for USE_THREADS + Branch: maint-5.005/perl + ! perl.c +____________________________________________________________________________ +[ 2136] By: gbarr on 1998/10/30 03:40:55 + Log: apply change#2076 from mainline + From: Graham Barr + Date: Sat, 24 Oct 1998 12:45:21 -0500 + Message-ID: <19981024124521.C512@pobox.com> + Subject: [PATCH 5.005_02] Re: Auto-incrementing tied scalar causes SEGV + Branch: maint-5.005/perl + ! sv.c +____________________________________________________________________________ +[ 2135] By: gbarr on 1998/10/30 03:28:29 + Log: integrate change#1873 from mainline + From: Ilya Zakharevich + Date: Tue, 25 Aug 1998 04:29:49 -0400 (EDT) + Message-Id: <199808250829.EAA02470@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Extraneous warning for (?()A|B) + Branch: maint-5.005/perl + ! regcomp.c +____________________________________________________________________________ +[ 2134] By: gbarr on 1998/10/30 03:15:12 + Log: integrate change#1816 from mainline + don't create empty directories in installperl + From: Robin Barker + Date: Fri, 21 Aug 1998 11:29:24 +0100 (BST) + Message-Id: <199808211029.LAA00551@cyclone.cise.npl.co.uk> + Subject: [PATCH 5.005_02] install: empty dirs + Branch: maint-5.005/perl + !> installperl +____________________________________________________________________________ +[ 2132] By: gbarr on 1998/10/30 01:39:00 + Log: integrate changes#1815 & 1828 from mainline + make behavior of /(a{3})+/ like /(aaa)+/ w.r.t where it matches + From: Ilya Zakharevich + Date: Fri, 21 Aug 1998 05:41:02 -0400 (EDT) + Message-Id: <199808210941.FAA16467@monk.mps.ohio-state.edu> + Subject: Re: your mail + + From: Ilya Zakharevich + Date: Mon, 31 Aug 1998 14:52:10 -0400 (EDT) + Message-Id: <199808311852.OAA24676@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_5*] (?>) broken in RE + Branch: maint-5.005/perl + ! regexec.c + !> t/op/re_tests +____________________________________________________________________________ +[ 2131] By: gbarr on 1998/10/30 01:09:19 + Log: integrate change#1947 from mainline + let docatch() pass the buck when restartop turns out to be null, + making exceptions in BEGIN{} propagate as expected + Branch: maint-5.005/perl + ! pp_ctl.c + !> t/op/misc.t +____________________________________________________________________________ +[ 2129] By: gbarr on 1998/10/29 14:53:11 + Log: integrate change#1810 from mainline + fix bogus integerization of pop()'s return value + From: Gurusamy Sarathy + Date: Sat, 15 Aug 1998 23:27:54 -0400 + Message-Id: <199808160327.XAA05186@aatma.engin.umich.edu> + Subject: Re: Complex expression does integer arithmetic + Branch: maint-5.005/perl + !> opcode.h opcode.pl +____________________________________________________________________________ +[ 2128] By: gbarr on 1998/10/29 14:28:13 + Log: integrate change#1870 from mainline + From: Dan Sugalski + Date: Fri, 14 Aug 1998 09:20:16 PDT + Message-Id: <3.0.5.32.19980814092016.00b37dc0@ous.edu> + Subject: [PATCH 5.005_02] (and _5x I expect) VMS config procedure patch + Branch: maint-5.005/perl + !> configure.com +____________________________________________________________________________ +[ 2127] By: gbarr on 1998/10/29 13:36:29 + Log: Integrate change#1789 from mainline + delay freeing itervar so C works + Branch: maint-5.005/perl + !> cop.h t/cmd/for.t +____________________________________________________________________________ +[ 2123] By: gbarr on 1998/10/29 02:43:01 + Log: Apply change#2075 from mainline + fix C etc. + Branch: maint-5.005/perl + ! toke.c +____________________________________________________________________________ +[ 2122] By: gbarr on 1998/10/29 02:40:31 + Log: Apply change#2070 from mainline + avoid bogus line number in XSUB redefined warnings + Branch: maint-5.005/perl + ! op.c +____________________________________________________________________________ +[ 2121] By: gbarr on 1998/10/29 02:38:59 + Log: Apply change#2052 from mainline + avoid the circular refcnt logic in magic_mutexfree() + Branch: maint-5.005/perl + ! mg.c pp.c pp_hot.c +____________________________________________________________________________ +[ 2120] By: gbarr on 1998/10/29 02:36:23 + Log: Remove "5.005" hard-coded and expose vtbl_* from the perl DLL + From: "Douglas Lankshear" + Date: Mon, 28 Sep 1998 08:49:13 -0700 + Message-ID: <000001bdeaf7$8a189350$a32fa8c0@tau.Active> + Subject: PATCH [5.005_02] update + Branch: maint-5.005/perl + ! embed.h global.sym objXSUB.h objpp.h perl.h proto.h util.c + ! win32/win32.c +____________________________________________________________________________ +[ 2084] By: gbarr on 1998/10/25 19:09:11 + Log: Integrate change#2069 from mainline + From: Martijn Koster + Date: Wed, 21 Oct 1998 13:12:03 +0100 + Message-ID: <19981021131203.A15661@excitecorp.com> + Subject: File::Path::mkpath reports the wrong error + Branch: maint-5.005/perl + !> lib/File/Path.pm +____________________________________________________________________________ +[ 2083] By: gbarr on 1998/10/25 18:48:39 + Log: Integrate change#1965 from mainline + use better numbers for exitstatus test + Branch: maint-5.005/perl + !> t/op/die_exit.t +____________________________________________________________________________ +[ 2082] By: gbarr on 1998/10/25 18:22:54 + Log: Apply change 2054 from mainline + disallow 'x' in hex numbers (except leading '0x') + From: Gisle Aas + Date: 16 Oct 1998 16:33:12 +0200 + Message-ID: + Subject: Re: [PATCH 5.005_52] 'x' is not a legal hex digit + Branch: maint-5.005/perl + ! perlvars.h util.c + !> t/op/oct.t +____________________________________________________________________________ +[ 2081] By: gbarr on 1998/10/25 17:58:04 + Log: Apply change #1998 from mainline + skip readonly vars and unref references when doing a reset() + Branch: maint-5.005/perl + ! sv.c +____________________________________________________________________________ +[ 2080] By: gbarr on 1998/10/25 16:06:35 + Log: Integrate changes #2072 & #1993 from mainline + fix bug in B::CC::pp_sassign() + From: "vishal bhatia" + Date: Sun, 11 Oct 1998 18:41:38 PDT + Message-ID: <19981012014139.19614.qmail@hotmail.com> + Subject: B::CC problems with pp_sassign routine + implement C and other fixes (via private mail) + From: "vishal bhatia" + Date: Wed, 21 Oct 1998 22:59:03 PDT + Message-Id: <19981022055904.20083.qmail@hotmail.com> + Subject: [PATCH 5.005_52] More fixes for B + Branch: maint-5.005/perl + !> ext/B/B.pm ext/B/B.xs ext/B/B/C.pm ext/B/B/CC.pm +____________________________________________________________________________ +[ 2079] By: gbarr on 1998/10/25 14:08:00 + Log: integrate from mainline more FSF address changes + Branch: maint-5.005/perl + !> Copying ext/B/README lib/Getopt/Long.pm +____________________________________________________________________________ +[ 2053] By: gbarr on 1998/10/25 04:56:47 + Log: From: Graham Barr + Date: Sat, 17 Oct 1998 23:05:18 -0500 + Message-ID: <19981017230518.K510@pobox.com> + Subject: Re: redo LOOP not restoring $` $' $& + Branch: maint-5.005/perl + ! cop.h t/cmd/while.t +____________________________________________________________________________ +[ 2048] By: gbarr on 1998/10/24 04:20:10 + Log: Change Free Software Foundation address in README + Branch: maint-5.005/perl + !> README +____________________________________________________________________________ +[ 2047] By: gbarr on 1998/10/24 04:02:20 + Log: Remove #ifdef DEBUGGING around SvTEMP_off + From: Gurusamy Sarathy + Date: Mon, 28 Sep 1998 15:23:39 -0400 + Message-Id: <199809281923.PAA10303@aatma.engin.umich.edu> + Subject: Re: [PATCH] Re: 5.005_52: the miniperl coredump: touch magic and you're toast + Branch: maint-5.005/perl + ! scope.c +____________________________________________________________________________ +[ 2046] By: gbarr on 1998/10/24 04:00:54 + Log: use cpp symbols instead of hardwired constants + From: Hugo van der Sanden + Date: Mon, 05 Oct 1998 09:23:33 +0100 + Message-Id: <199810050823.JAA00891@crypt.compulink.co.uk> + Subject: [PATCH 5.005_52] By the numbers (resend) + Branch: maint-5.005/perl + ! op.c +____________________________________________________________________________ +[ 2045] By: gbarr on 1998/10/24 03:50:25 + Log: squelch undef warnings + From: Hugo van der Sanden + Date: Fri, 02 Oct 1998 11:01:14 +0100 + Message-Id: <199810021001.LAA19214@crypt.compulink.co.uk> + Subject: [PATCH] Re: Apparent bug in Math::BigInt + Branch: maint-5.005/perl + !> lib/Math/BigInt.pm +____________________________________________________________________________ +[ 2044] By: gbarr on 1998/10/24 03:47:24 + Log: Add note to INSTALL about ANSI C + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 2043] By: gbarr on 1998/10/24 02:38:12 + Log: make C AUTOLOAD-aware (autouse now works for modules + that are autoloaded) + From: Gurusamy Sarathy + Date: Thu, 24 Sep 1998 03:01:01 -0400 + Message-Id: <199809240701.DAA16223@aatma.engin.umich.edu> + Subject: Re: autouse and Getopt::Long don't work together anymore + Branch: maint-5.005/perl + ! pp_ctl.c t/op/goto.t +____________________________________________________________________________ +[ 2042] By: gbarr on 1998/10/24 02:16:26 + Log: From: jarkko.hietaniemi@research.nokia.com (Jarkko Hietaniemi) + Date: Wed, 12 Aug 1998 15:42:35 +0300 + Message-Id: <199808121242.PAA29761@comanche.spices> + Subject: [PATCH] 5.004_02 or 5.005_51: fix regexp and tr character ranges in non-ASCII lands + Branch: maint-5.005/perl + + t/op/tr.t + ! MANIFEST perl.h pod/perllocale.pod pod/perlop.pod + ! pod/perlre.pod regcomp.c t/pragma/locale.t toke.c +____________________________________________________________________________ +[ 2021] By: gbarr on 1998/10/20 01:25:23 + Log: From: Chip Salzenberg + Date: Tue, 6 Oct 1998 13:33:05 -0400 + Message-ID: <19981006133305.A2348@perlsupport.com> + Subject: [PATCH] 5.005_02: Eliminate leak on self-ties + Branch: maint-5.005/perl + ! av.c doop.c hv.c mg.c mg.h pp.c pp_hot.c pp_sys.c scope.c + ! t/op/tie.t +____________________________________________________________________________ +[ 2015] By: gbarr on 1998/10/17 21:49:56 + Log: make h2xs generate ANSI prototypes + Branch: maint-5.005/perl + !> utils/h2xs.PL +____________________________________________________________________________ +[ 2014] By: gbarr on 1998/10/17 20:31:42 + Log: Fix POSIX::sigprocmask not to check type of $old parameter + as it is output only + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 2013] By: gbarr on 1998/10/17 17:51:16 + Log: From: "Kurt D. Starsinic" + Date: Thu, 20 Aug 1998 20:59:03 -0400 + Message-ID: <19980820205903.A12908@O2.chapin.edu> + Subject: [PATCH] h2ph misquotes #error directives + + fix h2ph handling of C<#error "foo"> + From: SAKAI Kiyotaka + Date: Thu, 10 Sep 1998 09:59:33 +0900 + Message-Id: <19980910095933N.ksakai@netwk.ntt-at.co.jp> + Subject: [5.005_02] h2ph problem + Branch: maint-5.005/perl + !> t/lib/h2ph.pht utils/h2ph.PL +____________________________________________________________________________ +[ 1985] By: gbarr on 1998/10/17 00:41:40 + Log: s/last/first/ typo in append_list() + Branch: maint-5.005/perl + ! op.c +____________________________________________________________________________ +[ 1984] By: gbarr on 1998/10/17 00:36:51 + Log: From: "Green, Paul" + Date: Thu, 10 Sep 1998 00:02:07 -0400 + Message-ID: <646CD0392810D211B04A00A024BF26FB1022EB@terminator.sw.stratus.com> + Subject: RE: [PATCH] 5.005_02 and 5.005_51: Stratus VOS port + Branch: maint-5.005/perl + + README.vos vos/Changes vos/build.cm vos/compile_perl.cm + + vos/config.h vos/config_h.SH_orig vos/perl.bind + + vos/test_vos_dummies.c vos/vos_dummies.c vos/vosish.h + ! MANIFEST perl.c perl.h pod/perlport.pod +____________________________________________________________________________ +[ 1983] By: gbarr on 1998/10/17 00:23:31 + Log: define PUT_svindex(), PUT_opindex() + Branch: maint-5.005/perl + !> ext/B/B/Assembler.pm +____________________________________________________________________________ +[ 1982] By: gbarr on 1998/10/17 00:20:57 + Log: From: Jochen Wiedmann + Date: Thu, 17 Sep 1998 17:16:06 +0200 + Message-ID: <360127B6.E44564A@ispsoft.de> + Subject: [PATCH] ExtUtils::MakeMaker::prompt cannot return 0 + Branch: maint-5.005/perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1981] By: gbarr on 1998/10/16 02:58:10 + Log: better CR-handling on shebang line and in formats (fixed variant of + patch suggested by Igor Sysoev ) + Branch: maint-5.005/perl + ! perl.c toke.c +____________________________________________________________________________ +[ 1980] By: gbarr on 1998/10/16 02:21:57 + Log: From: Roderick Schertler + Date: 11 Sep 1998 16:19:21 -0400 + Message-ID: + Subject: Re: Open2 and memory leaks + Branch: maint-5.005/perl + !> lib/IPC/Open3.pm +____________________________________________________________________________ +[ 1979] By: gbarr on 1998/10/16 02:15:54 + Log: integrate change #1908 from mainline + Branch: maint-5.005/perl + !> lib/File/Find.pm +____________________________________________________________________________ +[ 1977] By: gbarr on 1998/10/16 01:52:46 + Log: tests missing from change #1794 + Branch: maint-5.005/perl + ! t/op/re_tests +____________________________________________________________________________ +[ 1794] By: gbarr on 1998/09/20 15:59:20 + Log: From: Ilya Zakharevich + Date: Tue, 11 Aug 1998 18:43:29 -0400 (EDT) + Message-Id: <199808112243.SAA14243@monk.mps.ohio-state.edu> + Subject: Re: Segmentation fault for /a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz/ + Branch: maint-5.005/perl + ! regcomp.c t/op/re_tests +____________________________________________________________________________ +[ 1793] By: gbarr on 1998/09/20 15:39:41 + Log: From: Peter Prymmer + Date: Mon, 10 Aug 98 16:58:22 PDT + Message-Id: <9808102358.AA10616@forte.com> + Subject: fix for unpack('u') failures on OS/390 + Branch: maint-5.005/perl + ! pp.c +____________________________________________________________________________ +[ 1792] By: gbarr on 1998/09/20 15:11:33 + Log: From: "M.J.T. Guy" + Date: Sun, 9 Aug 1998 15:51:48 +0100 + Message-Id: + Subject: Fix typo, change "an array" to "a hash" + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1791] By: gbarr on 1998/09/20 14:49:26 + Log: From: Gurusamy Sarathy + Date: Wed, 16 Sep 1998 22:13:17 -0400 + Message-Id: <199809170213.WAA10546@aatma.engin.umich.edu> + Subject: fill gaps in sig_* entries in win32/config.?c + and resync win32/config.?c with Porting/config.sh to pick up apiversion + Branch: maint-5.005/perl + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1790] By: gbarr on 1998/09/20 14:40:56 + Log: From: Gurusamy Sarathy + Date: Sun, 06 Sep 1998 15:35:11 -0400 + Message-Id: <199809061935.PAA21531@aatma.engin.umich.edu> + Subject: suppress bogus warning on C + Branch: maint-5.005/perl + ! toke.c +____________________________________________________________________________ +[ 1784] By: nick on 1998/09/12 09:53:36 + Log: Two tweaks to allow quiet compile qith egcs-1.1 + Branch: maint-5.005/perl + ! win32/win32.h +____________________________________________________________________________ +[ 1783] By: gbarr on 1998/09/07 20:33:11 + Log: Subject: index() applied BM optimization to wrong argument + From: larry@wall.org (Larry Wall) + Date: Thu, 3 Sep 1998 12:49:13 -0700 + Message-Id: <199809031949.MAA29566@wall.org>, <199809060004.RAA23792@wall.org> + Branch: maint-5.005/perl + ! op.c util.c +____________________________________________________________________________ +[ 1782] By: gbarr on 1998/09/07 18:54:49 + Log: From: Gurusamy Sarathy + Date: Fri, 28 Aug 1998 00:33:15 -0400 + Mssage-Id: <199808280433.AAA06767@aatma.engin.umich.edu> + Subject: socket problems on NT + Branch: maint-5.005/perl + ! objXSUB.h +____________________________________________________________________________ +[ 1759] By: gsar on 1998/08/08 20:57:47 + Log: pending submit of 5.005_02 + Branch: maint-5.005/perl + ! Changes + +---------------- Version 5.005_02 Second maintenance release of 5.005 ---------------- diff --git a/contrib/perl5/Configure b/contrib/perl5/Configure index bc5c59d..5bcdbda 100755 --- a/contrib/perl5/Configure +++ b/contrib/perl5/Configure @@ -21,7 +21,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # # Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70] -# (with additional metaconfig patches by doughera@lafayette.edu) +# (with additional metaconfig patches by jhi@iki.fi) cat >/tmp/c1$$ </dev/null`" in - foox) - trnl='\n' - ;; - esac -fi -if test X"$trnl" = X; then - case "`echo foo|tr '\012' x 2>/dev/null`" in - foox) - trnl='\012' - ;; - esac -fi -if test -n "$DJGPP"; then - trnl='\012' -fi -if test X"$trnl" = X; then - cat <&2 - -$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. - -EOM - exit 1 -fi - : Proper separator for the PATH environment variable p_=: : On OS/2 this directory should exist if this is not floppy only system :-] @@ -193,6 +166,7 @@ d_xenix='' eunicefix='' Mcc='' ar='' +full_ar='' awk='' bash='' bison='' @@ -359,6 +333,14 @@ d_flexfnam='' d_flock='' d_fork='' d_fsetpos='' +i_sysmount='' +d_fstatfs='' +d_statfsflags='' +i_sysstatvfs='' +d_fstatvfs='' +i_mntent='' +d_getmntent='' +d_hasmntopt='' d_ftime='' d_gettimeod='' d_Gconvert='' @@ -391,7 +373,6 @@ d_getservprotos='' d_getsbyname='' d_getsbyport='' d_gnulibc='' -i_arpainet='' d_htonl='' d_inetaton='' d_isascii='' @@ -431,6 +412,8 @@ d_portable='' d_pthread_yield='' d_sched_yield='' d_pthreads_created_joinable='' +i_pthread='' +i_machcthreads='' d_readdir='' d_rewinddir='' d_seekdir='' @@ -540,6 +523,7 @@ dlsrc='' ld='' lddlflags='' usedl='' +ebcdic='' doublesize='' fpostype='' gidtype='' @@ -548,6 +532,7 @@ h_fcntl='' h_sysfile='' db_hashtype='' db_prefixtype='' +i_arpainet='' i_db='' i_dbm='' i_rpcsvcdbm='' @@ -633,6 +618,7 @@ libpth='' loclibpth='' plibpth='' xlibpth='' +ignore_versioned_solibs='' libs='' lns='' lseektype='' @@ -697,11 +683,13 @@ randbits='' installscript='' scriptdir='' scriptdirexp='' +selectminbits='' selecttype='' sh='' sig_name='' sig_name_init='' sig_num='' +sig_num_init='' installsitearch='' sitearch='' sitearchexp='' @@ -719,6 +707,7 @@ startperl='' startsh='' stdchar='' sysman='' +trnl='' uidtype='' nm_opt='' nm_so_opt='' @@ -733,7 +722,6 @@ mips_type='' usrinc='' defvoidused='' voidflags='' -ebcdic='' CONFIG='' define='define' @@ -741,6 +729,12 @@ undef='undef' smallmach='pdp11 i8086 z8000 i80286 iAPX286' rmlist='' +installusrbinperl='' + +ccsymbols='' +cppsymbols='' +cppccsymbols='' + : We must find out about Eunice early eunicefix=':' if test -f /etc/unixtovms; then @@ -836,6 +830,8 @@ plibpth='' : default library list libswanted='' +: some systems want only to use the non-versioned libso:s +ignore_versioned_solibs='' : Possible local include directories to search. : Set locincpth to "" in a hint file to defeat local include searches. locincpth="/usr/local/include /opt/local/include /usr/gnu/include" @@ -904,8 +900,7 @@ case "$sh" in $me: Fatal Error: I can't find a Bourne Shell anywhere. Usually it's in /bin/sh. How did you even get this far? -Please contact me (Andy Dougherty) at doughera@lafayette.edu and -we'll try to straighten this all out. +Please contact perlbug@perl.com and we'll try to straighten this all out. EOM exit 1 ;; @@ -1240,7 +1235,7 @@ cat >extract <<'EOS' CONFIG=true echo "Doing variable substitutions on .SH files..." if test -f $src/MANIFEST; then - set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH'` + set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH$'` else echo "(Looking for .SH files under the source directory.)" set x `(cd $src; find . -name "*.SH" -print)` @@ -1373,7 +1368,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE. You have the option of continuing the configuration process, despite the distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o -and contact the author (doughera@lafayette.edu). +and then contact perlbug@perl.com. EOM echo $n "Continue? [n] $c" >&4 @@ -1396,6 +1391,30 @@ else fi rm -f missing x?? +echo " " +: Find the appropriate value for a newline for tr +if test -n "$DJGPP"; then + trnl='\012' +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\n' x 2>/dev/null`" in + foox) trnl='\n' ;; + esac +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\012' x 2>/dev/null`" in + foox) trnl='\012' ;; + esac +fi +if test X"$trnl" = X; then + cat <&2 + +$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. + +EOM + exit 1 +fi + : compute the number of columns on the terminal for proper question formatting case "$COLUMNS" in '') COLUMNS='80';; @@ -1574,7 +1593,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (doughera@lafayette.edu) know how I blew it. +have, let perlbug@perl.com know how I blew it. This installation script affects things in two ways: @@ -1841,14 +1860,14 @@ ABYZ) *C9D1*|*c9d1*) echo "Hey, this might be EBCDIC." >&4 if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in + case "`echo IJ | $tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in ij) up='[A-IJ-RS-Z]' low='[a-ij-rs-z]' ;; esac fi if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in + case "`echo IJ | $tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in ij) up='A-IJ-RS-Z' low='a-ij-rs-z' ;; @@ -1941,7 +1960,7 @@ EOM (cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to doughera@lafayette.edu + : tests or hints, please send them to perlbug@perl.com : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix @@ -1968,6 +1987,12 @@ EOM osvers="$2.$3" fi fi + $test -f /sys/posix.dll && + $test -f /usr/bin/what && + set X `/usr/bin/what /sys/posix.dll` && + $test "$3" = UWIN && + osname=uwin && + osvers="$5" if $test -f $uname; then set X $myuname shift @@ -1982,7 +2007,11 @@ EOM [23]100) osname=mips ;; next*) osname=next ;; i386*) - if $test -f /etc/kconfig; then + tmp=`/bin/uname -X 2>/dev/null|awk '/3\.2v[45]/{ print $(NF) }'` + if $test "$tmp" != "" -a "$3" = "3.2" -a -f '/etc/systemid'; then + osname='sco' + osvers=$tmp + elif $test -f /etc/kconfig; then osname=isc if test "$lns" = "ln -s"; then osvers=4 @@ -1992,6 +2021,7 @@ EOM osvers=2 fi fi + unset tmp ;; pc*) if test -n "$DJGPP"; then @@ -2025,7 +2055,7 @@ EOM osvers="$3" ;; dynixptx*) osname=dynixptx - osvers="$3" + osvers=`echo "$4" | $sed 's/^v//'` ;; freebsd) osname=freebsd osvers="$3" ;; @@ -2386,26 +2416,26 @@ cat <&4 <pdp11.c <<'EOP' -main() { +int main() { #ifdef pdp11 exit(0); #else @@ -3442,7 +3498,11 @@ cat <<'EOT' >testcpp.c ABC.XYZ EOT cd .. +if test ! -f cppstdin; then echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin +else + echo "Keeping your $hint cppstdin wrapper." +fi chmod 755 cppstdin wrapper=`pwd`/cppstdin ok='false' @@ -3566,7 +3626,7 @@ false) esac case "$cppstdin" in -"$wrapper") ;; +"$wrapper"|'cppstdin') ;; *) $rm -f $wrapper;; esac $rm -f testcpp.c testcpp.out @@ -3693,7 +3753,8 @@ case "$libswanted" in esac for thislib in $libswanted; do - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then + if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; + $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then echo "Found -l$thislib (shared)." case " $dflt " in *"-l$thislib "*);; @@ -3838,11 +3899,7 @@ if $xxx; then esac; fi' -if ./osf1; then - set signal.h __LANGUAGE_C__; eval $inctest -else - set signal.h LANGUAGE_C; eval $inctest -fi +set signal.h LANGUAGE_C; eval $inctest case "$hint" in none|recommended) dflt="$ccflags $dflt" ;; @@ -3980,10 +4037,21 @@ rmlist="$rmlist pdp11" : coherency check echo " " echo "Checking your choice of C compiler and flags for coherency..." >&4 +$cat > try.c <<'EOF' +#include +int main() { printf("Ok\n"); exit(0); } +EOF set X $cc $optimize $ccflags -o try $ldflags try.c $libs shift -$cat >try.msg <try.msg <<'EOM' +I've tried to compile and run the following simple program: + +EOM +$cat try.c >> try.msg + +$cat >> try.msg < try.c <<'EOF' -#include -main() { printf("Ok\n"); exit(0); } -EOF dflt=y if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then if sh -c './try' >>try.msg 2>&1; then @@ -4031,7 +4095,7 @@ y) $cat try.msg >&4 case "$knowitall" in '') - echo "(The supplied flags might be incorrect with this C compiler.)" + echo "(The supplied flags or libraries might be incorrect.)" ;; *) dflt=n;; esac @@ -4149,9 +4213,8 @@ eval $inhdr : determine which malloc to compile in echo " " case "$usemymalloc" in -''|y*|true) dflt='y' ;; -n*|false) dflt='n' ;; -*) dflt="$usemymalloc" ;; +''|[yY]*|true|$define) dflt='y' ;; +*) dflt='n' ;; esac rp="Do you wish to attempt to use the malloc that comes with $package?" . ./myread @@ -4227,7 +4290,7 @@ $rm -f malloc.[co] echo " " echo "Checking out function prototypes..." >&4 $cat >prototype.c <<'EOCP' -main(int argc, char *argv[]) { +int main(int argc, char *argv[]) { exit(0);} EOCP if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then @@ -4253,7 +4316,7 @@ understands function prototypes. Unfortunately, your C compiler $cc $ccflags doesn't seem to understand them. Sorry about that. -If GNU cc is avaiable for your system, perhaps you could try that instead. +If GNU cc is available for your system, perhaps you could try that instead. Eventually, we hope to support building Perl with pre-ANSI compilers. If you would like to help in that effort, please contact . @@ -4296,6 +4359,29 @@ else installbin="$binexp" fi +echo " " +if test -d /usr/bin -a "X$installbin" != X/usr/bin; then + $cat <&4 -cat >tebcdic.c <&4 - val="$define" - else - echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 - fi -else - echo "I'm unable to compile the test program." >&4 - echo "I'll asuume ASCII or some ISO Latin." >&4 -fi -$rm -f tebcdic.c tebcdic -set ebcdic -eval $setvar - -echo " " echo "Checking for GNU C Library..." >&4 cat >gnulibc.c < -int -main() +int main() { #ifdef __GLIBC__ exit(0); @@ -4664,6 +4723,10 @@ elif com="$sed -n -e 's/.*\.text n\ \ \ \.//p'";\ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun +elif com="sed -n -e 's/^__.*//' -e 's/[ ]*D[ ]*[0-9]*.*//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun else $nm -p $* 2>/dev/null >libc.tmp $grep fprintf libc.tmp > libc.ptf @@ -4719,7 +4782,7 @@ nm_extract="$com" if $test -f /lib/syscalls.exp; then echo " " echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4 - $sed -n 's/^\([^ ]*\)[ ]*syscall$/\1/p' /lib/syscalls.exp >>libc.list + $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*$/\1/p' /lib/syscalls.exp >>libc.list fi ;; esac @@ -4750,7 +4813,7 @@ yes) else tval=false; fi;; *) - echo "main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c; + echo "int main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c; if $cc $optimize $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1; then tval=true; else tval=false; @@ -4899,7 +4962,7 @@ EOM /* Test for whether ELF binaries are produced */ #include #include -main() { +int main() { char b[4]; int i = open("a.out",O_RDONLY); if(i == -1) @@ -4944,6 +5007,7 @@ EOM linux|irix*) dflt='-shared' ;; next) dflt='none' ;; solaris) dflt='-G' ;; + beos) dflt='-nostart' ;; sunos) dflt='-assert nodefinitions' ;; svr4*|esix*) dflt="-G $ldflags" ;; *) dflt='none' ;; @@ -4953,6 +5017,10 @@ EOM esac : Try to guess additional flags to pick up local libraries. + : Be careful not to append to a plain 'none' + case "$dflt" in + none) dflt='' ;; + esac for thisflag in $ldflags; do case "$thisflag" in -L*) @@ -5016,7 +5084,7 @@ $undef) ;; *) case "$useshrplib" in '') case "$osname" in - svr4*|dgux|dynixptx|esix|powerux) + svr4*|dgux|dynixptx|esix|powerux|beos) dflt=y also='Building a shared libperl is required for dynamic loading to work on your system.' ;; @@ -5061,21 +5129,9 @@ EOM case "${osname}${osvers}" in next4*) xxx='DYLD_LIBRARY_PATH' ;; os2*) xxx='' ;; # Nothing special needed. + beos*) xxx='' ;; *) xxx='LD_LIBRARY_PATH' ;; esac - if test X"$xxx" != "X"; then - $cat <&4 - -To build perl, you must add the current working directory to your -$xxx environment variable before running make. You can do -this with - $xxx=\`pwd\`; export $xxx -for Bourne-style shells, or - setenv $xxx \`pwd\` -for Csh-style shells. You *MUST* do this before running make. - -EOM - fi ;; *) useshrplib='false' ;; esac @@ -5147,7 +5203,7 @@ case "$shrpdir" in *) $cat >&4 < #endif -main() { +int main() { exit(R_OK); } EOCP @@ -6197,7 +6255,7 @@ case "$d_getpgrp" in #ifdef I_UNISTD # include #endif -main() +int main() { if (getuid() == 0) { printf("(I see you are running Configure as super-user...)\n"); @@ -6259,7 +6317,7 @@ case "$d_setpgrp" in #ifdef I_UNISTD # include #endif -main() +int main() { if (getuid() == 0) { printf("(I see you are running Configure as super-user...)\n"); @@ -6317,7 +6375,7 @@ case "$intsize" in echo "Checking to see how big your integers are..." >&4 $cat >intsize.c <<'EOCP' #include -main() +int main() { printf("intsize=%d;\n", sizeof(int)); printf("longsize=%d;\n", sizeof(long)); @@ -6413,7 +6471,7 @@ $cat >try.c < #include $signal_t blech(s) int s; { exit(3); } -main() +int main() { $xxx i32; double f, g; @@ -6471,7 +6529,7 @@ $signal_t blech_in_list(s) int s; { exit(4); } unsigned long dummy_long(p) unsigned long p; { return p; } unsigned int dummy_int(p) unsigned int p; { return p; } unsigned short dummy_short(p) unsigned short p; { return p; } -main() +int main() { double f; unsigned long along; @@ -6563,7 +6621,7 @@ if set vprintf val -f d_vprintf; eval $csym; $val; then $cat >vprintf.c <<'EOF' #include -main() { xxx("foo"); } +int main() { xxx("foo"); } xxx(va_alist) va_dcl @@ -6611,7 +6669,7 @@ echo " " echo 'Checking to see if your C compiler knows about "const"...' >&4 $cat >const.c <<'EOCP' typedef struct spug { int drokk; } spug; -main() +int main() { const char *foo; const spug y; @@ -6703,6 +6761,10 @@ eval $setvar set difftime d_difftime eval $inlibc +: see if sys/stat.h is available +set sys/stat.h i_sysstat +eval $inhdr + : see if this is a dirent system echo " " if xinc=`./findhdr dirent.h`; $test "$xinc"; then @@ -6771,6 +6833,23 @@ set d_dirnamlen eval $setvar $rm -f try.c +hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift; +while $test $# -ge 2; do + case "$1" in + $define) echo "#include <$2>";; + esac ; + shift 2; +done > try.c; +echo "int main () { struct $struct foo; foo.$field = 0; }" >> try.c; +if eval $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then + val="$define"; +else + val="$undef"; +fi; +set $varname; +eval $setvar; +$rm -f try.c try.o' + : see if dlerror exists xxx_runnm="$runnm" runnm=false @@ -6829,7 +6908,7 @@ $cat >fred.c<open3.c <<'EOCP' #ifdef I_SYS_FILE #include #endif -main() { +int main() { if(O_RDONLY); #ifdef O_TRUNC exit(0); @@ -6973,7 +7052,7 @@ case "$o_nonblock" in '') $cat head.c > try.c $cat >>try.c <<'EOCP' -main() { +int main() { #ifdef O_NONBLOCK printf("O_NONBLOCK\n"); exit(0); @@ -7020,7 +7099,7 @@ extern int errno; $signal_t blech(x) int x; { exit(3); } EOCP $cat >> try.c <<'EOCP' -main() +int main() { int pd[2]; int pu[2]; @@ -7178,6 +7257,31 @@ eval $inlibc set gethostbyname d_gethbyname eval $inlibc +: see if this is a sys/param system +set sys/param.h i_sysparam +eval $inhdr + +: see if this is a sys/mount.h system +set sys/mount.h i_sysmount +eval $inhdr + +: see if fstatfs exists +set fstatfs d_fstatfs +eval $inlibc + +: see if statfs knows about mount flags +echo " " +set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h +eval $hasfield + +: see if this is a sysstatvfs.h system +set sys/statvfs.h i_sysstatvfs +eval $inhdr + +: see if fstatvfs exists +set fstatvfs d_fstatvfs +eval $inlibc + : see if gethostent exists set gethostent d_gethent eval $inlibc @@ -7244,6 +7348,18 @@ eval $inlibc set getprotoent d_getpent eval $inlibc +: see if this is a mntent.h system +set mntent.h i_mntent +eval $inhdr + +: see if getmntent exists +set getmntent d_getmntent +eval $inlibc + +: see if hasmntopt exists +set hasmntopt d_hasmntopt +eval $inlibc + : see if getpgid exists set getpgid d_getpgid eval $inlibc @@ -7305,7 +7421,7 @@ esac set netinet/in.h i_niin sys/in.h i_sysin eval $inhdr -: see if this is an arpa/inet.h +: see if arpa/inet.h has to be included set arpa/inet.h i_arpainet eval $inhdr @@ -7411,7 +7527,7 @@ echo " " $cat >isascii.c <<'EOCP' #include #include -main() { +int main() { int c = 'A'; if (isascii(c)) exit(0); @@ -7501,7 +7617,7 @@ $define) $echo $n "Checking to see how big your long doubles are...$c" >&4 $cat >try.c <<'EOCP' #include -main() +int main() { printf("%d\n", sizeof(long double)); } @@ -7518,6 +7634,9 @@ EOCP . ./myread longdblsize="$ans" fi + if $test "X$doublesize" = "X$longdblsize"; then + echo "(That isn't any different from an ordinary double.)" + fi ;; esac $rm -f try.c try @@ -7544,7 +7663,7 @@ $define) $echo $n "Checking to see how big your long longs are...$c" >&4 $cat >try.c <<'EOCP' #include -main() +int main() { printf("%d\n", sizeof(long long)); } @@ -7561,6 +7680,9 @@ EOCP . ./myread longlongsize="$ans" fi + if $test "X$longsize" = "X$longlongsize"; then + echo "(That isn't any different from an ordinary long.)" + fi ;; esac $rm -f try.c try @@ -7635,7 +7757,7 @@ case "$osname" in freebsd) case "`ipcs 2>&1`" in "SVID messages"*"not configured"*) - echo "But your FreeBSD kernel does not have the msg*(2) configured." >&4 + echo "Your $osname does not have the msg*(2) configured." >&4 h_msg=false val="$undef" set msgctl d_msgctl @@ -7678,10 +7800,10 @@ set poll d_poll eval $inlibc -: see whether the various POSIXish _yields exist within given cccmd +: see whether the various POSIXish _yields exist $cat >try.c < -main() { +int main() { YIELD(); exit(0); } @@ -7713,10 +7835,18 @@ set d_sched_yield eval $setvar $rm -f try try.* +: see if this is a pthread.h system +set pthread.h i_pthread +eval $inhdr + +: see if this is a mach/cthreads.h system +set mach/cthreads.h i_machcthreads +eval $inhdr + : test whether pthreads are created in joinable -- aka undetached -- state -if test "X$usethreads" = "X$define"; then +if test "X$usethreads" = "X$define" -a "X$i_pthread" = "X$define"; then echo $n "Checking whether pthreads are created joinable. $c" >&4 - $cat >try.c <<'EOCP' + $cat >try.c < #include int main() { @@ -7930,7 +8060,7 @@ EOCP #ifdef I_UNISTD # include /* Needed for NetBSD */ #endif -main() +int main() { char buf[128], abc[128]; char *b; @@ -8006,7 +8136,7 @@ EOCP #ifdef I_UNISTD # include /* Needed for NetBSD */ #endif -main() +int main() { char buf[128], abc[128]; char *b; @@ -8084,7 +8214,7 @@ EOCP #ifdef I_UNISTD # include /* Needed for NetBSD */ #endif -main() +int main() { char a = -1; char b = 0; @@ -8136,7 +8266,7 @@ case "$osname" in freebsd) case "`ipcs 2>&1`" in "SVID messages"*"not configured"*) - echo "But your FreeBSD kernel does not have the sem*(2) configured." >&4 + echo "Your $osname does not have the sem*(2) configured." >&4 h_sem=false val="$undef" set semctl d_semctl @@ -8185,6 +8315,31 @@ case "$d_sem" in $define) : see whether semctl IPC_STAT can use union semun echo " " + $cat > try.h <>3) +# define S_IWGRP (S_IWUSR>>3) +# define S_IXGRP (S_IXUSR>>3) +# define S_IROTH (S_IRUSR>>6) +# define S_IWOTH (S_IWUSR>>6) +# define S_IXOTH (S_IXUSR>>6) +#endif +#ifndef S_IRWXU +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) +# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) +#endif +END + $cat > try.c < #include @@ -8244,7 +8399,7 @@ END case "$d_semctl_semun" in $define) echo "You can use union semun for semctl IPC_STAT." >&4 - also='also' + also='also ' ;; *) echo "You cannot use union semun for semctl IPC_STAT." >&4 also='' @@ -8259,6 +8414,7 @@ END #include #include #include +#include "try.h" #ifndef errno extern int errno; #endif @@ -8300,11 +8456,12 @@ END eval $setvar case "$d_semctl_semid_ds" in $define) - echo "You can $also use struct semid_ds * for semctl IPC_STAT." >&4 + echo "You can ${also}use struct semid_ds* for semctl IPC_STAT." >&4 ;; - *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4 + *) echo "You cannot use struct semid_ds* for semctl IPC_STAT." >&4 ;; esac + $rm -f try.h ;; *) val="$undef" @@ -8499,7 +8656,7 @@ case "$osname" in freebsd) case "`ipcs 2>&1`" in "SVID shared memory"*"not configured"*) - echo "But your FreeBSD kernel does not have the shm*(2) configured." >&4 + echo "But your $osname does not have the shm*(2) configured." >&4 h_shm=false val="$undef" set shmctl d_shmctl @@ -8533,7 +8690,7 @@ if set sigaction val -f d_sigaction; eval $csym; $val; then #include #include #include -main() +int main() { struct sigaction act, oact; } @@ -8560,7 +8717,7 @@ case "$d_sigsetjmp" in #include sigjmp_buf env; int set = 1; -main() +int main() { if (sigsetjmp(env,1)) exit(set); @@ -8619,26 +8776,32 @@ else d_oldsock="$undef" else echo "You don't have Berkeley networking in libc$_a..." >&4 - if test -f /usr/lib/libnet$_a; then - ( ($nm $nm_opt /usr/lib/libnet$_a | eval $nm_extract) || \ - $ar t /usr/lib/libnet$_a) 2>/dev/null >> libc.list - if $contains socket libc.list >/dev/null 2>&1; then - echo "...but the Wollongong group seems to have hacked it in." >&4 - socketlib="-lnet" - sockethdr="-I/usr/netinclude" - d_socket="$define" - if $contains setsockopt libc.list >/dev/null 2>&1; then - d_oldsock="$undef" - else - echo "...using the old 4.1c interface, rather than 4.2" >&4 - d_oldsock="$define" + for net in net socket + do + if test -f /usr/lib/lib$net$_a; then + ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \ + $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list + if $contains socket libc.list >/dev/null 2>&1; then + d_socket="$define" + case "$net" in + net) + echo "...but the Wollongong group seems to have hacked it in." >&4 + socketlib="-lnet" + sockethdr="-I/usr/netinclude" + ;; + esac + echo "Found Berkeley sockets interface in lib$net." >& 4 + if $contains setsockopt libc.list >/dev/null 2>&1; then + d_oldsock="$undef" + else + echo "...using the old 4.1c interface, rather than 4.2" >&4 + d_oldsock="$define" + fi + break fi - else - echo "or even in libnet$_a, which is peculiar." >&4 - d_socket="$undef" - d_oldsock="$undef" fi - else + done + if test "X$d_socket" != "X$define"; then echo "or anywhere else I see." >&4 d_socket="$undef" d_oldsock="$undef" @@ -8652,21 +8815,8 @@ eval $inlibc : see if stat knows about block sizes echo " " -xxx=`./findhdr sys/stat.h` -if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then - if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then - echo "Your stat() knows about block sizes." >&4 - val="$define" - else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" - fi -else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" -fi -set d_statblks -eval $setvar +set d_statblks stat st_blocks $i_sysstat sys/stat.h +eval $hasfield : see if _ptr and _cnt from stdio act std echo " " @@ -8716,7 +8866,7 @@ $cat >try.c < #define FILE_ptr(fp) $stdio_ptr #define FILE_cnt(fp) $stdio_cnt -main() { +int main() { FILE *fp = fopen("try.c", "r"); char c = getc(fp); if ( @@ -8767,7 +8917,7 @@ $define) #include #define FILE_base(fp) $stdio_base #define FILE_bufsiz(fp) $stdio_bufsiz -main() { +int main() { FILE *fp = fopen("try.c", "r"); char c = getc(fp); if ( @@ -8803,7 +8953,7 @@ eval $inlibc echo " " echo "Checking to see if your C compiler can copy structs..." >&4 $cat >try.c <<'EOCP' -main() +int main() { struct blurfl { int dyick; @@ -9056,7 +9206,16 @@ $define) false) dflt='n';; *) dflt='y';; esac - rp="Some systems have problems with vfork(). Do you want to use it?" + cat <<'EOM' + +Perl can only use a vfork() that doesn't suffer from strict +restrictions on calling functions or modifying global data in +the child. For example, glibc-2.1 contains such a vfork() +that is unsuitable. If your system provides a proper fork() +call, chances are that you do NOT want perl to use vfork(). + +EOM + rp="Do you still want to use vfork()?" . ./myread case "$ans" in y|Y) ;; @@ -9148,7 +9307,7 @@ $rm -f closedir* echo " " echo 'Checking to see if your C compiler knows about "volatile"...' >&4 $cat >try.c <<'EOCP' -main() +int main() { typedef struct _goo_struct goo_struct; goo_struct * volatile goo = ((goo_struct *)0); @@ -9207,7 +9366,7 @@ struct foobar { char foo; double bar; } try; -main() +int main() { printf("%d\n", (char *)&try.bar - (char *)&try.foo); } @@ -9242,7 +9401,7 @@ I'm now running the test program... EOM $cat >try.c <<'EOCP' #include -main() +int main() { int i; union { @@ -9337,7 +9496,7 @@ $define) #include #include #include -main() +int main() { #ifdef DB_VERSION_MAJOR /* DB version >= 2 */ int Major, Minor, Patch ; @@ -9420,7 +9579,7 @@ size_t size; { } HASHINFO info; -main() +int main() { info.hash = hash_cb; } @@ -9465,7 +9624,7 @@ const DBT *key2; { } BTREEINFO info; -main() +int main() { info.prefix = prefix_cb; } @@ -9518,7 +9677,7 @@ sub() { #endif exit(0); } -main() { sub(); } +int main() { sub(); } EOCP if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then voidflags=$defvoidused @@ -9590,7 +9749,7 @@ case "$doublesize" in $echo $n "Checking to see how big your double precision numbers are...$c" >&4 $cat >try.c <<'EOCP' #include -main() +int main() { printf("%d\n", sizeof(double)); } @@ -9610,6 +9769,32 @@ EOCP esac $rm -f try.c try +echo " " +echo "Determining whether or not we are on an EBCDIC system..." >&4 +$cat >tebcdic.c <&4 + val="$define" + else + echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 + fi +else + echo "I'm unable to compile the test program." >&4 + echo "I'll assume ASCII or some ISO Latin." >&4 +fi +$rm -f tebcdic.c tebcdic +set ebcdic +eval $setvar + : see what type file positions are declared as in the library rp="What is the type for file position used by fsetpos()?" set fpos_t fpostype long stdio.h sys/types.h @@ -9630,6 +9815,12 @@ esac : Store the full pathname to the sed program for use in the C program full_sed=$sed +: Store the full pathname to the ar program for use in the Makefile.SH +: Respect a hint or command line value for full_ar. +case "$full_ar" in +'') full_ar=$ar ;; +esac + : see what type gids are declared as in the kernel echo " " echo "Looking for the type for group ids returned by getgid()." @@ -9928,7 +10119,7 @@ case "$ptrsize" in fi $cat >>try.c <<'EOCP' #include -main() +int main() { printf("%d\n", sizeof(VOID_PTR)); exit(0); @@ -9966,7 +10157,7 @@ case "$randbits" in #endif EOCP $cat >>try.c <<'EOCP' -main() +int main() { register int i; register unsigned long tmp; @@ -10004,7 +10195,7 @@ echo "Checking how to generate random libraries on your machine..." >&4 echo 'int bar1() { return bar2(); }' > bar1.c echo 'int bar2() { return 2; }' > bar2.c $cat > foo.c <<'EOP' -main() { printf("%d\n", bar1()); exit(0); } +int main() { printf("%d\n", bar1()); exit(0); } EOP $cc $ccflags -c bar1.c >/dev/null 2>&1 $cc $ccflags -c bar2.c >/dev/null 2>&1 @@ -10064,7 +10255,7 @@ if test "X$timeincl" = X; then #ifdef I_SYSSELECT #include #endif -main() +int main() { struct tm foo; #ifdef S_TIMEVAL @@ -10148,7 +10339,7 @@ $cat >fd_set.c < #endif -main() { +int main() { fd_set fds; #ifdef TRYBITS @@ -10217,8 +10408,10 @@ EOM : The first arg can be int, unsigned, or size_t : The last arg may or may not be 'const' val='' + : void pointer has been seen but using that + : breaks the selectminbits test for xxx in 'fd_set *' 'int *'; do - for nfd in 'int' 'size_t' 'unsigned' ; do + for nfd in 'int' 'size_t' 'unsigned' 'unsigned long'; do for tmo in 'struct timeval *' 'const struct timeval *'; do case "$val" in '') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));" @@ -10250,6 +10443,100 @@ EOM ;; esac +: check for the select 'width' +case "$selectminbits" in +'') case "$d_select" in + $define) + $cat <try.c < +#$i_time I_TIME +#$i_systime I_SYS_TIME +#$i_systimek I_SYS_TIME_KERNEL +#ifdef I_TIME +# include +#endif +#ifdef I_SYS_TIME +# ifdef I_SYS_TIME_KERNEL +# define KERNEL +# endif +# include +# ifdef I_SYS_TIME_KERNEL +# undef KERNEL +# endif +#endif +#$i_sysselct I_SYS_SELECT +#ifdef I_SYS_SELECT +#include +#endif +#include +$selecttype b; +#define S sizeof(*(b)) +#define MINBITS 64 +#define NBYTES (S * 8 > MINBITS ? S : MINBITS/8) +#define NBITS (NBYTES * 8) +int main() { + char s[NBYTES]; + struct timeval t; + int i; + FILE* fp; + int fd; + + fclose(stdin); + fp = fopen("try.c", "r"); + if (fp == 0) + exit(1); + fd = fileno(fp); + if (fd < 0) + exit(2); + b = ($selecttype)s; + for (i = 0; i < NBITS; i++) + FD_SET(i, b); + t.tv_sec = 0; + t.tv_usec = 0; + select(fd + 1, b, 0, 0, &t); + for (i = NBITS - 1; i > fd && FD_ISSET(i, b); i--); + printf("%d\n", i + 1); + return 0; +} +EOCP + set try + if eval $compile_ok; then + selectminbits=`./try` + case "$selectminbits" in + '') cat >&4 <&4 + else + rp='What is the minimum number of bits your select() operates on?' + case "$byteorder" in + 1234|12345678) dflt=32 ;; + *) dflt=1 ;; + esac + . ./myread + val=$ans + selectminbits="$val" + fi + $rm -f try.* try + ;; + *) : no select, so pick a harmless default + selectminbits='32' + ;; + esac + ;; +esac + : Trace out the files included by signal.h, then look for SIGxxx names. : Remove SIGARRAYSIZE used by HPUX. : Remove SIGTYP void lines used by OS2. @@ -10458,7 +10745,13 @@ $eunicefix signal_cmd : generate list of signal names echo " " case "$sig_name_init" in -'') +'') doinit=yes ;; +*) case "$sig_num_init" in + ''|*,*) doinit=yes ;; + esac ;; +esac +case "$doinit" in +yes) echo "Generating a list of signal names and numbers..." >&4 . ./signal_cmd sig_name=`$awk '{printf "%s ", $1}' signal.lst` @@ -10466,7 +10759,9 @@ case "$sig_name_init" in sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " } { printf "\"%s\", ", $1 } END { printf "0\n" }' signal.lst` - sig_num=`$awk 'BEGIN { printf "0, " } + sig_num=`$awk '{printf "%d ", $2}' signal.lst` + sig_num="0 $sig_num" + sig_num_init=`$awk 'BEGIN { printf "0, " } { printf "%d, ", $2} END { printf "0\n"}' signal.lst` ;; @@ -10498,7 +10793,7 @@ $cat > ssize.c < #define Size_t $sizetype #define SSize_t $dflt -main() +int main() { if (sizeof(Size_t) == sizeof(SSize_t)) printf("$dflt\n"); @@ -10814,12 +11109,16 @@ $eunicefix Cppsym ./Cppsym -l $al | $sort | $grep -v '^$' >Cppsym.true : now check the C compiler for additional symbols +postprocess_cc_v='' +case "$osname" in +aix) postprocess_cc_v="|$tr , ' '" ;; +esac $cat >ccsym <tmp.c <&1\` +for i in \`$cc -v -c tmp.c 2>&1 $postprocess_cc_v\` do case "\$i" in -D*) echo "\$i" | $sed 's/^-D//';; @@ -10828,9 +11127,16 @@ do done $rm -f try.c EOS +unset postprocess_cc_v chmod +x ccsym $eunicefix ccsym -./ccsym | $sort | $uniq >ccsym.raw +./ccsym > ccsym1.raw +if $test -s ccsym1.raw; then + $sort ccsym1.raw | $uniq >ccsym.raw +else + mv ccsym1.raw ccsym.raw +fi + $awk '/\=/ { print $0; next } { print $0"=1" }' ccsym.raw >ccsym.list $awk '{ print $0"=1" }' Cppsym.true >ccsym.true @@ -10838,12 +11144,15 @@ $comm -13 ccsym.true ccsym.list >ccsym.own $comm -12 ccsym.true ccsym.list >ccsym.com $comm -23 ccsym.true ccsym.list >ccsym.cpp also='' -symbols='symbols' if $test -z ccsym.raw; then echo "Your C compiler doesn't seem to define any symbol!" >&4 echo " " echo "However, your C preprocessor defines the following ones:" $cat Cppsym.true + ccsymbols='' + cppsymbols=`$cat Cppsym.true` + cppsymbols=`echo $cppsymbols` + cppccsymbols="$cppsymbols" else if $test -s ccsym.com; then echo "Your C compiler and pre-processor define these symbols:" @@ -10851,20 +11160,26 @@ else also='also ' symbols='ones' $test "$silent" || sleep 1 + cppccsymbols=`$cat ccsym.com` + cppccsymbols=`echo $cppccsymbols` fi if $test -s ccsym.cpp; then $test "$also" && echo " " - echo "Your C pre-processor ${also}defines the following $symbols:" + echo "Your C pre-processor ${also}defines the following symbols:" $sed -e 's/\(.*\)=.*/\1/' ccsym.cpp also='further ' $test "$silent" || sleep 1 + cppsymbols=`$cat ccsym.cpp` + cppsymbols=`echo $cppsymbols` fi if $test -s ccsym.own; then $test "$also" && echo " " - echo "Your C compiler ${also}defines the following cpp variables:" + echo "Your C compiler ${also}defines the following cpp symbols:" $sed -e 's/\(.*\)=1/\1/' ccsym.own $sed -e 's/\(.*\)=.*/\1/' ccsym.own | $uniq >>Cppsym.true $test "$silent" || sleep 1 + ccsymbols=`$cat ccsym.own` + ccsymbols=`echo $ccsymbols` fi fi $rm -f ccsym* @@ -11047,18 +11362,10 @@ fi set i_sysioctl eval $setvar -: see if this is a sys/param system -set sys/param.h i_sysparam -eval $inhdr - : see if sys/resource.h has to be included set sys/resource.h i_sysresrc eval $inhdr -: see if sys/stat.h is available -set sys/stat.h i_sysstat -eval $inhdr - : see if this is a sys/un.h system set sys/un.h i_sysun eval $inhdr @@ -11195,6 +11502,7 @@ for xxx in $known_extensions ; do esac ;; IPC/SysV|ipc/sysv) + : XXX Do we need a useipcsysv variable here case "${d_msg}${d_sem}${d_shm}" in *"${define}"*) avail_ext="$avail_ext $xxx" ;; esac @@ -11441,6 +11749,7 @@ cc='$cc' cccdlflags='$cccdlflags' ccdlflags='$ccdlflags' ccflags='$ccflags' +ccsymbols='$ccsymbols' cf_by='$cf_by' cf_email='$cf_email' cf_time='$cf_time' @@ -11460,6 +11769,8 @@ cpplast='$cpplast' cppminus='$cppminus' cpprun='$cpprun' cppstdin='$cppstdin' +cppsymbols='$cppsymbols' +cppccsymbols='$cppccsymbols' cryptlib='$cryptlib' csh='$csh' d_Gconvert='$d_Gconvert' @@ -11512,6 +11823,11 @@ d_flock='$d_flock' d_fork='$d_fork' d_fpathconf='$d_fpathconf' d_fsetpos='$d_fsetpos' +d_fstatfs='$d_fstatfs' +d_statfsflags='$d_statfsflags' +d_fstatvfs='$d_fstatvfs' +d_getmntent='$d_getmntent' +d_hasmntopt='$d_hasmntopt' d_ftime='$d_ftime' d_getgrent='$d_getgrent' d_getgrps='$d_getgrps' @@ -11706,6 +12022,7 @@ firstmakefile='$firstmakefile' flex='$flex' fpostype='$fpostype' freetype='$freetype' +full_ar='$full_ar' full_csh='$full_csh' full_sed='$full_sed' gccversion='$gccversion' @@ -11734,13 +12051,16 @@ i_grp='$i_grp' i_limits='$i_limits' i_locale='$i_locale' i_malloc='$i_malloc' +i_machcthreads='$i_machcthreads' i_math='$i_math' i_memory='$i_memory' +i_mntent='$i_mntent' i_ndbm='$i_ndbm' i_netdb='$i_netdb' i_neterrno='$i_neterrno' i_niin='$i_niin' i_pwd='$i_pwd' +i_pthread='$i_pthread' i_rpcsvcdbm='$i_rpcsvcdbm' i_sfio='$i_sfio' i_sgtty='$i_sgtty' @@ -11753,12 +12073,14 @@ i_sysfile='$i_sysfile' i_sysfilio='$i_sysfilio' i_sysin='$i_sysin' i_sysioctl='$i_sysioctl' +i_sysmount='$i_sysmount' i_sysndir='$i_sysndir' i_sysparam='$i_sysparam' i_sysresrc='$i_sysresrc' i_sysselct='$i_sysselct' i_syssockio='$i_syssockio' i_sysstat='$i_sysstat' +i_sysstatvfs='$i_sysstatvfs' i_systime='$i_systime' i_systimek='$i_systimek' i_systimes='$i_systimes' @@ -11774,6 +12096,7 @@ i_values='$i_values' i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' +ignore_versioned_solibs='$ignore_versioned_solibs' incpath='$incpath' inews='$inews' installarchlib='$installarchlib' @@ -11784,6 +12107,7 @@ installprivlib='$installprivlib' installscript='$installscript' installsitearch='$installsitearch' installsitelib='$installsitelib' +installusrbinperl='$installusrbinperl' intsize='$intsize' known_extensions='$known_extensions' ksh='$ksh' @@ -11882,6 +12206,7 @@ runnm='$runnm' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' sed='$sed' +selectminbits='$selectminbits' selecttype='$selecttype' sendmail='$sendmail' sh='$sh' @@ -11894,6 +12219,7 @@ shsharp='$shsharp' sig_name='$sig_name' sig_name_init='$sig_name_init' sig_num='$sig_num' +sig_num_init='$sig_num_init' signal_t='$signal_t' sitearch='$sitearch' sitearchexp='$sitearchexp' @@ -12023,51 +12349,6 @@ esac : if this fails, just run all the .SH files by hand . ./config.sh -case "$ebcdic" in -$define) - xxx='' - echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 - rm -f y.tab.c y.tab.h - yacc -d perly.y >/dev/null 2>&1 - if cmp -s y.tab.c perly.c; then - rm -f y.tab.c - else - echo "perly.y -> perly.c" >&4 - mv -f y.tab.c perly.c - chmod u+w perly.c - sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ - -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c - xxx="$xxx perly.c" - fi - if cmp -s y.tab.h perly.h; then - rm -f y.tab.h - else - echo "perly.y -> perly.h" >&4 - mv -f y.tab.h perly.h - xxx="$xxx perly.h" - fi - echo "x2p/a2p.y" >&4 - cd x2p - rm -f y.tab.c - yacc a2p.y >/dev/null 2>&1 - if cmp -s y.tab.c a2p.c - then - rm -f y.tab.c - else - echo "a2p.y -> a2p.c" >&4 - mv -f y.tab.c a2p.c - chmod u+w a2p.c - sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ - -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c - xxx="$xxx a2p.c" - fi - cd .. - case "$xxx" in - '') echo "No parser files were regenerated. That's okay." >&4 ;; - esac - ;; -esac - echo " " exec 1>&4 . ./UU/extract diff --git a/contrib/perl5/Copying b/contrib/perl5/Copying index 3c68f02..43cd72c 100644 --- a/contrib/perl5/Copying +++ b/contrib/perl5/Copying @@ -2,7 +2,7 @@ Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. - 675 Mass Ave, Cambridge, MA 02139, USA + 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -215,8 +215,8 @@ the exclusion of warranty; and each file should have at least the GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + along with this program; if not, write to the Free Software Foundation, + Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. diff --git a/contrib/perl5/EXTERN.h b/contrib/perl5/EXTERN.h index 19f6db8..66aeb9f 100644 --- a/contrib/perl5/EXTERN.h +++ b/contrib/perl5/EXTERN.h @@ -1,6 +1,6 @@ /* EXTERN.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/INSTALL b/contrib/perl5/INSTALL index a892e7d..c5e04cb 100644 --- a/contrib/perl5/INSTALL +++ b/contrib/perl5/INSTALL @@ -64,6 +64,23 @@ 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. +=head1 WARNING: This version requires a compiler that supports ANSI C. + +If you find that your C compiler is not ANSI-capable, try obtaining +GCC, available from GNU mirrors worldwide (e.g. ftp://ftp.gnu.org/pub/gnu). +Another alternative may be to use a tool like C to convert the +sources back to K&R style, but there is no guarantee this route will get +you anywhere, since the prototypes are not the only ANSI features used +in the Perl sources. C is usually found as part of the freely +available C distribution. Another similar tool is +C, distributed with GCC. Since C requires GCC to +run, you may have to run it on a platform where GCC is available, and move +the sources back to the platform without GCC. + +If you succeed in automatically converting the sources to a K&R compatible +form, be sure to email perlbug@perl.com to let us know the steps you +followed. This will enable us to officially support this option. + =head1 Space Requirements The complete perl5 source tree takes up about 10 MB of disk space. The @@ -167,6 +184,9 @@ put (symlinks to) perl and its accompanying utilities, such as perldoc, into a directory typically found along a user's PATH, or in another obvious and convenient place. +You can use "Configure -Uinstallusrbinperl" which causes installperl +to skip installing perl also as /usr/bin/perl. + By default, Configure will compile perl to use dynamic loading if your system supports it. If you want to force perl to be compiled statically, you can either choose this when Configure prompts you or @@ -472,23 +492,26 @@ that problem. If you need to install perl on many identical systems, it is convenient to compile it once and create an archive that can be -installed on multiple systems. Here's one way to do that: +installed on multiple systems. Suppose, for example, that you want to +create an archive that can be installed in /opt/perl. +Here's one way to do that: # Set up config.over to install perl into a different directory, # e.g. /tmp/perl5 (see previous part). - sh Configure -des + sh Configure -Dprefix=/opt/perl -des make make test - make install + make install # This will install everything into /tmp/perl5. cd /tmp/perl5 - # Edit $archlib/Config.pm to change all the + # Edit $archlib/Config.pm and $archlib/.packlist to change all the # install* variables back to reflect where everything will - # really be installed. - # Edit any of the scripts in $scriptdir to have the correct + # really be installed. (That is, change /tmp/perl5 to /opt/perl + # everywhere in those files.) + # Check the scripts in $scriptdir to make sure they have the correct # #!/wherever/perl line. tar cvf ../perl5-archive.tar . # Then, on each machine where you want to install perl, - cd /usr/local # Or wherever you specified as $prefix + cd /opt/perl # Or wherever you specified as $prefix tar xvf perl5-archive.tar =head2 Site-wide Policy settings @@ -518,8 +541,9 @@ some of the main things you can change. =head2 Threads -On some platforms, perl5.005 can be compiled to use threads. To -enable this, read the file README.threads, and then try +On some platforms, perl5.005 can be compiled with experimental support +for threads. To enable this, read the file README.threads, and then +try: sh Configure -Dusethreads @@ -653,9 +677,24 @@ You can elect to build a shared libperl by sh Configure -Duseshrplib -To actually build perl, you must add the current working directory to your -LD_LIBRARY_PATH environment variable before running make. You can do -this with +To build a shared libperl, the environment variable controlling shared +library search (LD_LIBRARY_PATH in most systems, DYLD_LIBRARY_PATH for +NeXTSTEP/OPENSTEP, LIBRARY_PATH for BeOS) must be set up to include +the Perl build directory because that's where the shared libperl will +be created. Configure arranges Makefile to have the correct shared +library search settings. + +However, there are some special cases where manually setting the +shared library path might be required. For example, if you want to run +something like the following with the newly-built but not-yet-installed +./perl: + + cd t; ./perl misc/failing_test.t +or + ./perl -Ilib ~/my_mission_critical_test + +then you need to set up the shared library path explicitly. +You can do this with LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH; export LD_LIBRARY_PATH @@ -663,9 +702,13 @@ for Bourne-style shells, or setenv LD_LIBRARY_PATH `pwd` -for Csh-style shells. You *MUST* do this before running make. -Folks running NeXT OPENSTEP must substitute DYLD_LIBRARY_PATH for -LD_LIBRARY_PATH above. +for Csh-style shells. (This procedure may also be needed if for some +unexpected reason Configure fails to set up Makefile correctly.) + +You can often recognize failures to build/use a shared libperl from error +messages complaining about a missing libperl.so (or libperl.sl in HP-UX), +for example: +18126:./miniperl: /sbin/loader: Fatal Error: cannot map libperl.so There is also an potential problem with the shared perl library if you want to have more than one "flavor" of the same version of perl (e.g. @@ -771,21 +814,6 @@ you can change a number of factors in the way perl is built by adding appropriate -D directives to your ccflags variable in config.sh. -For example, you can replace the rand() and srand() functions in the -perl source by any other random number generator by a trick such as the -following (this should all be on one line): - - sh Configure -Dccflags='-Dmy_rand=random -Dmy_srand=srandom' \ - -Drandbits=31 - -or you can use the drand48 family of functions with - - sh Configure -Dccflags='-Dmy_rand=lrand48 -Dmy_srand=srand48' \ - -Drandbits=31 - -or by adding the -D flags to your ccflags at the appropriate Configure -prompt. (Read pp.c to see how this works.) - You should also run Configure interactively to verify that a hint file doesn't inadvertently override your ccflags setting. (Hints files shouldn't do that, but some might.) @@ -920,6 +948,42 @@ to config.h and edit the config.h to reflect your system's peculiarities. You'll probably also have to extensively modify the extension building mechanism. +=item Environment variable clashes + +Configure uses a CONFIG variable that is reported to cause trouble on +ReliantUnix 5.44. If your system sets this variable, you can try +unsetting it before you run Configure. Configure should eventually +be fixed to avoid polluting the namespace of the environment. + +=item Digital UNIX/Tru64 UNIX and BIN_SH + +In Digital UNIX/Tru64 UNIX Configure might abort with + +Build a threading Perl? [n] +Configure[2437]: Syntax error at line 1 : `config.sh' is not expected. + +This indicates that Configure is being run with a broken Korn shell +(even though you think you are using a Bourne shell by using +"sh Configure" or "./Configure"). The Korn shell bug has been reported +to Compaq as of February 1999 but in the meanwhile, the reason ksh is +being used is that you have the environment variable BIN_SH set to +'xpg4'. This causes /bin/sh to delegate its duties to /bin/posix/sh +(a ksh). Unset the environment variable and rerun Configure. + +=item HP-UX 11, pthreads, and libgdbm + +If you are running Configure with -Dusethreads in HP-UX 11, be warned +that POSIX threads and libgdbm (the GNU dbm library) compiled before +HP-UX 11 do not mix. This will cause a basic test run by Configure to +fail + +Pthread internal error: message: __libc_reinit() failed, file: ../pthreads/pthread.c, line: 1096 +Return Pointer is 0xc082bf33 +sh: 5345 Quit(coredump) + +and Configure will give up. The cure is to recompile and install +libgdbm under HP-UX 11. + =item Porting information Specific information for the OS/2, Plan9, VMS and Win32 ports is in the @@ -1218,6 +1282,17 @@ ones (which ones these are depends on your system and applications) with "ipcrm -s SEMAPHORE_ID_HERE" or configure more semaphores to your system. +=item GNU binutils + +If you mix GNU binutils (nm, ld, ar) with equivalent vendor-supplied +tools you may be in for some trouble. For example creating archives +with an old GNU 'ar' and then using a new current vendor-supplied 'ld' +may lead into linking problems. Either recompile your GNU binutils +under your current operating system release, or modify your PATH not +to include the GNU utils before running Configure, or specify the +vendor-supplied utilities explicitly to Configure, for example by +Configure -Dar=/bin/ar. + =item Miscellaneous Some additional things that have been reported for either perl4 or perl5: @@ -1236,6 +1311,12 @@ If you get syntax errors on '(', try -DCRIPPLED_CC. Machines with half-implemented dbm routines will need to #undef I_ODBM +HP-UX 11 Y2K patch "Y2K-1100 B.11.00.B0125 HP-UX Core OS Year 2000 +Patch Bundle" has been reported to break the io/fs test #18 which +tests whether utime() can change timestamps. The Y2K patch seems to +break utime() so that over NFS the timestamps do not get changed +(on local filesystems utime() still works). + =back =head1 make test diff --git a/contrib/perl5/INTERN.h b/contrib/perl5/INTERN.h index 6ce0367..118e47c 100644 --- a/contrib/perl5/INTERN.h +++ b/contrib/perl5/INTERN.h @@ -1,6 +1,6 @@ /* INTERN.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/MANIFEST b/contrib/perl5/MANIFEST index 1d6b3a8..f42a832 100644 --- a/contrib/perl5/MANIFEST +++ b/contrib/perl5/MANIFEST @@ -29,9 +29,13 @@ Porting/patchls Flexible patch file listing utility Porting/pumpkin.pod Guidelines and hints for Perl maintainers README The Instructions README.amiga Notes about AmigaOS port +README.apollo Notes about Apollo DomainOS port README.beos Notes about BeOS port README.cygwin32 Notes about Cygwin32 port README.dos Notes about dos/djgpp port +README.hpux Notes about HP-UX port +README.hurd Notes about GNU/Hurd port +README.mint Notes about Atari MiNT port README.mpeix Notes about MPE/iX port README.os2 Notes about OS/2 port README.os390 Notes about OS/390 (nee MVS) port @@ -39,11 +43,13 @@ README.plan9 Notes about Plan9 port README.qnx Notes about QNX port README.threads Notes about multithreading README.vms Notes about VMS port +README.vos Notes about Stratus VOS port README.win32 Notes about Win32 port Todo The Wishlist Todo-5.005 What needs doing before 5.005 release XSlock.h Include file for extensions built with PERL_OBJECT defined XSUB.h Include file for extension subroutines +apollo/netinet/in.h Apollo DomainOS port: C header file frontend av.c Array value code av.h Array value header beos/nm.c BeOS port @@ -65,8 +71,8 @@ cygwin32/ld2 Cygwin32 port cygwin32/perlgcc Cygwin32 port cygwin32/perlld Cygwin32 port deb.c Debugging routines -djgpp/config.over DOS/DJGPP port -djgpp/configure.bat DOS/DJGPP port +djgpp/config.over DOS/DJGPP port +djgpp/configure.bat DOS/DJGPP port djgpp/djgpp.c DOS/DJGPP port djgpp/djgppsed.sh DOS/DJGPP port djgpp/fixpmain DOS/DJGPP port @@ -185,6 +191,7 @@ ext/DB_File/DB_File.xs Berkeley DB extension external subroutines ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder ext/DB_File/Makefile.PL Berkeley DB extension makefile writer ext/DB_File/dbinfo Berkeley DB database version checker +ext/DB_File/hints/dynixptx.pl Hints for DB_File for named architecture ext/DB_File/typemap Berkeley DB extension interface types ext/Data/Dumper/Changes Data pretty printer, changelog ext/Data/Dumper/Dumper.pm Data pretty printer, module @@ -195,6 +202,7 @@ ext/DynaLoader/DynaLoader_pm.PL Dynamic Loader perl module ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer ext/DynaLoader/README Dynamic Loader notes and intro ext/DynaLoader/dl_aix.xs AIX implementation +ext/DynaLoader/dl_beos.xs BeOS implementation ext/DynaLoader/dl_cygwin32.xs Cygwin32 implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation @@ -213,6 +221,7 @@ ext/Fcntl/Makefile.PL Fcntl extension makefile writer ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/Makefile.PL GDBM extension makefile writer +ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture ext/GDBM_File/typemap GDBM extension interface types ext/IO/IO.pm Top-level interface to IO::* classes ext/IO/IO.xs IO extension external subroutines @@ -262,8 +271,10 @@ ext/POSIX/POSIX.pm POSIX extension Perl module ext/POSIX/POSIX.pod POSIX extension documentation ext/POSIX/POSIX.xs POSIX extension external subroutines ext/POSIX/hints/bsdos.pl Hint for POSIX for named architecture +ext/POSIX/hints/dynixptx.pl Hint for POSIX for named architecture ext/POSIX/hints/freebsd.pl Hint for POSIX for named architecture ext/POSIX/hints/linux.pl Hint for POSIX for named architecture +ext/POSIX/hints/mint.pl Hint for POSIX for named architecture ext/POSIX/hints/netbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/next_3.pl Hint for POSIX for named architecture ext/POSIX/hints/openbsd.pl Hint for POSIX for named architecture @@ -380,6 +391,7 @@ hints/esix4.sh Hints for named architecture hints/fps.sh Hints for named architecture hints/freebsd.sh Hints for named architecture hints/genix.sh Hints for named architecture +hints/gnu.sh Hints for named architecture hints/greenhills.sh Hints for named architecture hints/hpux.sh Hints for named architecture hints/i386.sh Hints for named architecture @@ -394,6 +406,7 @@ hints/linux.sh Hints for named architecture hints/lynxos.sh Hints for named architecture hints/machten.sh Hints for named architecture hints/machten_2.sh Hints for named architecture +hints/mint.sh Hints for named architecture hints/mips.sh Hints for named architecture hints/mpc.sh Hints for named architecture hints/mpeix.sh Hints for named architecture @@ -429,12 +442,12 @@ hints/unicosmk.sh Hints for named architecture hints/unisysdynix.sh Hints for named architecture hints/utekv.sh Hints for named architecture hints/uts.sh Hints for named architecture +hints/uwin.sh Hints for named architecture hv.c Hash value code hv.h Hash value header installhtml Perl script to install html files for pods installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work -interp.sym Interpreter specific symbols to hide in a struct intrpvar.h Variables held in each interpreter instance iperlsys.h Perl's interface to the system keywords.h The keyword numbers @@ -456,8 +469,9 @@ lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions lib/Carp.pm Error message base class lib/Class/Struct.pm Declare struct-like datatypes as Perl classes lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir) -lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm +lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm lib/DirHandle.pm like FileHandle only for directories +lib/Dumpvalue.pm Screen dump of perl values lib/English.pm Readable aliases for short variables lib/Env.pm Map environment into ordinary variables lib/Exporter.pm Exporter base class @@ -553,7 +567,7 @@ lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package lib/blib.pm For "use blib" lib/cacheout.pl Manages output filehandles when you need too many -lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead) +lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead) lib/complete.pl A command completion subroutine lib/constant.pm For "use constant" lib/ctime.pl A ctime workalike @@ -602,6 +616,13 @@ mg.c Magic code mg.h Magic header minimod.pl Writes lib/ExtUtils/Miniperl.pm miniperlmain.c Basic perl w/o dynamic loading or extensions +mint/errno.h MiNT port +mint/Makefile MiNT port +mint/pwd.c MiNT port +mint/README MiNT port +mint/stdio.h MiNT port +mint/sys/time.h MiNT port +mint/time.h MiNT port mpeix/mpeixish.h MPE/iX port mpeix/nm MPE/iX port mpeix/relink MPE/iX port @@ -725,15 +746,18 @@ pod/perlmodinstall.pod Installing CPAN Modules pod/perlmodlib.pod Module policy info pod/perlobj.pod Object info pod/perlop.pod Operator info +pod/perlopentut.pod open() tutorial pod/perlpod.pod Pod info pod/perlport.pod Portability guide pod/perlre.pod Regular expression info pod/perlref.pod References info +pod/perlreftut.pod References tutorial pod/perlrun.pod Execution info pod/perlsec.pod Security info pod/perlstyle.pod Style info pod/perlsub.pod Subroutine info pod/perlsyn.pod Syntax info +pod/perlthrtut.pod Threads tutorial pod/perltie.pod Tieing an object class into a simple variable pod/perltoc.pod Table of Contents info pod/perltoot.pod Tom's object-oriented tutorial @@ -829,6 +853,7 @@ t/lib/dumper.t See if Data::Dumper works t/lib/english.t See if English works t/lib/env.t See if Env works t/lib/errno.t See if Errno works +t/lib/fatal.t See if Fatal works t/lib/fields.t See if base/fields works t/lib/filecache.t See if FileCache works t/lib/filecopy.t See if File::Copy works @@ -870,7 +895,8 @@ t/lib/socket.t See if Socket works t/lib/soundex.t See if Soundex works t/lib/symbol.t See if Symbol works t/lib/texttabs.t See if Text::Tabs works -t/lib/textwrap.t See if Text::Wrap works +t/lib/textfill.t See if Text::Wrap::fill works +t/lib/textwrap.t See if Text::Wrap::wrap works t/lib/thread.t Basic test of threading (skipped if no threads) t/lib/tie-push.t Test for Tie::Array t/lib/tie-stdarray.t Test for Tie::StdArray @@ -903,6 +929,7 @@ t/op/fork.t See if fork works t/op/glob.t See if <*> works t/op/goto.t See if goto works t/op/goto_xs.t See if "goto &sub" works on XSUBs +t/op/grep.t See if grep() and map() work t/op/groups.t See if $( works t/op/gv.t See if typeglobs work t/op/hashwarn.t See if warnings for bad hash assignments work @@ -938,7 +965,7 @@ t/op/repeat.t See if x operator works t/op/runlevel.t See if die() works from perl_call_*() t/op/sleep.t See if sleep works t/op/sort.t See if sort works -t/op/splice.t See if splice works +t/op/splice.t See if splice works t/op/split.t See if split works t/op/sprintf.t See if sprintf works t/op/stat.t See if stat works @@ -951,6 +978,7 @@ t/op/tie.t See if tie/untie functions work t/op/tiearray.t See if tie for arrays works t/op/tiehandle.t See if tie for handles works t/op/time.t See if time functions work +t/op/tr.t See if tr works t/op/undef.t See if undef works t/op/universal.t See if UNIVERSAL class works t/op/unshift.t See if unshift works @@ -1006,19 +1034,29 @@ vms/genconfig.pl retcon config.sh from config.h vms/genopt.com hack to write options files in case of broken makes vms/make_command.com record MM[SK] command used to build Perl vms/mms2make.pl convert descrip.mms to make syntax -vms/munchconfig.c performs shell $var substitution for VMS +vms/munchconfig.c performs shell $var substitution for VMS vms/myconfig.com record local configuration info for bug report vms/perlvms.pod VMS-specific additions to Perl documentation vms/perly_c.vms perly.c with fixed declarations for global syms vms/perly_h.vms perly.h with fixed declarations for global syms vms/sockadapt.c glue for SockshShr socket support vms/sockadapt.h glue for SockshShr socket support -vms/subconfigure.com performs compiler checks and writes config.sh, config.h, and descrip.mms +vms/subconfigure.com performs compiler checks and writes config.sh, config.h, and descrip.mms vms/test.com DCL driver for regression tests vms/vms.c VMS-specific C code for Perl core vms/vms_yfix.pl convert Unix perly.[ch] to VMS perly_[ch].vms vms/vmsish.h VMS-specific C header for Perl core vms/writemain.pl Generate perlmain.c from miniperlmain.c+extensions +vos/build.cm VOS command macro to build Perl +vos/Changes Changes made to port Perl to the VOS operating system +vos/compile_perl.cm VOS commnad macro to build multiple version of Perl +vos/config.h config.h for VOS +vos/config_h.SH_orig config_h.SH at the time config.h was created +vos/perl.bind VOS bind control file +vos/test_vos_dummies.c Test program for "vos_dummies.c" +vos/vos_accept.c Wrapper to fixup nonstandard VOS _accept function +vos/vos_dummies.c Wrappers to soak up undefined functions +vos/vosish.h VOS-specific header file win32/GenCAPI.pl Win32 port for C API with PERL_OBJECT win32/Makefile Win32 makefile for NMAKE (Visual C++ build) win32/TEST Win32 port diff --git a/contrib/perl5/Makefile.SH b/contrib/perl5/Makefile.SH index 050e471..61f01b5 100755 --- a/contrib/perl5/Makefile.SH +++ b/contrib/perl5/Makefile.SH @@ -43,12 +43,17 @@ true) # NeXT uses a different name. ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH" ;; + beos*) ldlibpth="LIBRARY_PATH=`pwd`:$LIBRARY_PATH" + ;; os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH. ldlibpth='' ;; - sunos*|freebsd[23]*|netbsd*) + sunos*) linklibperl="-lperl" ;; + netbsd*|freebsd[234]*) + linklibperl="-L. -lperl" + ;; aix*) shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp" case "$osvers" in @@ -161,7 +166,7 @@ shellflags = $shellflags $make_set_make # These variables may need to be manually set for non-Unix systems. -AR = $ar +AR = $full_ar EXE_EXT = $_exe LIB_EXT = $_a OBJ_EXT = $_o @@ -450,14 +455,15 @@ perly.h: perly.y -@sh -c true # No compat3.sym here since and including the 5.004_50. -SYM = global.sym interp.sym perlio.sym thread.sym +# No interp.sym since 5.005_03. +SYM = global.sym perlio.sym thread.sym SYMH = perlvars.h thrdvar.h # The following files are generated automatically # keywords.h: keywords.pl # opcode.h: opcode.pl -# embed.h: embed.pl global.sym interp.sym +# embed.h: embed.pl global.sym # byterun.h: bytecode.pl # byterun.c: bytecode.pl # lib/B/Asmdata.pm: bytecode.pl @@ -598,13 +604,13 @@ minitest: miniperl lib/re.pm # Please *don't* use this unless all tests pass. # If you want to report test failures, use "make nok" instead. ok: utilities - $(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' + $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' okfile: utilities - $(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok + $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok nok: utilities - $(LBLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' + $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' clist: $(c) echo $(c) | tr ' ' $(TRNL) >.clist @@ -644,3 +650,70 @@ case `pwd` in ;; esac $rm -f $firstmakefile + +# Now do any special processing required before building. + +case "$ebcdic" in +$define) + xxx='' + echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 +case "$osname" in +os390) + rm -f y.tab.c y.tab.h + yacc -d perly.y >/dev/null 2>&1 + if cmp -s y.tab.c perly.c; then + rm -f y.tab.c + else + echo "perly.y -> perly.c" >&2 + mv -f y.tab.c perly.c + chmod u+w perly.c + sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c + xxx="$xxx perly.c" + fi + if cmp -s y.tab.h perly.h; then + rm -f y.tab.h + else + echo "perly.y -> perly.h" >&2 + mv -f y.tab.h perly.h + xxx="$xxx perly.h" + fi + if cd x2p + then + rm -f y.tab.c y.tab.h + yacc a2p.y >/dev/null 2>&1 + if cmp -s y.tab.c a2p.c + then + rm -f y.tab.c + else + echo "a2p.y -> a2p.c" >&2 + mv -f y.tab.c a2p.c + chmod u+w a2p.c + sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c + xxx="$xxx a2p.c" + fi + # In case somebody yacc -d:ed the a2p.y. + if test -f y.tab.h + then + if cmp -s y.tab.h a2p.h + then + rm -f y.tab.h + else + echo "a2p.h -> a2p.h" >&2 + mv -f y.tab.h a2p.h + xxx="$xxx a2p.h" + fi + fi + cd .. + fi + ;; +*) + echo "'$osname' is an EBCDIC system I don't know that well." >&4 + ;; +esac + case "$xxx" in + '') echo "No parser files were regenerated. That's okay." >&2 ;; + esac + ;; +esac diff --git a/contrib/perl5/Porting/Glossary b/contrib/perl5/Porting/Glossary index f681679..52b560e 100644 --- a/contrib/perl5/Porting/Glossary +++ b/contrib/perl5/Porting/Glossary @@ -5,7 +5,7 @@ generates pod documentation for Config.pm from this file--please try to keep the formatting regular.] Mcc (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the Mcc program. After Configure runs, the value is reset to a plain "Mcc" and is not useful. @@ -52,7 +52,7 @@ apiversion (patchlevel.U): will retain binary compatibility. ar (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the ar program. After Configure runs, the value is reset to a plain "ar" and is not useful. @@ -79,7 +79,7 @@ archobjs (Unix.U): include os2/os2.obj. awk (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the awk program. After Configure runs, the value is reset to a plain "awk" and is not useful. @@ -105,7 +105,7 @@ bison (Loc.U): The value is a plain '' and is not useful. byacc (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the byacc program. After Configure runs, the value is reset to a plain "byacc" and is not useful. @@ -129,7 +129,7 @@ castflags (d_castneg.U): 4 = couldn't cast in argument expression list cat (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the cat program. After Configure runs, the value is reset to a plain "cat" and is not useful. @@ -154,6 +154,12 @@ ccflags (ccflags.U): This variable contains any additional C compiler flags desired by the user. It is up to the Makefile to use this. +ccsymbols (Cppsym.U): + The variable contains the symbols defined by the C compiler alone. + The symbols defined by cpp or by cc when it calls cpp are not in + this list, see cppsymbols and cppccsymbols. + The list is a space-separated list of symbol=value tokens. + cf_by (cf_who.U): Login name of the person who ran the Configure script and answered the questions. This is used to tag both config.sh and config_h.SH. @@ -184,7 +190,7 @@ clocktype (d_times.U): included). comm (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the comm program. After Configure runs, the value is reset to a plain "comm" and is not useful. @@ -199,7 +205,7 @@ contains (contains.U): is primarily for the use of other Configure units. cp (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the cp program. After Configure runs, the value is reset to a plain "cp" and is not useful. @@ -208,7 +214,7 @@ cpio (Loc.U): The value is a plain '' and is not useful. cpp (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the cpp program. After Configure runs, the value is reset to a plain "cpp" and is not useful. @@ -244,13 +250,25 @@ cppstdin (cppstdin.U): It is primarily used by other Configure units that ask about preprocessor symbols. +cppsymbols (Cppsym.U): + The variable contains the symbols defined by the C preprocessor + alone. The symbols defined by cc or by cc when it calls cpp are + not in this list, see ccsymbols and cppccsymbols. + The list is a space-separated list of symbol=value tokens. + +cppccsymbols (Cppsym.U): + The variable contains the symbols defined by the C compiler when + when it calls cpp. The symbols defined by the cc alone or cpp + alone are not in this list, see ccsymbols and cppsymbols. + The list is a space-separated list of symbol=value tokens. + cryptlib (d_crypt.U): This variable holds -lcrypt or the path to a libcrypt.a archive if the crypt() function is not defined in the standard C library. It is up to the Makefile to use this. csh (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the csh program. After Configure runs, the value is reset to a plain "csh" and is not useful. @@ -477,6 +495,14 @@ d_fsetpos (d_fsetpos.U): This variable conditionally defines HAS_FSETPOS if fsetpos() is available to set the file position indicator. +d_fstatfs (d_statfs.U): + This variable conditionally defines the HAS_FSTATFS symbol, which + indicates to the C program that the fstatfs() routine is available. + +d_fstatvfs (d_statvfs.U): + This variable conditionally defines the HAS_FSTATVFS symbol, which + indicates to the C program that the fstatvfs() routine is available. + d_ftime (d_ftime.U): This variable conditionally defines the HAS_FTIME symbol, which indicates that the ftime() routine exists. The ftime() routine is basically @@ -522,6 +548,11 @@ d_getlogin (d_getlogin.U): indicates to the C program that the getlogin() routine is available to get the login name. +d_getmntent (d_getmntent.U): + This variable conditionally defines the HAS_GETMNTENT symbol, which + indicates to the C program that the getmntent() routine is available + to iterate through mounted files. + d_getnbyaddr (d_getnbyad.U): This variable conditionally defines the HAS_GETNETBYADDR symbol, which indicates to the C program that the getnetbyaddr() routine is available @@ -626,6 +657,11 @@ d_grpasswd (i_grp.U): This variable conditionally defines GRPASSWD, which indicates that struct group in contains gr_passwd. +d_hasmntopt (d_hasmntopt.U): + This variable conditionally defines the HAS_HASMNTOPT symbol, which + indicates to the C program that the hasmntopt() routine is available + to query the mount options of file systems. + d_htonl (d_htonl.U): This variable conditionally defines HAS_HTONL if htonl() and its friends are available to do network order byte swapping. @@ -1072,6 +1108,16 @@ d_statblks (d_statblks.U): This variable conditionally defines USE_STAT_BLOCKS if this system has a stat structure declaring st_blksize and st_blocks. +d_statfsflags (d_statfs.U): + This variable conditionally defines the HAS_STRUCT_STATFS_FLAGS + symbol, which indicates to struct statfs from has f_flags member. + This kind of struct statfs is coming from sys/mount.h (BSD), + not from sys/statfs.h (SYSV). + +d_statvfs (d_statvfs.U): + This variable conditionally defines the HAS_STATVFS symbol, which + indicates to the C program that the statvfs() routine is available. + d_stdio_cnt_lval (d_stdstdio.U): This variable conditionally defines STDIO_CNT_LVALUE if the FILE_cnt macro can be used as an lvalue. @@ -1260,7 +1306,7 @@ d_xenix (Guess.U): the C program that it runs under Xenix. date (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the date program. After Configure runs, the value is reset to a plain "date" and is not useful. @@ -1307,12 +1353,12 @@ ebcdic (ebcdic.U): See trnl.U echo (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the echo program. After Configure runs, the value is reset to a plain "echo" and is not useful. egrep (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the egrep program. After Configure runs, the value is reset to a plain "egrep" and is not useful. @@ -1329,7 +1375,7 @@ exe_ext (Unix.U): This is an old synonym for _exe. expr (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the expr program. After Configure runs, the value is reset to a plain "expr" and is not useful. @@ -1340,7 +1386,7 @@ extensions (Extensions.U): is available. find (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the find program. After Configure runs, the value is reset to a plain "find" and is not useful. @@ -1362,6 +1408,11 @@ freetype (mallocsrc.U): This variable contains the return type of free(). It is usually void, but occasionally int. +full_ar (Loc_ar.U): + This variable contains the full pathname to 'ar', whether or + not the user has specified 'portability'. This is only used + in the Makefile.SH. + full_csh (d_csh.U): This variable contains the full pathname to 'csh', whether or not the user has specified 'portability'. This is only used @@ -1387,7 +1438,7 @@ gidtype (gidtype.U): of getgid(). Typically, it is the type of group ids in the kernel. grep (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the grep program. After Configure runs, the value is reset to a plain "grep" and is not useful. @@ -1403,7 +1454,7 @@ groupstype (groupstype.U): gidtype (gid_t), but sometimes it isn't. gzip (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the gzip program. After Configure runs, the value is reset to a plain "gzip" and is not useful. @@ -1489,6 +1540,10 @@ i_locale (i_locale.U): This variable conditionally defines the I_LOCALE symbol, and indicates whether a C program should include . +i_machcthr (i_machcthr.U): + This variable conditionally defines the I_MACH_CTHREADS symbol, + and indicates whether a C program should include . + i_malloc (i_malloc.U): This variable conditionally defines the I_MALLOC symbol, and indicates whether a C program should include . @@ -1501,6 +1556,10 @@ i_memory (i_memory.U): This variable conditionally defines the I_MEMORY symbol, and indicates whether a C program should include . +i_mntent (i_mntent.U): + This variable conditionally defines the I_MNTENT symbol, and indicates + whether a C program should include . + i_ndbm (i_ndbm.U): This variable conditionally defines the I_NDBM symbol, which indicates to the C program that exists and should @@ -1580,6 +1639,10 @@ i_sysioctl (i_sysioctl.U): indicates to the C program that exists and should be included. +i_sysmount (i_sysmount.U): + This variable conditionally defines the I_SYSMOUNT symbol, + and indicates whether a C program should include . + i_sysndir (i_sysndir.U): This variable conditionally defines the I_SYS_NDIR symbol, and indicates whether a C program should include . @@ -1606,6 +1669,14 @@ i_sysstat (i_sysstat.U): This variable conditionally defines the I_SYS_STAT symbol, and indicates whether a C program should include . +i_sysstatfs (i_sysstatfs.U): + This variable conditionally defines the I_SYSSTATFS symbol, + and indicates whether a C program should include . + +i_sysstatvfs (i_sysstatvfs.U): + This variable conditionally defines the I_SYSSTATVFS symbol, + and indicates whether a C program should include . + i_systime (i_time.U): This variable conditionally defines I_SYS_TIME, which indicates to the C program that it should include . @@ -1671,6 +1742,11 @@ i_vfork (i_vfork.U): This variable conditionally defines the I_VFORK symbol, and indicates whether a C program should include vfork.h. +ignore_versioned_solibs (libs.U): + This variable should be non-empty if non-versioned shared + libraries (libfoo.so.x.y) are to be ignored (because they + cannot be linked against). + incpath (usrinc.U): This variable must preceed the normal include path to get hte right one, as in "$incpath/usr/include" or "$incpath/usr/lib". @@ -1722,6 +1798,11 @@ installsitelib (sitelib.U): those systems using AFS. For extra portability, only this variable should be used in makefiles. +installusrbinperl (instubperl.U): + This variable tells whether Perl should be installed also as + /usr/bin/perl in addition to + $installbin/perl + intsize (intsize.U): This variable contains the value of the INTSIZE symbol, which indicates to the C program how many bytes there are in an int. @@ -1756,7 +1837,7 @@ ldflags (ccflags.U): the user. It is up to the Makefile to use this. less (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the less program. After Configure runs, the value is reset to a plain "less" and is not useful. @@ -1788,7 +1869,7 @@ libswanted (Myinit.U): ahead of ucb or bsd libraries for SVR4. line (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the line program. After Configure runs, the value is reset to a plain "line" and is not useful. @@ -1801,7 +1882,7 @@ lkflags (ccflags.U): the user. It is up to the Makefile to use this. ln (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the ln program. After Configure runs, the value is reset to a plain "ln" and is not useful. @@ -1845,7 +1926,7 @@ lpr (Loc.U): The value is a plain '' and is not useful. ls (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the ls program. After Configure runs, the value is reset to a plain "ls" and is not useful. @@ -1863,7 +1944,7 @@ mailx (Loc.U): The value is a plain '' and is not useful. make (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the make program. After Configure runs, the value is reset to a plain "make" and is not useful. @@ -1934,7 +2015,7 @@ mips_type (usrinc.U): Possible values are "BSD 4.3" and "System V". mkdir (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the mkdir program. After Configure runs, the value is reset to a plain "mkdir" and is not useful. @@ -1949,7 +2030,7 @@ modetype (modetype.U): modes for system calls. more (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the more program. After Configure runs, the value is reset to a plain "more" and is not useful. @@ -2006,7 +2087,7 @@ netdb_net_type (netdbtype.U): This is only useful if you have getnetbyaddr(), naturally. nm (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the nm program. After Configure runs, the value is reset to a plain "nm" and is not useful. @@ -2026,7 +2107,7 @@ nonxs_ext (Extensions.U): in the package. All of them will be built. nroff (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the nroff program. After Configure runs, the value is reset to a plain "nroff" and is not useful. @@ -2086,7 +2167,7 @@ path_sep (Unix.U): used to separate elements in the command shell search PATH. perl (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the perl program. After Configure runs, the value is reset to a plain "perl" and is not useful. @@ -2099,7 +2180,7 @@ perlpath (perlpath.U): shell scripts and in the "eval 'exec'" idiom. pg (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the pg program. After Configure runs, the value is reset to a plain "pg" and is not useful. @@ -2172,7 +2253,7 @@ rd_nodata (nblock_io.U): no data and an EOF.. Sigh! rm (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the rm program. After Configure runs, the value is reset to a plain "rm" and is not useful. @@ -2197,10 +2278,17 @@ scriptdirexp (scriptdir.U): at configuration time, for programs not wanting to bother with it. sed (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the sed program. After Configure runs, the value is reset to a plain "sed" and is not useful. +selectminbits (selectminbits.U): + This variable holds the minimum number of bits operated by select. + That is, if you do select(n, ...), how many bits at least will be + cleared in the masks if some activity is detected. Usually this + is either n or 32*ceil(n/32), especially many little-endians do + the latter. This is only useful if you have select(), naturally. + selecttype (selecttype.U): This variable holds the type used for the 2nd, 3rd, and 4th arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET @@ -2208,7 +2296,7 @@ selecttype (selecttype.U): have select(), naturally. sendmail (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the sendmail program. After Configure runs, the value is reset to a plain "sendmail" and is not useful. @@ -2277,6 +2365,12 @@ sig_num (sig_name.U): the value of the signal listed in the same place within the sig_name list. +sig_num_init (sig_name.U): + This variable holds the signal numbers, enclosed in double quotes and + separated by commas, suitable for use in the SIG_NUM definition + below. A "ZERO" is prepended to the list, and the list is + terminated with a plain 0. + signal_t (d_voidsig.U): This variable holds the type of the signal handler (void or int). @@ -2329,7 +2423,7 @@ socketlib (d_socket.U): This variable has the names of any libraries needed for socket support. sort (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the sort program. After Configure runs, the value is reset to a plain "sort" and is not useful. @@ -2440,12 +2534,12 @@ tbl (Loc.U): The value is a plain '' and is not useful. tee (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the tee program. After Configure runs, the value is reset to a plain "tee" and is not useful. test (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the test program. After Configure runs, the value is reset to a plain "test" and is not useful. @@ -2458,12 +2552,12 @@ timetype (d_time.U): included). Anyway, the type Time_t should be used. touch (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the touch program. After Configure runs, the value is reset to a plain "touch" and is not useful. tr (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the tr program. After Configure runs, the value is reset to a plain "tr" and is not useful. @@ -2482,12 +2576,12 @@ uidtype (uidtype.U): ushort, or whatever type is used to declare user ids in the kernel. uname (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the uname program. After Configure runs, the value is reset to a plain "uname" and is not useful. uniq (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the uniq program. After Configure runs, the value is reset to a plain "uniq" and is not useful. @@ -2574,7 +2668,7 @@ zcat (Loc.U): The value is a plain '' and is not useful. zip (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the zip program. After Configure runs, the value is reset to a plain "zip" and is not useful. diff --git a/contrib/perl5/Porting/patching.pod b/contrib/perl5/Porting/patching.pod index e3b6188..caada0c 100644 --- a/contrib/perl5/Porting/patching.pod +++ b/contrib/perl5/Porting/patching.pod @@ -10,7 +10,7 @@ The latest version of this document is available from =head2 How to contribute to this document You may mail corrections, additions, and suggestions to me -at dgris@tdrenterprises.com but the preferred method would be +at dgris@dimensional.com but the preferred method would be to follow the instructions set forth in this document and submit a patch 8-). @@ -36,6 +36,12 @@ and patches not produced using standard utilities (such as diff). =head1 Proper Patch Guidelines +=head2 What to patch + +Generally speaking you should patch the latest development release +of perl. The maintainers of the individual branches will see to it +that patches are picked up and applied as appropriate. + =head2 How to prepare your patch =over 4 @@ -159,18 +165,19 @@ guidelines (courtesy of Gurusamy Sarathy (gsar@engin.umich.edu))- Interpret results strictly. Use unrelated features (this will flush out bizarre interactions). Use non-standard idioms (otherwise you are not testing TIMTOWTDI). - Avoid using hardcoded test umbers whenever possible (the EXPECTED/GOT style - found in t/op/tie.t is much more maintainable, and gives better failure - reports). + Avoid using hardcoded test numbers whenever possible (the + EXPECTED/GOT found in t/op/tie.t is much more maintainable, + and gives better failure reports). Give meaningful error messages when a test fails. Avoid using qx// and system() unless you are testing for them. If you do use them, make sure that you cover _all_ perl platforms. Unlink any temporary files you create. Promote unforeseen warnings to errors with $SIG{__WARN__}. - Be sure to use the libraries and modules shipped with version being tested, - not those that were already installed. + Be sure to use the libraries and modules shipped with version + being tested, not those that were already installed. Add comments to the code explaining what you are testing for. - Make updating the '1..42' string unnecessary. Or make sure that you update it. + Make updating the '1..42' string unnecessary. Or make sure that + you update it. Test _all_ behaviors of a given operator, library, or function- All optional arguments Return values in various contexts (boolean, scalar, list, lvalue) @@ -289,23 +296,25 @@ others will have an easy time using your work, and it should be easier for the maintainers to coordinate the occasionally large numbers of patches received. -Also, just because you're not a brilliant coder doesn't mean that you can't -contribute. As valuable as code patches are there is always a need for better -documentation (especially considering the general level of joy that most -programmers feel when forced to sit down and write docs). If all you do -is patch the documentation you have still contributed more than the person -who sent in an amazing new feature that noone can use because noone understands -the code (what I'm getting at is that documentation is both the hardest part to -do (because everyone hates doing it) and the most valuable). - -Mostly, when contributing patches, imagine that it is B receiving hundreds -of patches and that it is B responsibility to integrate them into the source. -Obviously you'd want the patches to be as easy to apply as possible. Keep that in -mind. 8-) +Also, just because you're not a brilliant coder doesn't mean that you +can't contribute. As valuable as code patches are there is always a +need for better documentation (especially considering the general +level of joy that most programmers feel when forced to sit down and +write docs). If all you do is patch the documentation you have still +contributed more than the person who sent in an amazing new feature +that no one can use because no one understands the code (what I'm +getting at is that documentation is both the hardest part to do +(because everyone hates doing it) and the most valuable). + +Mostly, when contributing patches, imagine that it is B receiving +hundreds of patches and that it is B responsibility to integrate +them into the source. Obviously you'd want the patches to be as easy +to apply as possible. Keep that in mind. 8-) =head1 Last Modified -Last modified 21 May 1998 by Daniel Grisinger +Last modified 21 January 1999 +Daniel Grisinger =head1 Author and Copyright Information @@ -314,6 +323,3 @@ Copyright (c) 1998 Daniel Grisinger Adapted from a posting to perl5-porters by Tim Bunce (Tim.Bunce@ig.co.uk). I'd like to thank the perl5-porters for their suggestions. - - - diff --git a/contrib/perl5/Porting/pumpkin.pod b/contrib/perl5/Porting/pumpkin.pod index f41dfac..335e49f 100644 --- a/contrib/perl5/Porting/pumpkin.pod +++ b/contrib/perl5/Porting/pumpkin.pod @@ -1178,6 +1178,16 @@ the dist-users mailing list along these lines. They have been folded back into the main distribution, but various parts of the perl Configure/build/install process still assume src='.'. +=item Directory for vendor-supplied modules? + +If a vendor supplies perl, but wants to leave $siteperl and $sitearch +for the local user to use, where should the vendor put vendor-supplied +modules (such as Tk.so?) If the vendor puts them in $archlib, then +they need to be updated each time the perl version is updated. +Perhaps we need a set of libries $vendorperl and $vendorarch that +track $apiversion (like the $sitexxx directories do) rather than +just $version (like the main perl directory). + =item Hint file fixes Various hint files work around Configure problems. We ought to fix diff --git a/contrib/perl5/README b/contrib/perl5/README index 7cc8021..e3ccad4 100644 --- a/contrib/perl5/README +++ b/contrib/perl5/README @@ -1,7 +1,7 @@ Perl Kit, Version 5.0 - Copyright 1989-1997, Larry Wall + Copyright 1989-1999, Larry Wall All rights reserved. This program is free software; you can redistribute it and/or modify @@ -22,8 +22,8 @@ Kit, in the file named "Artistic". If not, I'll be glad to provide one. You should also have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + along with this program; if not, write to the Free Software Foundation, + Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. For those of you that choose to use the GNU General Public License, my interpretation of the GNU General Public License is that no Perl diff --git a/contrib/perl5/README.threads b/contrib/perl5/README.threads index 952623f..136b156 100644 --- a/contrib/perl5/README.threads +++ b/contrib/perl5/README.threads @@ -1,3 +1,10 @@ +NOTE + +Threading is a highly experimental feature. There are still a +few race conditions that show up under high contention on SMP +machines. Internal implementation is still subject to changes. +It is not recommended for production use at this time. + Building If you want to build with multi-threading support and you are @@ -27,7 +34,8 @@ work or you are using another platform which you believe supports POSIX.1c threads then read on. Additional information may be in a platform-specific "hints" file in the hints/ subdirectory. -Omit the -d from your ./Configure arguments. For example, use +On other platforms that use Configure to build perl, omit the -d +from your ./Configure arguments. For example, use: ./Configure -Dusethreads @@ -92,6 +100,10 @@ For AIX: Add -lc_r to libswanted Change -lc in lddflags to be -lpthread -lc_r -lc +For Win32: + See README.win32, and the notes at the beginning of win32/Makefile + or win32/makefile.mk. + Now you can do a make @@ -147,11 +159,8 @@ libraries were not compiled to be thread-aware). Bugs * FAKE_THREADS should produce a working perl but the Thread -extension won't build with it yet. - -* There's a known memory leak (curstack isn't freed at the end -of each thread because it causes refcount problems that I -haven't tracked down yet) and there are very probably others too. +extension won't build with it yet. (FAKE_THREADS has not been +tested at all in recent times.) * There may still be races where bugs show up under contention. @@ -275,3 +284,6 @@ Last updated: 27 November 1997 Configure-related info updated 16 July 1998 by Andy Dougherty + +Other minor updates 10 Feb 1999 by +Gurusamy Sarathy diff --git a/contrib/perl5/Todo b/contrib/perl5/Todo index 3340e4f..5867c40 100644 --- a/contrib/perl5/Todo +++ b/contrib/perl5/Todo @@ -10,9 +10,8 @@ Would be nice to have lexperl Bundled perl preprocessor Use posix calls internally where possible - gettimeofday + gettimeofday (possibly best left for a module?) format BOTTOM - -iprefix. -i rename file only when successfully changed All ARGV input should act like <> report HANDLE [formats]. @@ -23,6 +22,8 @@ Would be nice to have lvalue functions regression/sanity tests for suidperl Full 64 bit support (i.e. "long long") + Generalise Errno way of extracting cpp symbols and use that in + Errno and Fcntl (ExtUtils::CppSymbol?) Possible pragmas debugger diff --git a/contrib/perl5/Todo-5.005 b/contrib/perl5/Todo-5.005 index 404e5ec..7f2dbc9 100644 --- a/contrib/perl5/Todo-5.005 +++ b/contrib/perl5/Todo-5.005 @@ -1,26 +1,21 @@ Multi-threading $AUTOLOAD. Hmm. - without USE_THREADS, change extern variable for dTHR consistent semantics for exit/die in threads SvREFCNT_dec(curstack) in threadstart() in Thread.xs better support for externally created threads Thread::Pool - more Configure support spot-check globals like statcache and global GVs for thread-safety Compiler auto-produce executable typed lexicals should affect B::CC::load_pad workarounds to help Win32 - $^C to track compiler/checker status END blocks need saving in compiled output _AUTOLOAD prodding fix comppadlist (names in comppad_name can have fake SvCUR from where newASSIGNOP steals the field) Namespace cleanup - symbol-space: "pl_" prefix for all global vars - "Perl_" prefix for all functions CPP-space: restrict what we export from headers stop malloc()/free() pollution unless asked header-space: move into CORE/perl/ @@ -28,9 +23,7 @@ Namespace cleanup MULTIPLICITY support complete work on safe recursive interpreters, Cnew()> - -Configure - installation layout changes to avoid overwriting old versions + revisit extra implicit arg that provides curthread/curinterp context Reliable Signals alternate runops() for signal despatch @@ -38,31 +31,31 @@ Reliable Signals add tests for Thread::Signal Win32 stuff - automate maintenance of most PERL_OBJECT code get PERL_OBJECT building under gcc + get PERL_OBJECT building on non-win32 + automate generation of 'protected' prototypes for CPerlObj rename new headers to be consistent with the rest sort out the spawnvp() mess work out DLL versioning - put perlobject in $ARCHNAME so it can coexist with rest - get PERL_OBJECT building on non-win32? style-check Miscellaneous rename and alter ISA.pm magic_setisa should be made to update %FIELDS [???] - be generous in accepting foreign line terminations - make filenames 8.3 friendly, where feasible - upgrade to newer versions of all independently maintained modules - add new modules (Data-Dumper, Storable?) - test it with large parts of CPAN + add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?) fix pod2html to generate relative URLs + automate testing with large parts of CPAN -Documentation +Ongoing + keep filenames 8.3 friendly, where feasible + upgrade to newer versions of all independently maintained modules comprehensive perldelta.pod + +Documentation describe new age patterns update perl{guts,call,embed,xs} with additions, changes to API document Win32 choices - rework INSTALL to reflect changes in installation structure spot-check all new modules for completeness better docs for pack()/unpack() - add perlport.pod + reorg tutorials vs. reference sections + diff --git a/contrib/perl5/XSUB.h b/contrib/perl5/XSUB.h index dc805d8..a6577d8 100644 --- a/contrib/perl5/XSUB.h +++ b/contrib/perl5/XSUB.h @@ -57,8 +57,8 @@ #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ - SV *tmpsv; \ - char *vn = Nullch, *module = SvPV(ST(0),PL_na); \ + SV *tmpsv; STRLEN n_a; \ + char *vn = Nullch, *module = SvPV(ST(0),n_a); \ if (items >= 2) /* version supplied as bootstrap arg */ \ tmpsv = ST(1); \ else { \ @@ -69,7 +69,7 @@ tmpsv = perl_get_sv(form("%s::%s", module, \ vn = "VERSION"), FALSE); \ } \ - if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na)))) \ + if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \ croak("%s object version %s does not match %s%s%s%s %_", \ module, XS_VERSION, \ vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ @@ -79,6 +79,70 @@ # define XS_VERSION_BOOTCHECK #endif +#ifdef PERL_CAPI +# define VTBL_sv get_vtbl(want_vtbl_sv) +# define VTBL_env get_vtbl(want_vtbl_env) +# define VTBL_envelem get_vtbl(want_vtbl_envelem) +# define VTBL_sig get_vtbl(want_vtbl_sig) +# define VTBL_sigelem get_vtbl(want_vtbl_sigelem) +# define VTBL_pack get_vtbl(want_vtbl_pack) +# define VTBL_packelem get_vtbl(want_vtbl_packelem) +# define VTBL_dbline get_vtbl(want_vtbl_dbline) +# define VTBL_isa get_vtbl(want_vtbl_isa) +# define VTBL_isaelem get_vtbl(want_vtbl_isaelem) +# define VTBL_arylen get_vtbl(want_vtbl_arylen) +# define VTBL_glob get_vtbl(want_vtbl_glob) +# define VTBL_mglob get_vtbl(want_vtbl_mglob) +# define VTBL_nkeys get_vtbl(want_vtbl_nkeys) +# define VTBL_taint get_vtbl(want_vtbl_taint) +# define VTBL_substr get_vtbl(want_vtbl_substr) +# define VTBL_vec get_vtbl(want_vtbl_vec) +# define VTBL_pos get_vtbl(want_vtbl_pos) +# define VTBL_bm get_vtbl(want_vtbl_bm) +# define VTBL_fm get_vtbl(want_vtbl_fm) +# define VTBL_uvar get_vtbl(want_vtbl_uvar) +# define VTBL_defelem get_vtbl(want_vtbl_defelem) +# define VTBL_regexp get_vtbl(want_vtbl_regexp) +# ifdef USE_LOCALE_COLLATE +# define VTBL_collxfrm get_vtbl(want_vtbl_collxfrm) +# endif +# ifdef OVERLOAD +# define VTBL_amagic get_vtbl(want_vtbl_amagic) +# define VTBL_amagicelem get_vtbl(want_vtbl_amagicelem) +# endif +#else +# define VTBL_sv &vtbl_sv +# define VTBL_env &vtbl_env +# define VTBL_envelem &vtbl_envelem +# define VTBL_sig &vtbl_sig +# define VTBL_sigelem &vtbl_sigelem +# define VTBL_pack &vtbl_pack +# define VTBL_packelem &vtbl_packelem +# define VTBL_dbline &vtbl_dbline +# define VTBL_isa &vtbl_isa +# define VTBL_isaelem &vtbl_isaelem +# define VTBL_arylen &vtbl_arylen +# define VTBL_glob &vtbl_glob +# define VTBL_mglob &vtbl_mglob +# define VTBL_nkeys &vtbl_nkeys +# define VTBL_taint &vtbl_taint +# define VTBL_substr &vtbl_substr +# define VTBL_vec &vtbl_vec +# define VTBL_pos &vtbl_pos +# define VTBL_bm &vtbl_bm +# define VTBL_fm &vtbl_fm +# define VTBL_uvar &vtbl_uvar +# define VTBL_defelem &vtbl_defelem +# define VTBL_regexp &vtbl_regexp +# ifdef USE_LOCALE_COLLATE +# define VTBL_collxfrm &vtbl_collxfrm +# endif +# ifdef OVERLOAD +# define VTBL_amagic &vtbl_amagic +# define VTBL_amagicelem &vtbl_amagicelem +# endif +#endif + #ifdef PERL_OBJECT #include "objXSUB.h" #ifndef NO_XSLOCKS diff --git a/contrib/perl5/XSlock.h b/contrib/perl5/XSlock.h index 8fb0ce4..0b2c829 100644 --- a/contrib/perl5/XSlock.h +++ b/contrib/perl5/XSlock.h @@ -13,23 +13,26 @@ protected: }; XSLockManager g_XSLock; +CPerlObj* pPerl; class XSLock { public: - XSLock() { g_XSLock.Enter(); }; + XSLock(CPerlObj *p) { + g_XSLock.Enter(); + ::pPerl = p; + }; ~XSLock() { g_XSLock.Leave(); }; }; -CPerlObj* pPerl; - +/* PERL_CAPI does its own locking in xs_handler() */ +#if defined(PERL_OBJECT) && !defined(PERL_CAPI) #undef dXSARGS #define dXSARGS \ - dSP; dMARK; \ - I32 ax = mark - PL_stack_base + 1; \ - I32 items = sp - mark; \ - XSLock localLock; \ - ::pPerl = pPerl - + XSLock localLock(pPerl); \ + dSP; dMARK; \ + I32 ax = mark - PL_stack_base + 1; \ + I32 items = sp - mark +#endif /* PERL_OBJECT && !PERL_CAPI */ #endif diff --git a/contrib/perl5/av.c b/contrib/perl5/av.c index b5c9bc2..7652757 100644 --- a/contrib/perl5/av.c +++ b/contrib/perl5/av.c @@ -1,6 +1,6 @@ /* av.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -24,7 +24,7 @@ av_reify(AV *av) if (AvREAL(av)) return; #ifdef DEBUGGING - if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) + if (SvTIED_mg((SV*)av, 'P')) warn("av_reify called on tied array"); #endif key = AvMAX(av) + 1; @@ -41,6 +41,7 @@ av_reify(AV *av) key = AvARRAY(av) - AvALLOC(av); while (key) AvALLOC(av)[--key] = &PL_sv_undef; + AvREIFY_off(av); AvREAL_on(av); } @@ -49,14 +50,14 @@ av_extend(AV *av, I32 key) { dTHR; /* only necessary if we have to extend stack */ MAGIC *mg; - if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + if (mg = SvTIED_mg((SV*)av, 'P')) { dSP; ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP,2); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj((SV*)av, mg)); PUSHs(sv_2mortal(newSViv(key+1))); PUTBACK; perl_call_method("EXTEND", G_SCALAR|G_DISCARD); @@ -174,10 +175,7 @@ av_fetch(register AV *av, I32 key, I32 lval) if (key > AvFILLp(av)) { if (!lval) return 0; - if (AvREALISH(av)) - sv = NEWSV(5,0); - else - sv = sv_newmortal(); + sv = NEWSV(5,0); return av_store(av,key,sv); } if (AvARRAY(av)[key] == &PL_sv_undef) { @@ -370,7 +368,7 @@ av_undef(register AV *av) /*SUPPRESS 560*/ /* Give any tie a chance to cleanup first */ - if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) + if (SvTIED_mg((SV*)av, 'P')) av_fill(av, -1); /* mg_clear() ? */ if (AvREAL(av)) { @@ -397,12 +395,12 @@ av_push(register AV *av, SV *val) if (SvREADONLY(av)) croak(no_modify); - if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + if (mg = SvTIED_mg((SV*)av, 'P')) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP,2); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj((SV*)av, mg)); PUSHs(val); PUTBACK; ENTER; @@ -424,11 +422,11 @@ av_pop(register AV *av) return &PL_sv_undef; if (SvREADONLY(av)) croak(no_modify); - if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + if (mg = SvTIED_mg((SV*)av, 'P')) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - XPUSHs(mg->mg_obj); + XPUSHs(SvTIED_obj((SV*)av, mg)); PUTBACK; ENTER; if (perl_call_method("POP", G_SCALAR)) { @@ -459,12 +457,12 @@ av_unshift(register AV *av, register I32 num) if (SvREADONLY(av)) croak(no_modify); - if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + if (mg = SvTIED_mg((SV*)av, 'P')) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP,1+num); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj((SV*)av, mg)); while (num-- > 0) { PUSHs(&PL_sv_undef); } @@ -510,11 +508,11 @@ av_shift(register AV *av) return &PL_sv_undef; if (SvREADONLY(av)) croak(no_modify); - if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + if (mg = SvTIED_mg((SV*)av, 'P')) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - XPUSHs(mg->mg_obj); + XPUSHs(SvTIED_obj((SV*)av, mg)); PUTBACK; ENTER; if (perl_call_method("SHIFT", G_SCALAR)) { @@ -551,14 +549,14 @@ av_fill(register AV *av, I32 fill) croak("panic: null array"); if (fill < 0) fill = -1; - if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + if (mg = SvTIED_mg((SV*)av, 'P')) { dSP; ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP,2); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj((SV*)av, mg)); PUSHs(sv_2mortal(newSViv(fill+1))); PUTBACK; perl_call_method("STORESIZE", G_SCALAR|G_DISCARD); diff --git a/contrib/perl5/av.h b/contrib/perl5/av.h index 8de81f4..bef763d 100644 --- a/contrib/perl5/av.h +++ b/contrib/perl5/av.h @@ -1,6 +1,6 @@ /* av.h * - * Copyright (c) 1991-1998, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/bytecode.h b/contrib/perl5/bytecode.h index e28dd43..7f0ab13 100644 --- a/contrib/perl5/bytecode.h +++ b/contrib/perl5/bytecode.h @@ -64,7 +64,7 @@ typedef IV IV64; BGET_U32(hi); \ BGET_U32(lo); \ if (sizeof(IV) == 8) \ - arg = (IV) (hi << (sizeof(IV)*4) | lo); \ + arg = ((IV)hi << (sizeof(IV)*4) | lo); \ else if (((I32)hi == -1 && (I32)lo < 0) \ || ((I32)hi == 0 && (I32)lo >= 0)) { \ arg = (I32)lo; \ diff --git a/contrib/perl5/cc_runtime.h b/contrib/perl5/cc_runtime.h index 18e3ba2..9a01ff8 100644 --- a/contrib/perl5/cc_runtime.h +++ b/contrib/perl5/cc_runtime.h @@ -45,7 +45,7 @@ case 0: \ PL_op = ppaddr(ARGS); \ PL_retstack[PL_retstack_ix - 1] = Nullop; \ - if (PL_op != nxt) runops(); \ + if (PL_op != nxt) CALLRUNOPS(); \ JMPENV_POP; \ break; \ case 1: JMPENV_POP; JMPENV_JUMP(1); \ diff --git a/contrib/perl5/config_h.SH b/contrib/perl5/config_h.SH index 49f86c7..0b42d29 100755 --- a/contrib/perl5/config_h.SH +++ b/contrib/perl5/config_h.SH @@ -239,6 +239,54 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_fsetpos HAS_FSETPOS /**/ +/* I_SYS_MOUNT: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_sysmount I_SYS_MOUNT /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat the filesystem of a file descriptor. + */ +#$d_fstatfs HAS_FSTATFS /**/ + +/* HAS_STRUCT_STATFS_FLAGS: + * This symbol, if defined, indicates that the struct statfs has + * the f_flags member for mount flags. + */ +#$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_sysstatvfs I_SYS_STATVFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat the filesystem of a file descriptor. + */ +#$d_fstatvfs HAS_FSTATVFS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_mntent I_MNTENT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to lookup mount entries in some data base or other. + */ +#$d_getmntent HAS_GETMNTENT /**/ + +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query mount entries returned by getmntent. + */ +#$d_hasmntopt HAS_HASMNTOPT /**/ + /* HAS_GETTIMEOFDAY: * This symbol, if defined, indicates that the gettimeofday() system * call is available for a sub-second accuracy clock. Usually, the file @@ -1813,7 +1861,7 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * the sig_name list. */ #define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num /**/ +#define SIG_NUM $sig_num_init /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this @@ -1902,6 +1950,15 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PRIVLIB "$privlib" /**/ #define PRIVLIB_EXP "$privlibexp" /**/ +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. + */ +#define SELECT_MIN_BITS $selectminbits /**/ + /* SITEARCH: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's @@ -2017,6 +2074,18 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define ARCHNAME "$archname" /**/ +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_machcthreads I_MACH_CTHREADS /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_pthread I_PTHREAD /**/ + /* HAS_PTHREAD_YIELD: * This symbol, if defined, indicates that the pthread_yield * routine is available to yield the execution of the current diff --git a/contrib/perl5/configure.com b/contrib/perl5/configure.com index 5212219..d51793a 100644 --- a/contrib/perl5/configure.com +++ b/contrib/perl5/configure.com @@ -974,7 +974,7 @@ $ line = F$EDIT(line,"COMPRESS, TRIM") $ patchlevel = F$EXTRACT(18,F$LENGTH(line)-18,line) $ got_patch = "true" $ ENDIF -$ IF ((F$LOCATE("SUBVERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_sub)) +$ IF ((F$LOCATE("#define SUBVERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_sub)) $ THEN $ line = F$EDIT(line,"COMPRESS, TRIM") $ subversion = F$EXTRACT(18,F$LENGTH(line)-18,line) diff --git a/contrib/perl5/cop.h b/contrib/perl5/cop.h index 9c8eae6..7d6730f 100644 --- a/contrib/perl5/cop.h +++ b/contrib/perl5/cop.h @@ -1,6 +1,6 @@ /* cop.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -142,7 +142,7 @@ struct block_loop { #define POPLOOP2() \ SvREFCNT_dec(cxloop.iterlval); \ if (cxloop.itervar) { \ - SvREFCNT_dec(*cxloop.itervar); \ + sv_2mortal(*cxloop.itervar); \ *cxloop.itervar = cxloop.itersave; \ } \ if (cxloop.iterary && cxloop.iterary != PL_curstack) \ @@ -180,17 +180,17 @@ struct block { cx->cx_type = t, \ cx->blk_oldsp = sp - PL_stack_base, \ cx->blk_oldcop = PL_curcop, \ - cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \ + cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \ cx->blk_oldscopesp = PL_scopestack_ix, \ - cx->blk_oldretsp = PL_retstack_ix, \ + cx->blk_oldretsp = PL_retstack_ix, \ cx->blk_oldpm = PL_curpm, \ cx->blk_gimme = gimme; \ DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \ - (long)cxstack_ix, block_type[t]); ) + (long)cxstack_ix, block_type[CxTYPE(cx)]); ) /* Exit a block (RETURN and LAST). */ #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \ - newsp = PL_stack_base + cx->blk_oldsp, \ + newsp = PL_stack_base + cx->blk_oldsp, \ PL_curcop = cx->blk_oldcop, \ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ PL_scopestack_ix = cx->blk_oldscopesp, \ @@ -198,14 +198,15 @@ struct block { pm = cx->blk_oldpm, \ gimme = cx->blk_gimme; \ DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \ - (long)cxstack_ix+1,block_type[cx->cx_type]); ) + (long)cxstack_ix+1,block_type[CxTYPE(cx)]); ) /* Continue a block elsewhere (NEXT and REDO). */ #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ - PL_stack_sp = PL_stack_base + cx->blk_oldsp, \ + PL_stack_sp = PL_stack_base + cx->blk_oldsp, \ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ PL_scopestack_ix = cx->blk_oldscopesp, \ - PL_retstack_ix = cx->blk_oldretsp + PL_retstack_ix = cx->blk_oldretsp, \ + PL_curpm = cx->blk_oldpm /* substitution context */ struct subst { @@ -261,12 +262,14 @@ struct subst { rxres_free(&cx->sb_rxres) struct context { - I32 cx_type; /* what kind of context this is */ + U32 cx_type; /* what kind of context this is */ union { struct block cx_blk; struct subst cx_subst; } cx_u; }; + +#define CXTYPEMASK 0xff #define CXt_NULL 0 #define CXt_SUB 1 #define CXt_EVAL 2 @@ -274,6 +277,12 @@ struct context { #define CXt_SUBST 4 #define CXt_BLOCK 5 +/* private flags for CXt_EVAL */ +#define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */ + +#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) +#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) == (CXt_EVAL|CXp_REAL)) + #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) /* "gimme" values */ diff --git a/contrib/perl5/cv.h b/contrib/perl5/cv.h index c7c7a73..9605135 100644 --- a/contrib/perl5/cv.h +++ b/contrib/perl5/cv.h @@ -1,6 +1,6 @@ /* cv.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -94,3 +94,12 @@ struct xpvcv { #define CvLOCKED(cv) (CvFLAGS(cv) & CVf_LOCKED) #define CvLOCKED_on(cv) (CvFLAGS(cv) |= CVf_LOCKED) #define CvLOCKED_off(cv) (CvFLAGS(cv) &= ~CVf_LOCKED) + +#define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv)) +#define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv)) +#define CvEVAL_off(cv) CvUNIQUE_off(cv) + +/* BEGIN|INIT|END */ +#define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv)) +#define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv)) +#define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv)) diff --git a/contrib/perl5/deb.c b/contrib/perl5/deb.c index 0c25225..ad26cd6 100644 --- a/contrib/perl5/deb.c +++ b/contrib/perl5/deb.c @@ -1,6 +1,6 @@ /* deb.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/doio.c b/contrib/perl5/doio.c index 85d604b..74544c9 100644 --- a/contrib/perl5/doio.c +++ b/contrib/perl5/doio.c @@ -1,6 +1,6 @@ /* doio.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -18,13 +18,12 @@ #include "perl.h" #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +#ifndef HAS_SEM #include +#endif #ifdef HAS_MSG #include #endif -#ifdef HAS_SEM -#include -#endif #ifdef HAS_SHM #include # ifndef HAS_SHMAT_PROTOTYPE @@ -359,8 +358,12 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe PerlIO_clearerr(fp); } #if defined(HAS_FCNTL) && defined(F_SETFD) - fd = PerlIO_fileno(fp); - fcntl(fd,F_SETFD,fd > PL_maxsysfd); + { + int save_errno = errno; + fd = PerlIO_fileno(fp); + fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + errno = save_errno; + } #endif IoIFP(io) = fp; if (writing) { @@ -545,7 +548,7 @@ nextargv(register GV *gv) } else PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n", - SvPV(sv, PL_na), Strerror(errno)); + SvPV(sv, oldlen), Strerror(errno)); } if (PL_inplace) { (void)do_close(PL_argvoutgv,FALSE); @@ -759,7 +762,7 @@ do_binmode(PerlIO *fp, int iotype, int flag) if (flag != TRUE) croak("panic: unsetting binmode"); /* Not implemented yet */ #ifdef DOSISH -#ifdef atarist +#if defined(atarist) || defined(__MINT__) if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) return 1; else @@ -920,6 +923,7 @@ my_stat(ARGSproto) else { SV* sv = POPs; char *s; + STRLEN n_a; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; @@ -930,7 +934,7 @@ my_stat(ARGSproto) goto do_fstat; } - s = SvPV(sv, PL_na); + s = SvPV(sv, n_a); PL_statgv = Nullgv; sv_setpv(PL_statname, s); PL_laststype = OP_STAT; @@ -946,6 +950,7 @@ my_lstat(ARGSproto) { djSP; SV *sv; + STRLEN n_a; if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); if (cGVOP->op_gv == PL_defgv) { @@ -960,13 +965,13 @@ my_lstat(ARGSproto) PL_statgv = Nullgv; sv = POPs; PUTBACK; - sv_setpv(PL_statname,SvPV(sv, PL_na)); + sv_setpv(PL_statname,SvPV(sv, n_a)); #ifdef HAS_LSTAT - PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache); + PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache); #else - PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache); + PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache); #endif - if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, PL_na), '\n')) + if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, n_a), '\n')) warn(warn_nl, "lstat"); return PL_laststatval; } @@ -976,6 +981,7 @@ do_aexec(SV *really, register SV **mark, register SV **sp) { register char **a; char *tmps; + STRLEN n_a; if (sp > mark) { dTHR; @@ -983,14 +989,14 @@ do_aexec(SV *really, register SV **mark, register SV **sp) a = PL_Argv; while (++mark <= sp) { if (*mark) - *a++ = SvPVx(*mark, PL_na); + *a++ = SvPVx(*mark, n_a); else *a++ = ""; } *a = Nullch; if (*PL_Argv[0] != '/') /* will execvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ - if (really && *(tmps = SvPV(really, PL_na))) + if (really && *(tmps = SvPV(really, n_a))) PerlProc_execvp(tmps,PL_Argv); else PerlProc_execvp(PL_Argv[0],PL_Argv); @@ -1116,10 +1122,11 @@ apply(I32 type, register SV **mark, register SV **sp) char *what; char *s; SV **oldmark = mark; + STRLEN n_a; #define APPLY_TAINT_PROPER() \ STMT_START { \ - if (PL_tainting && PL_tainted) { goto taint_proper_label; } \ + if (PL_tainted) { TAINT_PROPER(what); } \ } STMT_END /* This is a first heuristic; it doesn't catch tainting magic. */ @@ -1141,7 +1148,7 @@ apply(I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, PL_na); + char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_chmod(name, val)) tot--; @@ -1158,7 +1165,7 @@ apply(I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, PL_na); + char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_chown(name, val, val2)) tot--; @@ -1178,7 +1185,7 @@ nothing in the core. APPLY_TAINT_PROPER(); if (mark == sp) break; - s = SvPVx(*++mark, PL_na); + s = SvPVx(*++mark, n_a); if (isUPPER(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; @@ -1248,7 +1255,7 @@ nothing in the core. APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - s = SvPVx(*mark, PL_na); + s = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PL_euid || PL_unsafe) { if (UNLINK(s)) @@ -1277,23 +1284,23 @@ nothing in the core. struct utimbuf utbuf; #else struct { - long actime; - long modtime; + Time_t actime; + Time_t modtime; } utbuf; #endif Zero(&utbuf, sizeof utbuf, char); #ifdef BIG_TIME - utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */ - utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */ + utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */ + utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */ #else - utbuf.actime = SvIVx(*++mark); /* time accessed */ - utbuf.modtime = SvIVx(*++mark); /* time modified */ + utbuf.actime = (Time_t)SvIVx(*++mark); /* time accessed */ + utbuf.modtime = (Time_t)SvIVx(*++mark); /* time modified */ #endif APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, PL_na); + char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_utime(name, &utbuf)) tot--; @@ -1306,10 +1313,6 @@ nothing in the core. } return tot; - taint_proper_label: - TAINT_PROPER(what); - return 0; /* this should never happen */ - #undef APPLY_TAINT_PROPER } diff --git a/contrib/perl5/doop.c b/contrib/perl5/doop.c index e80fa48..85d7b9e 100644 --- a/contrib/perl5/doop.c +++ b/contrib/perl5/doop.c @@ -1,6 +1,6 @@ /* doop.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -352,7 +352,8 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right) len = leftlen < rightlen ? leftlen : rightlen; lensave = len; if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { - dc = SvPV_force(sv, PL_na); + STRLEN n_a; + dc = SvPV_force(sv, n_a); if (SvCUR(sv) < len) { dc = SvGROW(sv, len + 1); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); @@ -491,7 +492,7 @@ do_kv(ARGSproto) RETURN; } - if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P')) + if (! SvTIED_mg((SV*)keys, 'P')) i = HvKEYS(keys); else { i = 0; diff --git a/contrib/perl5/dump.c b/contrib/perl5/dump.c index b1e984b..782c62d 100644 --- a/contrib/perl5/dump.c +++ b/contrib/perl5/dump.c @@ -1,6 +1,6 @@ /* dump.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -239,11 +239,12 @@ dump_op(OP *o) case OP_GVSV: case OP_GV: if (cGVOPo->op_gv) { + STRLEN n_a; SV *tmpsv = NEWSV(0,0); ENTER; SAVEFREESV(tmpsv); gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); - dump("GV = %s\n", SvPV(tmpsv, PL_na)); + dump("GV = %s\n", SvPV(tmpsv, n_a)); LEAVE; } else diff --git a/contrib/perl5/eg/ADB b/contrib/perl5/eg/ADB new file mode 100644 index 0000000..e8130e1 --- /dev/null +++ b/contrib/perl5/eg/ADB @@ -0,0 +1,8 @@ +#!/usr/bin/perl + +# $RCSfile: ADB,v $$Revision: 4.1 $$Date: 92/08/07 17:20:06 $ + +# This script is only useful when used in your crash directory. + +$num = shift; +exec 'adb', '-k', "vmunix.$num", "vmcore.$num"; diff --git a/contrib/perl5/eg/README b/contrib/perl5/eg/README new file mode 100644 index 0000000..15eb655 --- /dev/null +++ b/contrib/perl5/eg/README @@ -0,0 +1,22 @@ +Although supplied with the perl package, the perl scripts in this eg +directory and its subdirectories are placed in the public domain, and +you may do anything with them that you wish. + +This stuff is supplied on an as-is basis--little attempt has been made to make +any of it portable. It's mostly here to give you an idea of what perl code +looks like, and what tricks and idioms are used. + +System administrators responsible for many computers will enjoy the items +down in the g directory very much. The scan directory contains the beginnings +of a system to check on and report various kinds of anomalies. + +If you machine doesn't support #!, the first thing you'll want to do is +replace the #! with a couple of lines that look like this: + + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if $running_under_some_shell; + +being sure to include any flags that were on the #! line. A supplied script +called "nih" will translate perl scripts in place for you: + + nih g/g?? diff --git a/contrib/perl5/eg/cgi/RunMeFirst b/contrib/perl5/eg/cgi/RunMeFirst new file mode 100755 index 0000000..018b11b --- /dev/null +++ b/contrib/perl5/eg/cgi/RunMeFirst @@ -0,0 +1,36 @@ +#!/usr/local/bin/perl + +# Make a world-writeable directory for saving state. +$ww = 'WORLD_WRITABLE'; +unless (-w $ww) { + $u = umask 0; + mkdir $ww, 0777; + umask $u; +} + +# Decode the sample image. +for $uu (<*.uu>) { + unless (open UU, "<$uu") { warn "Can't open $uu: $!\n"; next } + while () { + chomp; + if (/^begin\s+\d+\s+(.+)$/) { + $bin = $1; + last; + } + } + unless (open BIN, "> $bin") { warn "Can't create $bin: $!\n"; next } + binmode BIN; + while () { + chomp; + last if /^end/; + print BIN unpack "u", $_; + } + close BIN; + close UU; +} + +# Create symlinks from *.txt to *.cgi for documentation purposes. +foreach (<*.cgi>) { + ($target = $_) =~ s/cgi$/txt/i; + symlink $_, $target unless -e $target; +} diff --git a/contrib/perl5/eg/cgi/caution.xbm b/contrib/perl5/eg/cgi/caution.xbm new file mode 100644 index 0000000..87fcdbe --- /dev/null +++ b/contrib/perl5/eg/cgi/caution.xbm @@ -0,0 +1,12 @@ +#define caution_width 32 +#define caution_height 32 +static char caution_bits[] = { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x00,0x00,0x00,0x10,0x01, + 0x00,0x00,0x08,0x07,0x00,0x00,0x08,0x0e,0x00,0x00,0x04,0x0e,0x00,0x00,0x04, + 0x1c,0x00,0x00,0x02,0x1c,0x00,0x00,0xe2,0x38,0x00,0x00,0xf1,0x39,0x00,0x00, + 0xf1,0x71,0x00,0x80,0xf0,0x71,0x00,0x80,0xf0,0xe1,0x00,0x40,0xf0,0xe1,0x00, + 0x40,0xf0,0xc1,0x01,0x20,0xf0,0xc1,0x01,0x20,0xf0,0x81,0x03,0x10,0xe0,0x80, + 0x03,0x10,0xe0,0x00,0x07,0x08,0xe0,0x00,0x07,0x08,0xe0,0x00,0x0e,0x04,0x00, + 0x00,0x0e,0x04,0xe0,0x00,0x1c,0x02,0xf0,0x01,0x1c,0x02,0xf0,0x01,0x38,0x01, + 0xe0,0x00,0x38,0x01,0x00,0x00,0x70,0x01,0x00,0x00,0x70,0xff,0xff,0xff,0x7f, + 0xf8,0xff,0xff,0x3f,0x00,0x00,0x00,0x00}; diff --git a/contrib/perl5/eg/cgi/clickable_image.cgi b/contrib/perl5/eg/cgi/clickable_image.cgi new file mode 100644 index 0000000..81daf09 --- /dev/null +++ b/contrib/perl5/eg/cgi/clickable_image.cgi @@ -0,0 +1,26 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +print $query->start_html("A Clickable Image"); +print <A Clickable Image + +END +print "Sorry, this isn't very exciting!\n"; + +print $query->startform; +print $query->image_button('picture',"./wilogo.gif"); +print "Give me a: ",$query->popup_menu('letter',['A','B','C','D','E','W']),"\n"; # +print "

Magnification: ",$query->radio_group('magnification',['1X','2X','4X','20X']),"\n"; +print "


\n"; + +if ($query->param) { + print "

Magnification, ",$query->param('magnification'),"\n"; + print "

Selected Letter, ",$query->param('letter'),"\n"; + ($x,$y) = ($query->param('picture.x'),$query->param('picture.y')); + print "

Selected Position ($x,$y)\n"; +} + +print $query->end_html; diff --git a/contrib/perl5/eg/cgi/cookie.cgi b/contrib/perl5/eg/cgi/cookie.cgi new file mode 100644 index 0000000..98adda1 --- /dev/null +++ b/contrib/perl5/eg/cgi/cookie.cgi @@ -0,0 +1,88 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard); + +@ANIMALS=sort qw/lion tiger bear pig porcupine ferret zebra gnu ostrich + emu moa goat weasel yak chicken sheep hyena dodo lounge-lizard + squirrel rat mouse hedgehog racoon baboon kangaroo hippopotamus + giraffe/; + +# Recover the previous animals from the magic cookie. +# The cookie has been formatted as an associative array +# mapping animal name to the number of animals. +%zoo = cookie('animals'); + +# Recover the new animal(s) from the parameter 'new_animal' +@new = param('new_animals'); + +# If the action is 'add', then add new animals to the zoo. Otherwise +# delete them. +foreach (@new) { + if (param('action') eq 'Add') { + $zoo{$_}++; + } elsif (param('action') eq 'Delete') { + $zoo{$_}-- if $zoo{$_}; + delete $zoo{$_} unless $zoo{$_}; + } +} + +# Add new animals to old, and put them in a cookie +$the_cookie = cookie(-name=>'animals', + -value=>\%zoo, + -expires=>'+1h'); + +# Print the header, incorporating the cookie and the expiration date... +print header(-cookie=>$the_cookie); + +# Now we're ready to create our HTML page. +print start_html('Animal crackers'); + +print <Animal Crackers +Choose the animals you want to add to the zoo, and click "add". +Come back to this page any time within the next hour and the list of +animals in the zoo will be resurrected. You can even quit Netscape +completely! +

+Try adding the same animal several times to the list. Does this +remind you vaguely of a shopping cart? +

+This script only works with Netscape browsers +

+

+ +
Add/DeleteCurrent Contents +EOF + ; + +print "
",start_form; +print scrolling_list(-name=>'new_animals', + -values=>[@ANIMALS], + -multiple=>1, + -override=>1, + -size=>10),"
"; +print submit(-name=>'action',-value=>'Delete'), + submit(-name=>'action',-value=>'Add'); +print end_form; + +print "
"; +if (%zoo) { # make a table + print "
    \n"; + foreach (sort keys %zoo) { + print "
  • $zoo{$_} $_\n"; + } + print "
\n"; +} else { + print "The zoo is empty.\n"; +} +print "
"; + +print < +
Lincoln D. Stein

+More Examples +EOF + ; +print end_html; + + diff --git a/contrib/perl5/eg/cgi/crash.cgi b/contrib/perl5/eg/cgi/crash.cgi new file mode 100644 index 0000000..64f03c7 --- /dev/null +++ b/contrib/perl5/eg/cgi/crash.cgi @@ -0,0 +1,6 @@ +#!/usr/local/bin/perl + +use CGI::Carp qw(fatalsToBrowser); + +# This line invokes a fatal error message at compile time. +foo bar baz; diff --git a/contrib/perl5/eg/cgi/customize.cgi b/contrib/perl5/eg/cgi/customize.cgi new file mode 100644 index 0000000..c1c8187 --- /dev/null +++ b/contrib/perl5/eg/cgi/customize.cgi @@ -0,0 +1,92 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard :html3); + +# Some constants to use in our form. +@colors=qw/aqua black blue fuschia gray green lime maroon navy olive + purple red silver teal white yellow/; +@sizes=("",1..7); + +# recover the "preferences" cookie. +%preferences = cookie('preferences'); + +# If the user wants to change the background color or her +# name, they will appear among our CGI parameters. +foreach ('text','background','name','size') { + $preferences{$_} = param($_) || $preferences{$_}; +} + +# Set some defaults +$preferences{'background'} = $preferences{'background'} || 'silver'; +$preferences{'text'} = $preferences{'text'} || 'black'; + +# Refresh the cookie so that it doesn't expire. This also +# makes any changes the user made permanent. +$the_cookie = cookie(-name=>'preferences', + -value=>\%preferences, + -expires=>'+30d'); +print header(-cookie=>$the_cookie); + +# Adjust the title to incorporate the user's name, if provided. +$title = $preferences{'name'} ? + "Welcome back, $preferences{name}!" : "Customizable Page"; + +# Create the HTML page. We use several of Netscape's +# extended tags to control the background color and the +# font size. It's safe to use Netscape features here because +# cookies don't work anywhere else anyway. +print start_html(-title=>$title, + -bgcolor=>$preferences{'background'}, + -text=>$preferences{'text'} + ); + +print basefont({SIZE=>$preferences{size}}) if $preferences{'size'} > 0; + +print h1($title),<'name', + -default=>$preferences{'name'}, + -size=>30),br, + + table( + TR( + td("Preferred"), + td("Page color:"), + td(popup_menu(-name=>'background', + -values=>\@colors, + -default=>$preferences{'background'}) + ), + ), + TR( + td(''), + td("Text color:"), + td(popup_menu(-name=>'text', + -values=>\@colors, + -default=>$preferences{'text'}) + ) + ), + TR( + td(''), + td("Font size:"), + td(popup_menu(-name=>'size', + -values=>\@sizes, + -default=>$preferences{'size'}) + ) + ) + ), + + submit(-label=>'Set preferences'), + hr; + +print a({HREF=>"/"},'Go to the home page'); +print end_html; diff --git a/contrib/perl5/eg/cgi/diff_upload.cgi b/contrib/perl5/eg/cgi/diff_upload.cgi new file mode 100644 index 0000000..913f9ca --- /dev/null +++ b/contrib/perl5/eg/cgi/diff_upload.cgi @@ -0,0 +1,68 @@ +#!/usr/local/bin/perl + +$DIFF = "/usr/bin/diff"; +$PERL = "/usr/bin/perl"; + +use CGI qw(:standard); +use CGI::Carp; + +print header; +print start_html("File Diff Example"); +print "Version $CGI::VERSION

"; + +print <File Diff Example +Enter two files. When you press "submit" their diff will be +produced. +EOF + ; + +# Start a multipart form. +print start_multipart_form; +print "File #1:",filefield(-name=>'file1',-size=>45),"
\n"; +print "File #2:",filefield(-name=>'file2',-size=>45),"
\n"; +print "Diff type: ",radio_group(-name=>'type', + -value=>['context','normal']),"
\n"; +print reset,submit(-name=>'submit',-value=>'Do Diff'); +print endform; + +# Process the form if there is a file name entered +$file1 = param('file1'); +$file2 = param('file2'); + +$|=1; # for buffering +if ($file1 && $file2) { + $realfile1 = tmpFileName($file1); + $realfile2 = tmpFileName($file2); + print "


\n"; + print "

$file1 vs $file2

\n"; + + print "
\n";
+    $options = "-c" if param('type') eq 'context';
+    system "$DIFF $options $realfile1 $realfile2 | $PERL -pe 's/>/>/g; s/\n";
+}
+
+print <
+CGI documentation
+
+
+Lincoln D. Stein +

+Last modified 17 July 1996 +EOF + ; +print end_html; + +sub sanitize { + my $name = shift; + my($safe) = $name=~/([a-zA-Z0-9._~#,]+)/; + unless ($safe) { + print "$name is not a valid Unix filename -- sorry"; + exit 0; + } + return $safe; +} diff --git a/contrib/perl5/eg/cgi/dna.small.gif.uu b/contrib/perl5/eg/cgi/dna.small.gif.uu new file mode 100644 index 0000000..d3ce24c --- /dev/null +++ b/contrib/perl5/eg/cgi/dna.small.gif.uu @@ -0,0 +1,63 @@ +begin 444 dna.small.gif +M1TE&.#=A)0`J`.<``+9%&Y@_&A$_5`Y#3$=2"=#59M((H88,GP\/]X^&+$R +M$"(79"DF33(93"$86=%;&"T4/=Y"&\\A$Q4Z4!`62*T4-Q4B9+X1*BH96SP? +M1<0D/3(F<-TM$!`=5:H.(!<64C$W?#8J3*`S(S<@3=8V%K$](QT.6Q`43AL4 +M1:$D,;<0,\X9&,8])\@=$A(U244S5U,D6Q=/#YH> +M08$I1B,09S$35R(:4C0?<19$75!()-;4702M`=;56)A`25,0K%"X< +M83`N>K`H'HDS*1`40,M&%!<@7M,_$AE+#%0>0S0/:4PJ9I,F-6DG420Y<"@09R,0 +M-V$R/R4M<:\H0!(H410Z:AT27&4Q9"L@;=1%(MA-$M5+#RL4+M8Z&AT<7[<: +M(-QA&2,36R$++B(84!0:5ALO:K$A.]X?&!$84V@;/SX<6Q`;2$(B2QD21W4J +M1=TW&@```````````````"P`````)0`J```(_@!]:(N'18\W%15T$1N'C)V? +M0_HH,<$G9YBX!C6<3;+T@AZ-)K@\O*"!KP^$>"KVA`L3*8P3)^5ZA)@B:AH+ +M9];F7.$Q+!`!0=*.%",&P7J"9XB82L5,48F5K,:" +M'94FU='6;!*R3T->E"%&95DR"`/6P,I0PDF)0SG8($$RJN0R`FI(H7$A2]VD +M*^^L_6(T3U*V%XH"_AB:HDS8H$AO5@R:P,8.I%^.:*AC(>Z!'":6RC`1L@W- +M%1Q/,%(.'5+1``/"*]=90`PD.F'3SR@-AG)`&_A=3'"**#[J(P<0^C0&S/#1""(ZI)'&*6,,$842N%Q!@3NK +M"R'%%4KP0D(Q?"`S!3)BVE(/$+)#-80 +M<+,`-[QH$LP+0_P!1C>=S("!,N>8XP<8H6131!B;3`#&#)"DTH(L5#P0S#W+ +MQ)*`$K1HHD4^;E!2QP%:B``&4H$,/Y2C$Y*(1%0(00A)@```77B"*$0@#3>P +MP&PU4`,^H!","P!!$')0P^H6((I5L"$'.;``';[Q!@-\PP"$0?)M$`<92!%OG8Q3#@(`U2C*)%9-!`&`K`!!EP0@80 +M2,0M;I$.:"C#"D.@P#UJ``]GT"*,K%B&*0+!@TFH8VV*0$(:_/`)?7@#'.'0 +M@R[H8``\:&`,=NC"*"B@!2TTHP5]N((TEH&`<)B"!PU`0RQ(P8MNS``9K6@% +M'W31AG%$(BZ2&((PA-&#'I"A&`F8!DD\\`H6-,.,X'B'%,+R#FX4`PS&_L!$ +M.4R0#7W<0@%O2,07$($#9@C3"%C8P!5H88\]J$,"-E!;(.X@C5T<`!65V,40 +M,'&(0C!"`1JP@"3TH`T9=&,5JRC$-]+1`U%TP@@[^,$>Z$&*0%1A%XFK`BFD +MX0L6Y"(#A_A$#[JPC@%\@1@02`(SJ#&&.`A@'\&$!AALX(4Y="`/TA"",UA! +M@%W<8!*\$`$@C%""+G1A"9AP!"<>9@ME*)$0F\C!$I8`B3\TP@%'@$(QH$`" +M)8@#'(B0ACB`P`,@%&,'9"##)S`1!&)\`0)^&,,^+$`("QC"#D\X!":HX0!< +ML(`&-O!%,&H@BS#F0AI'`!LO^"`,/OS!%KJ0_H0HEA`E27Q#%T%X0"%"@`1E +M2,`!:F!%+Q#A!G)40A!HP`4OFK`#-13#`?I(QCW38(Q/9&``%0#!);01BE>$ +M@!TZNL81$G`!-]2!&&5@A1N&T0Q<,$$$%*!``BR1A5$PPPH<74$%]*`#$.RA +M`(VP@#`X$(`7``(%T=@`.5Q`C@:0`P[)D$4'$H`."MB#"908Q=X@,01B9$(7 +MG'A%`#8!"QSL@PUAL,0==M"")CQCP4)0QQUDP806H&,!T]A!`EH@AC2P`P,^ +MT`,*NN%-&&T!&L@X!!Y^<(4.D(,%E>A`,T20C#IXL`6-:,`5F+"#!W"@'%OH +MA`IJ$5(#;`(;AV/'FA103(EV+(,>GHB&&ZJ`!D'P!57`X1F9D`4<0!]FB({'Content-Type'} || ''; + print hr(), + h2($file), + h3($tmpfile), + h4("MIME Type:",em($mimetype)); + + my($lines,$words,$characters,@words) = (0,0,0,0); + while (<$file>) { + $lines++; + $words += @words=split(/\s+/); + $characters += length($_); + } + close $file; + grep($stats{$_}++,param('count')); + if (%stats) { + print strong("Lines: "),$lines,br if $stats{'count lines'}; + print strong("Words: "),$words,br if $stats{'count words'}; + print strong("Characters: "),$characters,br if $stats{'count characters'}; + } else { + print strong("No statistics selected."); + } +} + +# print cite("URL parameters: "),url_param(); + +print hr(), + a({href=>"../cgi_docs.html"},"CGI documentation"), + hr, + address( + a({href=>'/~lstein'},"Lincoln D. Stein")), + br, + 'Last modified July 17, 1996', + end_html; + diff --git a/contrib/perl5/eg/cgi/frameset.cgi b/contrib/perl5/eg/cgi/frameset.cgi new file mode 100644 index 0000000..fc86e92 --- /dev/null +++ b/contrib/perl5/eg/cgi/frameset.cgi @@ -0,0 +1,81 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +$TITLE="Frameset Example"; + +# We use the path information to distinguish between calls +# to the script to: +# (1) create the frameset +# (2) create the query form +# (3) create the query response + +$path_info = $query->path_info; + +# If no path information is provided, then we create +# a side-by-side frame set +if (!$path_info) { + &print_frameset; + exit 0; +} + +# If we get here, then we either create the query form +# or we create the response. +&print_html_header; +&print_query if $path_info=~/query/; +&print_response if $path_info=~/response/; +&print_end; + + +# Create the frameset +sub print_frameset { + $script_name = $query->script_name; + print <$TITLE + + + + +EOF + ; + exit 0; +} + +sub print_html_header { + print $query->start_html($TITLE); +} + +sub print_end { + print qq{


More Examples}; + print $query->end_html; +} + +sub print_query { + $script_name = $query->script_name; + print "

Frameset Query

\n"; + print $query->startform(-action=>"$script_name/response",-TARGET=>"response"); + print "What's your name? ",$query->textfield('name'); + print "

What's the combination?

", + $query->checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe']); + + print "

What's your favorite color? ", + $query->popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + "

"; + print $query->submit; + print $query->endform; +} + +sub print_response { + print "

Frameset Result

\n"; + unless ($query->param) { + print "No query submitted yet."; + return; + } + print "Your name is ",$query->param(name),"\n"; + print "

The keywords are: ",join(", ",$query->param(words)),"\n"; + print "

Your favorite color is ",$query->param(color),"\n"; +} + diff --git a/contrib/perl5/eg/cgi/index.html b/contrib/perl5/eg/cgi/index.html new file mode 100644 index 0000000..75e2d30 --- /dev/null +++ b/contrib/perl5/eg/cgi/index.html @@ -0,0 +1,118 @@ + +More Examples of Scripts Created with CGI.pm + + + +

More Examples of Scripts Created with CGI.pm

+ +

Basic Non Sequitur Questionnaire

+ + +

Advanced Non Sequitur Questionnaire

+ + +

Save and restore the state of a form to a file

+ + +

Server Push

+ + +

Read the coordinates from a clickable image map

+ + +

Multiple independent forms on the same page

+ + +

How to maintain state on a page with internal links

+ + +

Echo fatal script errors to the browser

+This script deliberately generates a compile-time error. + + +The Following Scripts only Work with Netscape 2.0 & Internet Explorer only! + +

Prompt for a file to upload and process it

+ + +

A Continuously-Updated Page using Server Push

+ + +

Compute the "diff" between two uploaded files

+ + +

Maintain state over a long period with a cookie

+ + +

Permanently customize the appearance of a page with a cookie

+ + +

Popup the response in a new window

+ + +

Side-by-side form and response using frames

+ + +

Verify the Contents of a fill-out form with JavaScript

+ + +
+ +
  • CGI.pm documentation +
  • Download the CGI.pm distribution +
  • +
    +
    Lincoln D. Stein, lstein@genome.wi.mit.edu
    +Whitehead Institute/MIT Center for Genome Research
    + +Last modified: Tue May 19 22:16:43 EDT 1998 + + diff --git a/contrib/perl5/eg/cgi/internal_links.cgi b/contrib/perl5/eg/cgi/internal_links.cgi new file mode 100644 index 0000000..4806966 --- /dev/null +++ b/contrib/perl5/eg/cgi/internal_links.cgi @@ -0,0 +1,33 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; + +# We generate a regular HTML file containing a very long list +# and a popup menu that does nothing except to show that we +# don't lose the state information. +print $query->header; +print $query->start_html("Internal Links Example"); +print "

    Internal Links Example

    \n"; +print "Click Submit Query to create a state. Then scroll down and", + " click on any of the Jump to top links. This is not very exciting."; + +print "\n"; # an anchor point at the top + +# pick a default starting value; +$query->param('amenu','FOO1') unless $query->param('amenu'); + +print $query->startform; +print $query->popup_menu('amenu',[('FOO1'..'FOO9')]); +print $query->submit,$query->endform; + +# We create a long boring list for the purposes of illustration. +$myself = $query->self_url; +print "
      \n"; +for (1..100) { + print qq{
    1. List item #$_ Jump to top\n}; +} +print "
    \n"; + +print $query->end_html; + diff --git a/contrib/perl5/eg/cgi/javascript.cgi b/contrib/perl5/eg/cgi/javascript.cgi new file mode 100644 index 0000000..91c2b9e --- /dev/null +++ b/contrib/perl5/eg/cgi/javascript.cgi @@ -0,0 +1,105 @@ +#!/usr/local/bin/perl + +# This script illustrates how to use JavaScript to validate fill-out +# forms. +use CGI qw(:standard); + +# Here's the javascript code that we include in the document. +$JSCRIPT=< 20) || (years < 5)) { + alert("You must be between the ages of 5 and 20 to submit this form"); + document.form1.birthdate.focus(); + document.form1.birthdate.select(); + return false; + } + // Since we've calculated the age in years already, + // we might as well send it up to our CGI script. + document.form1.age.value=Math.floor(years); + return true; + } + + // make sure that the contents of the supplied + // field contain a valid date. + function validateDate(element) { + var date = Date.parse(element.value); + if (0 == date) { + alert("Please enter date in format MMM DD, YY"); + element.focus(); + element.select(); + } + return date; + } + + // Compliments, compliments + function doPraise(element) { + if (element.checked) { + self.status=element.value + " is an excellent choice!"; + return true; + } else { + return false; + } + } + + function checkColor(element) { + var color = element.options[element.selectedIndex].text; + if (color == "blonde") { + if (confirm("Is it true that blondes have more fun?")) + alert("Darn. That leaves me out."); + } else + alert(color + " is a fine choice!"); + } +EOF + ; + +# here's where the execution begins +print header; +print start_html(-title=>'Personal Profile',-script=>$JSCRIPT); + +print h1("Big Brother Wants to Know All About You"), + strong("Note: "),"This page uses JavaScript and requires ", + "Netscape 2.0 or higher to do anything special."; + +&print_prompt(); +print hr; +&print_response() if param; +print end_html; + +sub print_prompt { + print start_form(-name=>'form1', + -onSubmit=>"return validateForm()"),"\n"; + print "Birthdate (e.g. Jan 3, 1972): ", + textfield(-name=>'birthdate', + -onBlur=>"validateDate(this)"),"

    \n"; + print "Sex: ",radio_group(-name=>'gender', + -value=>[qw/male female/], + -onClick=>"doPraise(this)"),"

    \n"; + print "Hair color: ",popup_menu(-name=>'color', + -value=>[qw/brunette blonde red gray/], + -default=>'red', + -onChange=>"checkColor(this)"),"

    \n"; + print hidden(-name=>'age',-value=>0); + print submit(); + print end_form; +} + +sub print_response { + import_names('Q'); + print h2("Your profile"), + "You claim to be a ",b($Q::age)," year old ",b($Q::color,$Q::gender),".", + "You should be ashamed of yourself for lying so ", + "blatantly to big brother!", + hr; +} + diff --git a/contrib/perl5/eg/cgi/monty.cgi b/contrib/perl5/eg/cgi/monty.cgi new file mode 100644 index 0000000..693c258 --- /dev/null +++ b/contrib/perl5/eg/cgi/monty.cgi @@ -0,0 +1,84 @@ +#!/usr/local/bin/perl + +use CGI; +use CGI::Carp qw/fatalsToBrowser/; + +$query = new CGI; + +print $query->header; +print $query->start_html("Example CGI.pm Form"); +print "

    Example CGI.pm Form

    \n"; +&print_prompt($query); +&do_work($query); +&print_tail; +print $query->end_html; + +sub print_prompt { + my($query) = @_; + + print $query->start_form; + print "What's your name?
    "; + print $query->textfield('name'); + print $query->checkbox('Not my real name'); + + print "

    Where can you find English Sparrows?
    "; + print $query->checkbox_group( + -name=>'Sparrow locations', + -Values=>[England,France,Spain,Asia,Hoboken], + -linebreak=>'yes', + -defaults=>[England,Asia]); + + print "

    How far can they fly?
    ", + $query->radio_group( + -name=>'how far', + -Values=>['10 ft','1 mile','10 miles','real far'], + -default=>'1 mile'); + + print "

    What's your favorite color? "; + print $query->popup_menu(-name=>'Color', + -Values=>['black','brown','red','yellow'], + -default=>'red'); + + print $query->hidden('Reference','Monty Python and the Holy Grail'); + + print "

    What have you got there?
    "; + print $query->scrolling_list( + -name=>'possessions', + -Values=>['A Coconut','A Grail','An Icon', + 'A Sword','A Ticket'], + -size=>5, + -multiple=>'true'); + + print "

    Any parting comments?
    "; + print $query->textarea(-name=>'Comments', + -rows=>10, + -columns=>50); + + print "

    ",$query->reset; + print $query->submit('Action','Shout'); + print $query->submit('Action','Scream'); + print $query->endform; + print "


    \n"; + } + +sub do_work { + my($query) = @_; + my(@values,$key); + + print "

    Here are the current settings in this form

    "; + + foreach $key ($query->param) { + print "$key -> "; + @values = $query->param($key); + print join(", ",@values),"
    \n"; + } +} + +sub print_tail { + print < +
    Lincoln D. Stein

    +Home Page +END + ; +} diff --git a/contrib/perl5/eg/cgi/multiple_forms.cgi b/contrib/perl5/eg/cgi/multiple_forms.cgi new file mode 100644 index 0000000..b38bf93 --- /dev/null +++ b/contrib/perl5/eg/cgi/multiple_forms.cgi @@ -0,0 +1,54 @@ +#!/usr/local/bin/perl + +use CGI; + +$query = new CGI; +print $query->header; +print $query->start_html('Multiple Forms'); +print "

    Multiple Forms

    \n"; + +# Print the first form +print $query->startform; +$name = $query->remote_user || 'anonymous@' . $query->remote_host; + +print "What's your name? ",$query->textfield('name',$name,50); +print "

    What's the combination?

    ", + $query->checkbox_group('words',['eenie','meenie','minie','moe']); +print "

    What's your favorite color? ", + $query->popup_menu('color',['red','green','blue','chartreuse']), + "

    "; +print $query->submit('form_1','Send Form 1'); +print $query->endform; + +# Print the second form +print "


    \n"; +print $query->startform; +print "Some radio buttons: ",$query->radio_group('radio buttons', + [qw{one two three four five}],'three'),"\n"; +print "

    What's the password? ",$query->password_field('pass','secret'); +print $query->defaults,$query->submit('form_2','Send Form 2'),"\n"; +print $query->endform; + +print "


    \n"; + +$query->import_names('Q'); +if ($Q::form_1) { + print "

    Form 1 Submitted

    \n"; + print "Your name is $Q::name\n"; + print "

    The combination is: {",join(",",@Q::words),"}\n"; + print "

    Your favorite color is $Q::color\n"; +} elsif ($Q::form_2) { + print <Form 2 Submitted +

    The value of the radio buttons is $Q::radio_buttons +

    The secret password is $Q::pass +EOF + ; +} +print qq{

    Other examples}; +print qq{

    Go to the documentation}; + +print $query->end_html; + + + diff --git a/contrib/perl5/eg/cgi/nph-clock.cgi b/contrib/perl5/eg/cgi/nph-clock.cgi new file mode 100644 index 0000000..55a2fbe --- /dev/null +++ b/contrib/perl5/eg/cgi/nph-clock.cgi @@ -0,0 +1,18 @@ +#!/usr/local/bin/perl -w + +use CGI::Push qw(:standard :html3); + +do_push(-next_page=>\&draw_time,-delay=>1); + +sub draw_time { + my $time = `/bin/date`; + return start_html('Tick Tock'), + div({-align=>CENTER}, + h1('Virtual Clock'), + h2($time) + ), + hr, + a({-href=>'index.html'},'More examples'), + end_html(); +} + diff --git a/contrib/perl5/eg/cgi/nph-multipart.cgi b/contrib/perl5/eg/cgi/nph-multipart.cgi new file mode 100755 index 0000000..f8cea59 --- /dev/null +++ b/contrib/perl5/eg/cgi/nph-multipart.cgi @@ -0,0 +1,10 @@ +#!/usr/local/bin/perl +use CGI qw/:push -nph/; +$| = 1; +print multipart_init(-boundary=>'----------------here we go!'); +while (1) { + print multipart_start(-type=>'text/plain'), + "The current time is ",scalar(localtime),"\n", + multipart_end; + sleep 1; +} diff --git a/contrib/perl5/eg/cgi/popup.cgi b/contrib/perl5/eg/cgi/popup.cgi new file mode 100644 index 0000000..88cea1d --- /dev/null +++ b/contrib/perl5/eg/cgi/popup.cgi @@ -0,0 +1,32 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +print $query->start_html('Popup Window'); + + +if (!$query->param) { + print "

    Ask your Question

    \n"; + print $query->startform(-target=>'_new'); + print "What's your name? ",$query->textfield('name'); + print "

    What's the combination?

    ", + $query->checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','moe']); + + print "

    What's your favorite color? ", + $query->popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + "

    "; + print $query->submit; + print $query->endform; + +} else { + print "

    And the Answer is...

    \n"; + print "Your name is ",$query->param(name),"\n"; + print "

    The keywords are: ",join(", ",$query->param(words)),"\n"; + print "

    Your favorite color is ",$query->param(color),"\n"; +} +print qq{

    Go to the documentation}; +print $query->end_html; diff --git a/contrib/perl5/eg/cgi/save_state.cgi b/contrib/perl5/eg/cgi/save_state.cgi new file mode 100644 index 0000000..85bacaf --- /dev/null +++ b/contrib/perl5/eg/cgi/save_state.cgi @@ -0,0 +1,67 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; + +print $query->header; +print $query->start_html("Save and Restore Example"); +print "

    Save and Restore Example

    \n"; + +# Here's where we take action on the previous request +&save_parameters($query) if $query->param('action') eq 'SAVE'; +$query = &restore_parameters($query) if $query->param('action') eq 'RESTORE'; + +# Here's where we create the form +print $query->start_multipart_form; +print "Popup 1: ",$query->popup_menu('popup1',[qw{red green purple magenta orange chartreuse brown}]),"\n"; +print "Popup 2: ",$query->popup_menu('popup2',[qw{lion tiger bear zebra potto wildebeest frog emu gazelle}]),"\n"; +print "

    "; +$default_name = $query->remote_addr . '.sav'; +print "Save/restore state from file: ",$query->textfield('savefile',$default_name),"\n"; +print "

    "; +print $query->submit('action','SAVE'),$query->submit('action','RESTORE'); +print "

    ",$query->defaults; +print $query->endform; + +# Here we print out a bit at the end +print $query->end_html; + +sub save_parameters { + local($query) = @_; + local($filename) = &clean_name($query->param('savefile')); + if (open(FILE,">$filename")) { + $query->save(FILE); + close FILE; + print "State has been saved to file $filename\n"; + print "

    If you remember this name you can restore the state later.\n"; + } else { + print "Error: couldn't write to file $filename: $!\n"; + } +} + +sub restore_parameters { + local($query) = @_; + local($filename) = &clean_name($query->param('savefile')); + if (open(FILE,$filename)) { + $query = new CGI(FILE); # Throw out the old query, replace it with a new one + close FILE; + print "State has been restored from file $filename\n"; + } else { + print "Error: couldn't restore file $filename: $!\n"; + } + return $query; +} + + +# Very important subroutine -- get rid of all the naughty +# metacharacters from the file name. If there are, we +# complain bitterly and die. +sub clean_name { + local($name) = @_; + unless ($name=~/^[\w\._\-]+$/) { + print "$name has naughty characters. Only "; + print "alphanumerics are allowed. You can't use absolute names."; + die "Attempt to use naughty characters"; + } + return "WORLD_WRITABLE/$name"; +} diff --git a/contrib/perl5/eg/cgi/tryit.cgi b/contrib/perl5/eg/cgi/tryit.cgi new file mode 100644 index 0000000..83c620c --- /dev/null +++ b/contrib/perl5/eg/cgi/tryit.cgi @@ -0,0 +1,37 @@ +#!/usr/local/bin/perl + +use CGI ':standard'; + +print header; +print start_html('A Simple Example'), + h1('A Simple Example'), + start_form, + "What's your name? ",textfield('name'), + p, + "What's the combination?", + p, + checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','minie']), + p, + "What's your favorite color? ", + popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + p, + submit, + end_form, + hr; + +if (param()) { + print + "Your name is: ",em(param('name')), + p, + "The keywords are: ",em(join(", ",param('words'))), + p, + "Your favorite color is: ",em(param('color')), + hr; +} +print a({href=>'../cgi_docs.html'},'Go to the documentation'); +print end_html; + + diff --git a/contrib/perl5/eg/cgi/wilogo.gif.uu b/contrib/perl5/eg/cgi/wilogo.gif.uu new file mode 100644 index 0000000..c5d1042 --- /dev/null +++ b/contrib/perl5/eg/cgi/wilogo.gif.uu @@ -0,0 +1,13 @@ +begin 444 wilogo.gif +M1TE&.#=A7@!$`(```'X2F?___RP`````7@!$```"_D2.J<#MKF)ZU,A3,[OO +M(IUY']A%9"6AW$F)+#2]Y:BNLF6_\;WMHF*(A55\BX%UEI^;OJ8N%(*Z^4G +M.OJJ>8HZ.(>;JRMD>X" +M%A1XSM]!A?T8/C0T$1XMJG\B&G+,"-&C/(VS0(842;`)M'S>_OE8F#"=2S#* +M8LHLAS'D1Y,42UGY9O,F-T:X@@JEE@D1RW>/D@8R.DZ-+*E0CQ:9JJ5JU!SQ +MR&BU2D.;E*4'ER0TNY%G2A/Y.G[=VG%81+5K_UG$21-GQW55;$8L\RW6J8-9>QM7<^A/SMZK!ESY$,+ +(KPA.EJ```#L` +end diff --git a/contrib/perl5/eg/changes b/contrib/perl5/eg/changes new file mode 100644 index 0000000..901e1ed --- /dev/null +++ b/contrib/perl5/eg/changes @@ -0,0 +1,34 @@ +#!/usr/bin/perl -P + +# $RCSfile: changes,v $$Revision: 4.1 $$Date: 92/08/07 17:20:08 $ + +($dir, $days) = @ARGV; +$dir = '/' if $dir eq ''; +$days = '14' if $days eq ''; + +# Masscomps do things differently from Suns + +#if defined(mc300) || defined(mc500) || defined(mc700) +open(Find, "find $dir -mtime -$days -print |") || + die "changes: can't run find"; +#else +open(Find, "find $dir \\( -fstype nfs -prune \\) -o -mtime -$days -ls |") || + die "changes: can't run find"; +#endif + +while () { + +#if defined(mc300) || defined(mc500) || defined(mc700) + $x = `/bin/ls -ild $_`; + $_ = $x; + ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name) + = split(' '); +#else + ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name) + = split(' '); +#endif + + printf("%10s%3s %-8s %-8s%9s %3s %2s %s\n", + $perm,$links,$owner,$group,$size,$month,$day,$name); +} + diff --git a/contrib/perl5/eg/client b/contrib/perl5/eg/client new file mode 100755 index 0000000..5900c90 --- /dev/null +++ b/contrib/perl5/eg/client @@ -0,0 +1,34 @@ +#!./perl + +$pat = 'S n C4 x8'; +$inet = 2; +$echo = 7; +$smtp = 25; +$nntp = 119; +$test = 2345; + +$SIG{'INT'} = 'dokill'; + +$this = pack($pat,$inet,0, 128,149,13,43); +$that = pack($pat,$inet,$test,127,0,0,1); + +if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; } +if (bind(S,$this)) { print "bind ok\n"; } else { die $!; } +if (connect(S,$that)) { print "connect ok\n"; } else { die $!; } + +select(S); $| = 1; select(stdout); + +if ($child = fork) { + while () { + print S; + } + sleep 3; + do dokill(); +} +else { + while () { + print; + } +} + +sub dokill { kill 9,$child if $child; } diff --git a/contrib/perl5/eg/down b/contrib/perl5/eg/down new file mode 100755 index 0000000..bbb0d06 --- /dev/null +++ b/contrib/perl5/eg/down @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +$| = 1; +if ($#ARGV >= 0) { + $cmd = join(' ',@ARGV); +} +else { + print "Command: "; + $cmd = ; + chop($cmd); + while ($cmd =~ s/\\$//) { + print "+ "; + $cmd .= ; + chop($cmd); + } +} +$cwd = `pwd`; chop($cwd); + +open(FIND,'find . -type d -print|') || die "Can't run find"; + +while () { + chop; + unless (chdir $_) { + print stderr "Can't cd to $_\n"; + next; + } + print "\t--> ",$_,"\n"; + system $cmd; + chdir $cwd; +} diff --git a/contrib/perl5/eg/dus b/contrib/perl5/eg/dus new file mode 100644 index 0000000..3025e2b --- /dev/null +++ b/contrib/perl5/eg/dus @@ -0,0 +1,22 @@ +#!/usr/bin/perl + +# $RCSfile: dus,v $$Revision: 4.1 $$Date: 92/08/07 17:20:11 $ + +# This script does a du -s on any directories in the current directory that +# are not mount points for another filesystem. + +($mydev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat('.'); + +open(ls,'ls -F1|'); + +while () { + chop; + next unless s|/$||; + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($_); + next unless $dev == $mydev; + push(@ary,$_); +} + +exec 'du', '-s', @ary; diff --git a/contrib/perl5/eg/findcp b/contrib/perl5/eg/findcp new file mode 100644 index 0000000..5dba040 --- /dev/null +++ b/contrib/perl5/eg/findcp @@ -0,0 +1,53 @@ +#!/usr/bin/perl + +# $RCSfile: findcp,v $$Revision: 4.1 $$Date: 92/08/07 17:20:12 $ + +# This is a wrapper around the find command that pretends find has a switch +# of the form -cp host:destination. It presumes your find implements -ls. +# It uses tar to do the actual copy. If your tar knows about the I switch +# you may prefer to use findtar, since this one has to do the tar in batches. + +sub copy { + `tar cf - $list | rsh $desthost cd $destdir '&&' tar xBpf -`; +} + +$sourcedir = $ARGV[0]; +if ($sourcedir =~ /^\//) { + $ARGV[0] = '.'; + unless (chdir($sourcedir)) { die "Can't find directory $sourcedir: $!"; } +} + +$args = join(' ',@ARGV); +if ($args =~ s/-cp *([^ ]+)/-ls/) { + $dest = $1; + if ($dest =~ /(.*):(.*)/) { + $desthost = $1; + $destdir = $2; + } + else { + die "Malformed destination--should be host:directory"; + } +} +else { + die("No destination specified"); +} + +open(find,"find $args |") || die "Can't run find for you: $!"; + +while () { + @x = split(' '); + if ($x[2] =~ /^d/) { next;} + chop($filename = $x[10]); + if (length($list) > 5000) { + do copy(); + $list = ''; + } + else { + $list .= ' '; + } + $list .= $filename; +} + +if ($list) { + do copy(); +} diff --git a/contrib/perl5/eg/findtar b/contrib/perl5/eg/findtar new file mode 100644 index 0000000..6462f66 --- /dev/null +++ b/contrib/perl5/eg/findtar @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +# $RCSfile: findtar,v $$Revision: 4.1 $$Date: 92/08/07 17:20:13 $ + +# findtar takes find-style arguments and spits out a tarfile on stdout. +# It won't work unless your find supports -ls and your tar the I flag. + +$args = join(' ',@ARGV); +open(find,"/usr/bin/find $args -ls |") || die "Can't run find for you."; + +open(tar,"| /bin/tar cIf - -") || die "Can't run tar for you: $!"; + +while () { + @x = split(' '); + if ($x[2] =~ /^d/) { print tar '-d ';} + print tar $x[10],"\n"; +} diff --git a/contrib/perl5/eg/g/gcp b/contrib/perl5/eg/g/gcp new file mode 100644 index 0000000..d18b6f6 --- /dev/null +++ b/contrib/perl5/eg/g/gcp @@ -0,0 +1,114 @@ +#!/usr/bin/perl + +# $RCSfile: gcp,v $$Revision: 4.1 $$Date: 92/08/07 17:20:15 $ + +# Here is a script to do global rcps. See man page. + +$#ARGV >= 1 || die "Not enough arguments.\n"; + +if ($ARGV[0] eq '-r') { + $rcp = 'rcp -r'; + shift; +} else { + $rcp = 'rcp'; +} +$args = $rcp; +$dest = $ARGV[$#ARGV]; + +$SIG{'QUIT'} = 'CLEANUP'; +$SIG{'INT'} = 'CONT'; + +while ($arg = shift) { + if ($arg =~ /^([-a-zA-Z0-9_+]+):/) { + if ($systype && $systype ne $1) { + die "Can't mix system type specifers ($systype vs $1).\n"; + } + $#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n"; + $systype = $1; + $args .= " $arg"; + } else { + if ($#ARGV >= 0) { + if ($arg =~ /^[\/~]/) { + $arg =~ /^(.*)\// && ($dir = $1); + } else { + if (!$pwd) { + chop($pwd = `pwd`); + } + $dir = $pwd; + } + } + if ($olddir && $dir ne $olddir && $dest =~ /:$/) { + $args .= " $dest$olddir; $rcp"; + } + $olddir = $dir; + $args .= " $arg"; + } +} + +die "No system type specified.\n" unless $systype; + +$args =~ s/:$/:$olddir/; + +chop($thishost = `hostname`); + +$one_of_these = ":$systype:"; +if ($systype =~ s/\+/[+]/g) { + $one_of_these =~ s/\+/:/g; +} +$one_of_these =~ s/-/:-/g; + +@ARGV = (); +push(@ARGV,'.grem') if -f '.grem'; +push(@ARGV,'.ghosts') if -f '.ghosts'; +push(@ARGV,'/etc/ghosts'); + +$remainder = ''; + +line: while (<>) { + s/[ \t]*\n//; + if (!$_ || /^#/) { + next line; + } + if (/^([a-zA-Z_0-9]+)=(.+)/) { + $name = $1; $repl = $2; + $repl =~ s/\+/:/g; + $repl =~ s/-/:-/g; + $one_of_these =~ s/:$name:/:$repl:/; + $repl =~ s/:/:-/g; + $one_of_these =~ s/:-$name:/:-$repl:/g; + next line; + } + @gh = split(' '); + $host = $gh[0]; + next line if $host eq $thishost; # should handle aliases too + $wanted = 0; + foreach $class (@gh) { + $wanted++ if index($one_of_these,":$class:") >= 0; + $wanted = -9999 if index($one_of_these,":-$class:") >= 0; + } + if ($wanted > 0) { + ($cmd = $args) =~ s/[ \t]$systype:/ $host:/g; + print "$cmd\n"; + $result = `$cmd 2>&1`; + $remainder .= "$host+" if + $result =~ /Connection timed out|Permission denied/; + print $result; + } +} + +if ($remainder) { + chop($remainder); + open(grem,">.grem") || (printf stderr "Can't create .grem: $!\n"); + print grem 'rem=', $remainder, "\n"; + close(grem); + print 'rem=', $remainder, "\n"; +} + +sub CLEANUP { + exit; +} + +sub CONT { + print "Continuing...\n"; # Just ignore the signal that kills rcp + $remainder .= "$host+"; +} diff --git a/contrib/perl5/eg/g/gcp.man b/contrib/perl5/eg/g/gcp.man new file mode 100644 index 0000000..1198554 --- /dev/null +++ b/contrib/perl5/eg/g/gcp.man @@ -0,0 +1,77 @@ +.\" $RCSfile: gcp.man,v $$Revision: 4.1 $$Date: 92/08/07 17:20:17 $ +.TH GCP 1C "13 May 1988" +.SH NAME +gcp \- global file copy +.SH SYNOPSIS +.B gcp +file1 file2 +.br +.B gcp +[ +.B \-r +] file ... directory +.SH DESCRIPTION +.I gcp +works just like rcp(1C) except that you may specify a set of hosts to copy files +from or to. +The host sets are defined in the file /etc/ghosts. +(An individual host name can be used as a set containing one member.) +You can give a command like + + gcp /etc/motd sun: + +to copy your /etc/motd file to /etc/motd on all the Suns. +If, on the other hand, you say + + gcp /a/foo /b/bar sun:/tmp + +then your files will be copied to /tmp on all the Suns. +The general rule is that if you don't specify the destination directory, +files go to the same directory they are in currently. +.P +You may specify the union of two or more sets by using + as follows: + + gcp /a/foo /b/bar 750+mc: + +which will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy +/b/bar to /b/bar on all 750's and Masscomps. +.P +Commonly used sets should be defined in /etc/ghosts. +For example, you could add a line that says + + pep=manny+moe+jack + +Another way to do that would be to add the word "pep" after each of the host +entries: + + manny sun3 pep +.br + moe sun3 pep +.br + jack sun3 pep + +Hosts and sets of host can also be excluded: + + foo=sun-sun2 + +Any host so excluded will never be included, even if a subsequent set on the +line includes it: + + foo=abc+def +.br + bar=xyz-abc+foo + +comes out to xyz+def. + +You can define private host sets by creating .ghosts in your current directory +with entries just like /etc/ghosts. +Also, if there is a file .grem, it defines "rem" to be the remaining hosts +from the last gsh or gcp that didn't succeed everywhere. +.PP +Interrupting with a SIGINT will cause the rcp to the current host to be skipped +and execution resumed with the next host. +To stop completely, send a SIGQUIT. +.SH SEE ALSO +rcp(1C) +.SH BUGS +All the bugs of rcp, since it calls rcp. diff --git a/contrib/perl5/eg/g/ged b/contrib/perl5/eg/g/ged new file mode 100644 index 0000000..07ac88f --- /dev/null +++ b/contrib/perl5/eg/g/ged @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +# $RCSfile: ged,v $$Revision: 4.1 $$Date: 92/08/07 17:20:18 $ + +# Does inplace edits on a set of files on a set of machines. +# +# Typical invokation: +# +# ged vax+sun /etc/passwd +# s/Freddy/Freddie/; +# ^D +# + +$class = shift; +$files = join(' ',@ARGV); + +die "Usage: ged class files /tmp/gsh$$`; # get input into a handy place + $dist = " ) { # for each line of ghosts + + s/[ \t]*\n//; # trim trailing whitespace + if (!$_ || /^#/) { # skip blank line or comment + next line; + } + + if (/^(\w+)=(.+)/) { # a macro line? + $name = $1; $repl = $2; + $repl =~ s/\+/:/g; + $repl =~ s/-/:-/g; + $one_of_these =~ s/:$name:/:$repl:/; # do expansion in "wanted" list + $repl =~ s/:/:-/g; + $one_of_these =~ s/:-$name:/:-$repl:/; + next line; + } + + # we have a normal line + + @attr = split(' '); # a list of attributes to match against + # which we put into an array + $host = $attr[0]; # the first attribute is the host name + if ($showhost) { + $showhost = "$host:\t"; + } + + $wanted = 0; + foreach $attr (@attr) { # iterate over attribute array + $wanted++ if index($one_of_these,":$attr:") >= 0; + $wanted = -9999 if index($one_of_these,":-$attr:") >= 0; + } + if ($wanted > 0) { + print "rsh $host$l$n '$cmd'\n" unless $silent; + $SIG{'INT'} = 'DEFAULT'; + if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) { # start an rsh + $SIG{'INT'} = 'cont'; + for ($iter=0; ; $iter++) { + unless ($iter) { + $remainder .= "$host+" + if /Connection timed out|Permission denied/; + } + print $showhost,$_; + } + close(PIPE); + } else { + print "(Can't execute rsh: $!)\n"; + $SIG{'INT'} = 'cont'; + } + } +} + +unlink "/tmp/gsh$$" if $dodist; + +if ($remainder) { + chop($remainder); + open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n"); + print grem 'rem=', $remainder, "\n"; + close(grem); + print 'rem=', $remainder, "\n"; +} + +# here are a couple of subroutines that serve as signal handlers + +sub cont { + print "\rContinuing...\n"; + $remainder .= "$host+"; +} + +sub quit { + $| = 1; + print "\r"; + $SIG{'INT'} = ''; + kill 2, $$; +} diff --git a/contrib/perl5/eg/g/gsh.man b/contrib/perl5/eg/g/gsh.man new file mode 100644 index 0000000..2958707 --- /dev/null +++ b/contrib/perl5/eg/g/gsh.man @@ -0,0 +1,80 @@ +.\" $RCSfile: gsh.man,v $$Revision: 4.1 $$Date: 92/08/07 17:20:22 $ +.TH GSH 8 "13 May 1988" +.SH NAME +gsh \- global shell +.SH SYNOPSIS +.B gsh +[options] +.I host +[options] +.I command +.SH DESCRIPTION +.I gsh +works just like rsh(1C) except that you may specify a set of hosts to execute +the command on. +The host sets are defined in the file /etc/ghosts. +(An individual host name can be used as a set containing one member.) +You can give a command like + + gsh sun /etc/mungmotd + +to run /etc/mungmotd on all your Suns. +.P +You may specify the union of two or more sets by using + as follows: + + gsh 750+mc /etc/mungmotd + +which will run mungmotd on all 750's and Masscomps. +.P +Commonly used sets should be defined in /etc/ghosts. +For example, you could add a line that says + + pep=manny+moe+jack + +Another way to do that would be to add the word "pep" after each of the host +entries: + + manny sun3 pep +.br + moe sun3 pep +.br + jack sun3 pep + +Hosts and sets of host can also be excluded: + + foo=sun-sun2 + +Any host so excluded will never be included, even if a subsequent set on the +line includes it: + + foo=abc+def + bar=xyz-abc+foo + +comes out to xyz+def. + +You can define private host sets by creating .ghosts in your current directory +with entries just like /etc/ghosts. +Also, if there is a file .grem, it defines "rem" to be the remaining hosts +from the last gsh or gcp that didn't succeed everywhere. + +Options include all those defined by rsh, as well as + +.IP "\-d" 8 +Causes gsh to collect input till end of file, and then distribute that input +to each invokation of rsh. +.IP "\-h" 8 +Rather than print out the command followed by the output, merely prepends the +host name to each line of output. +.IP "\-s" 8 +Do work silently. +.PP +Interrupting with a SIGINT will cause the rsh to the current host to be skipped +and execution resumed with the next host. +To stop completely, send a SIGQUIT. +.SH SEE ALSO +rsh(1C) +.SH BUGS +All the bugs of rsh, since it calls rsh. + +Also, will not properly return data from the remote execution that contains +null characters. diff --git a/contrib/perl5/eg/muck b/contrib/perl5/eg/muck new file mode 100644 index 0000000..873539b --- /dev/null +++ b/contrib/perl5/eg/muck @@ -0,0 +1,141 @@ +#!../perl + +$M = '-M'; +$M = '-m' if -d '/usr/uts' && -f '/etc/master'; + +do 'getopt.pl'; +do Getopt('f'); + +if ($opt_f) { + $makefile = $opt_f; +} +elsif (-f 'makefile') { + $makefile = 'makefile'; +} +elsif (-f 'Makefile') { + $makefile = 'Makefile'; +} +else { + die "No makefile\n"; +} + +$MF = 'mf00'; + +while(($key,$val) = each(ENV)) { + $mac{$key} = $val; +} + +do scan($makefile); + +$co = $action{'.c.o'}; +$co = ' ' unless $co; + +$missing = "Missing dependencies:\n"; +foreach $key (sort keys(o)) { + if ($oc{$key}) { + $src = $oc{$key}; + $action = $action{$key}; + } + else { + $action = ''; + } + if (!$action) { + if ($co && ($c = $key) =~ s/\.o$/.c/ && -f $c) { + $src = $c; + $action = $co; + } + else { + print "No source found for $key $c\n"; + next; + } + } + $I = ''; + $D = ''; + $I .= $1 while $action =~ s/(-I\S+\s*)//; + $D .= $1 . ' ' while $action =~ s/(-D\w+)//; + if ($opt_v) { + $cmd = "Checking $key: cc $M $D $I $src"; + $cmd =~ s/\s\s+/ /g; + print stderr $cmd,"\n"; + } + open(CPP,"cc $M $D $I $src|") || die "Can't run C preprocessor: $!"; + while () { + ($name,$dep) = split; + $dep =~ s|^\./||; + (print $missing,"$key: $dep\n"),($missing='') + unless ($dep{"$key: $dep"} += 2) > 2; + } +} + +$extra = "\nExtraneous dependencies:\n"; +foreach $key (sort keys(dep)) { + if ($key =~ /\.o: .*\.h$/ && $dep{$key} == 1) { + print $extra,$key,"\n"; + $extra = ''; + } +} + +sub scan { + local($makefile) = @_; + local($MF) = $MF; + print stderr "Analyzing $makefile.\n" if $opt_v; + $MF++; + open($MF,$makefile) || die "Can't open $makefile: $!"; + while (<$MF>) { + chop; + chop($_ = $_ . <$MF>) while s/\\$//; + next if /^#/; + next if /^$/; + s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg; + s/\$\((\w+)\)/$mac{$1}/eg; + $mac{$1} = $2, next if /^(\w+)\s*=\s*(.*)/; + if (/^include\s+(.*)/) { + do scan($1); + print stderr "Continuing $makefile.\n" if $opt_v; + next; + } + if (/^([^:]+):\s*(.*)/) { + $left = $1; + $right = $2; + if ($right =~ /^([^;]*);(.*)/) { + $right = $1; + $action = $2; + } + else { + $action = ''; + } + while (<$MF>) { + last unless /^\t/; + chop; + chop($_ = $_ . <$MF>) while s/\\$//; + next if /^#/; + last if /^$/; + s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg; + s/\$\((\w+)\)/$mac{$1}/eg; + $action .= $_; + } + foreach $targ (split(' ',$left)) { + $targ =~ s|^\./||; + foreach $src (split(' ',$right)) { + $src =~ s|^\./||; + $deplist{$targ} .= ' ' . $src; + $dep{"$targ: $src"} = 1; + $o{$src} = 1 if $src =~ /\.o$/; + $oc{$targ} = $src if $targ =~ /\.o$/ && $src =~ /\.[yc]$/; + } + $action{$targ} .= $action; + } + redo if $_; + } + } + close($MF); +} + +sub subst { + local($foo,$from,$to) = @_; + $foo = $mac{$foo}; + $from =~ s/\./[.]/; + y/a/a/; + $foo =~ s/\b$from\b/$to/g; + $foo; +} diff --git a/contrib/perl5/eg/muck.man b/contrib/perl5/eg/muck.man new file mode 100644 index 0000000..02ae428 --- /dev/null +++ b/contrib/perl5/eg/muck.man @@ -0,0 +1,21 @@ +.\" $RCSfile: muck.man,v $$Revision: 4.1 $$Date: 92/08/07 17:20:23 $ +.TH MUCK 1 "10 Jan 1989" +.SH NAME +muck \- make usage checker +.SH SYNOPSIS +.B muck +[options] +.SH DESCRIPTION +.I muck +looks at your current makefile and complains if you've left out any dependencies +between .o and .h files. +It also complains about extraneous dependencies. +.PP +You can use the -f FILENAME option to specify an alternate name for your +makefile. +The -v option is a little more verbose about what muck is mucking around +with at the moment. +.SH SEE ALSO +make(1) +.SH BUGS +Only knows about .h, .c and .o files. diff --git a/contrib/perl5/eg/myrup b/contrib/perl5/eg/myrup new file mode 100644 index 0000000..2cbdf75 --- /dev/null +++ b/contrib/perl5/eg/myrup @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +# $RCSfile: myrup,v $$Revision: 4.1 $$Date: 92/08/07 17:20:26 $ + +# This was a customization of ruptime requested by someone here who wanted +# to be able to find the least loaded machine easily. It uses the +# /etc/ghosts file that's defined for gsh and gcp to prune down the +# number of entries to those hosts we have administrative control over. + +print "node load (u)\n------- --------\n"; + +open(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts: $!"; +line: while () { + next line if /^#/; + next line if /^$/; + next line if /=/; + ($host) = split; + $wanted{$host} = 1; +} + +open(ruptime,'ruptime|') || die "Can't run ruptime: $!"; +open(sort,'|sort +1n'); + +while () { + ($host,$upness,$foo,$users,$foo,$foo,$load) = split(/[\s,]+/); + if ($wanted{$host} && $upness eq 'up') { + printf sort "%s\t%s (%d)\n", $host, $load, $users; + } +} diff --git a/contrib/perl5/eg/nih b/contrib/perl5/eg/nih new file mode 100644 index 0000000..4475c49 --- /dev/null +++ b/contrib/perl5/eg/nih @@ -0,0 +1,11 @@ +eval 'exec /usr/bin/perl -Spi.bak $0 ${1+"$@"}' + if $running_under_some_shell; + +# $RCSfile: nih,v $$Revision: 4.1 $$Date: 92/08/07 17:20:27 $ + +# This script makes #! scripts directly executable on machines that don't +# support #!. It edits in place any scripts mentioned on the command line. + +s[^#!(.*)] + [#!$1\neval 'exec $1 -S \$0 \${1+"\$@"}'\n\tif \$running_under_some_shell;] + if $. == 1; diff --git a/contrib/perl5/eg/relink b/contrib/perl5/eg/relink new file mode 100644 index 0000000..2c5793f --- /dev/null +++ b/contrib/perl5/eg/relink @@ -0,0 +1,82 @@ +#!/usr/bin/perl +'di'; +'ig00'; +# +# $RCSfile: relink,v $$Revision: 4.1 $$Date: 92/08/07 17:20:29 $ +# +# $Log: relink,v $ + +($op = shift) || die "Usage: relink perlexpr [filenames]\n"; +if (!@ARGV) { + @ARGV = ; + chop(@ARGV); +} +for (@ARGV) { + next unless -l; # symbolic link? + $name = $_; + $_ = readlink($_); + $was = $_; + eval $op; + die $@ if $@; + if ($was ne $_) { + unlink($name); + symlink($_, $name); + } +} +############################################################################## + + # These next few lines are legal in both Perl and nroff. + +.00; # finish .ig + +'di \" finish diversion--previous line must be blank +.nr nl 0-1 \" fake up transition to first page again +.nr % 0 \" start at page 1 +';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############ +.TH RELINK 1 "July 30, 1990" +.AT 3 +.SH LINK +relink \- relinks multiple symbolic links +.SH SYNOPSIS +.B relink perlexpr [symlinknames] +.SH DESCRIPTION +.I Relink +relinks the symbolic links given according to the rule specified as the +first argument. +The argument is a Perl expression which is expected to modify the $_ +string in Perl for at least some of the names specified. +For each symbolic link named on the command line, the Perl expression +will be executed on the contents of the symbolic link with that name. +If a given symbolic link's contents is not modified by the expression, +it will not be changed. +If a name given on the command line is not a symbolic link, it will be ignored. +If no names are given on the command line, names will be read +via standard input. +.PP +For example, to relink all symbolic links in the current directory +pointing to somewhere in X11R3 so that they point to X11R4, you might say +.nf + + relink 's/X11R3/X11R4/' * + +.fi +To change all occurences of links in the system from /usr/spool to /var/spool, +you'd say +.nf + + find / -type l -print | relink 's#/usr/spool#/var/spool#' + +.fi +.SH ENVIRONMENT +No environment variables are used. +.SH FILES +.SH AUTHOR +Larry Wall +.SH "SEE ALSO" +ln(1) +.br +perl(1) +.SH DIAGNOSTICS +If you give an invalid Perl expression you'll get a syntax error. +.SH BUGS +.ex diff --git a/contrib/perl5/eg/rename b/contrib/perl5/eg/rename new file mode 100755 index 0000000..10e97f7 --- /dev/null +++ b/contrib/perl5/eg/rename @@ -0,0 +1,74 @@ +#!/usr/bin/perl +'di'; +'ig00'; +# +# $RCSfile: rename,v $$Revision: 4.1 $$Date: 92/08/07 17:20:30 $ +# +# $Log: rename,v $ + +($op = shift) || die "Usage: rename perlexpr [filenames]\n"; +if (!@ARGV) { + @ARGV = ; + chop(@ARGV); +} +for (@ARGV) { + $was = $_; + eval $op; + die $@ if $@; + rename($was,$_) unless $was eq $_; +} +############################################################################## + + # These next few lines are legal in both Perl and nroff. + +.00; # finish .ig + +'di \" finish diversion--previous line must be blank +.nr nl 0-1 \" fake up transition to first page again +.nr % 0 \" start at page 1 +';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############ +.TH RENAME 1 "July 30, 1990" +.AT 3 +.SH NAME +rename \- renames multiple files +.SH SYNOPSIS +.B rename perlexpr [files] +.SH DESCRIPTION +.I Rename +renames the filenames supplied according to the rule specified as the +first argument. +The argument is a Perl expression which is expected to modify the $_ +string in Perl for at least some of the filenames specified. +If a given filename is not modified by the expression, it will not be +renamed. +If no filenames are given on the command line, filenames will be read +via standard input. +.PP +For example, to rename all files matching *.bak to strip the extension, +you might say +.nf + + rename 's/\e.bak$//' *.bak + +.fi +To translate uppercase names to lower, you'd use +.nf + + rename 'y/A-Z/a-z/' * + +.fi +.SH ENVIRONMENT +No environment variables are used. +.SH FILES +.SH AUTHOR +Larry Wall +.SH "SEE ALSO" +mv(1) +.br +perl(1) +.SH DIAGNOSTICS +If you give an invalid Perl expression you'll get a syntax error. +.SH BUGS +.I Rename +does not check for the existence of target filenames, so use with care. +.ex diff --git a/contrib/perl5/eg/rmfrom b/contrib/perl5/eg/rmfrom new file mode 100644 index 0000000..7178e77 --- /dev/null +++ b/contrib/perl5/eg/rmfrom @@ -0,0 +1,7 @@ +#!/usr/bin/perl -n + +# $RCSfile: rmfrom,v $$Revision: 4.1 $$Date: 92/08/07 17:20:31 $ + +# A handy (but dangerous) script to put after a find ... -print. + +chop; unlink; diff --git a/contrib/perl5/eg/scan/scan_df b/contrib/perl5/eg/scan/scan_df new file mode 100644 index 0000000..c221cdc --- /dev/null +++ b/contrib/perl5/eg/scan/scan_df @@ -0,0 +1,51 @@ +#!/usr/bin/perl -P + +# $RCSfile: scan_df,v $$Revision: 4.1 $$Date: 92/08/07 17:20:33 $ + +# This report points out filesystems that are in danger of overflowing. + +(chdir '/usr/adm/private/memories') || die "Can't cd to memories: $!\n"; +`df >newdf`; +open(Df, 'olddf'); + +while () { + ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split; + next if $fs =~ /:/; + next if $fs eq ''; + $oldused{$fs} = $used; +} + +open(Df, 'newdf') || die "scan_df: can't open newdf"; + +while () { + ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split; + next if $fs =~ /:/; + next if $fs eq ''; + $oldused = $oldused{$fs}; + next if ($oldused == $used && $capacity < 99); # inactive filesystem + if ($capacity >= 90) { +#if defined(mc300) || defined(mc500) || defined(mc700) + $_ = substr($_,0,13) . ' ' . substr($_,13,1000); + $kbytes /= 2; # translate blocks to K + $used /= 2; + $oldused /= 2; + $avail /= 2; +#endif + $diff = int($used - $oldused); + if ($avail < $diff * 2) { # mark specially if in danger + $mounted_on .= ' *'; + } + next if $diff < 50 && $mounted_on eq '/'; + $fs =~ s|/dev/||; + if ($diff >= 0) { + $diff = '(+' . $diff . ')'; + } + else { + $diff = '(' . $diff . ')'; + } + printf "%-8s%8d%8d %-8s%8d%7s %s\n", + $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on; + } +} + +rename('newdf','olddf'); diff --git a/contrib/perl5/eg/scan/scan_last b/contrib/perl5/eg/scan/scan_last new file mode 100644 index 0000000..4d15ca0 --- /dev/null +++ b/contrib/perl5/eg/scan/scan_last @@ -0,0 +1,57 @@ +#!/usr/bin/perl -P + +# $RCSfile: scan_last,v $$Revision: 4.1 $$Date: 92/08/07 17:20:35 $ + +# This reports who was logged on at weird hours + +($dy, $mo, $lastdt) = split(/ +/,`date`); + +open(Last, 'exec last 2>&1 |') || die "scan_last: can't run last"; + +while () { +#if defined(mc300) || defined(mc500) || defined(mc700) + $_ = substr($_,0,19) . substr($_,23,100); +#endif + next if /^$/; + (print),next if m|^/|; + $login = substr($_,0,8); + $tty = substr($_,10,7); + $from = substr($_,19,15); + $day = substr($_,36,3); + $mo = substr($_,40,3); + $dt = substr($_,44,2); + $hr = substr($_,47,2); + $min = substr($_,50,2); + $dash = substr($_,53,1); + $tohr = substr($_,55,2); + $tomin = substr($_,58,2); + $durhr = substr($_,63,2); + $durmin = substr($_,66,2); + + next unless $hr; + next if $login eq 'reboot '; + next if $login eq 'shutdown'; + + if ($dt != $lastdt) { + if ($lastdt < $dt) { + $seen += $dt - $lastdt; + } + else { + $seen++; + } + $lastdt = $dt; + } + + $inat = $hr + $min / 60; + if ($tohr =~ /^[a-z]/) { + $outat = 12; # something innocuous + } else { + $outat = $tohr + $tomin / 60; + } + + last if $seen + ($inat < 8) > 1; + + if ($inat < 5 || $inat > 21 || $outat < 6 || $outat > 23) { + print; + } +} diff --git a/contrib/perl5/eg/scan/scan_messages b/contrib/perl5/eg/scan/scan_messages new file mode 100644 index 0000000..6cf0997 --- /dev/null +++ b/contrib/perl5/eg/scan/scan_messages @@ -0,0 +1,222 @@ +#!/usr/bin/perl -P + +# $RCSfile: scan_messages,v $$Revision: 4.1 $$Date: 92/08/07 17:20:37 $ + +# This prints out extraordinary console messages. You'll need to customize. + +chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n"; + +$maxpos = `cat oldmsgs 2>&1`; + +#if defined(mc300) || defined(mc500) || defined(mc700) +open(Msgs, '/dev/null') || die "scan_messages: can't open messages"; +#else +open(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages"; +#endif + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat(Msgs); + +if ($size < $maxpos) { # Did somebody truncate messages file? + $maxpos = 0; +} + +seek(Msgs,$maxpos,0); # Start where we left off last time. + +while () { + s/\[(\d+)\]/#/ && s/$1/#/g; +#ifdef vax + $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//; + next if /root@.*:/; + next if /^vmunix: 4.3 BSD UNIX/; + next if /^vmunix: Copyright/; + next if /^vmunix: avail mem =/; + next if /^vmunix: SBIA0 at /; + next if /^vmunix: disk ra81 is/; + next if /^vmunix: dmf. at uba/; + next if /^vmunix: dmf.:.*asynch/; + next if /^vmunix: ex. at uba/; + next if /^vmunix: ex.: HW/; + next if /^vmunix: il. at uba/; + next if /^vmunix: il.: hardware/; + next if /^vmunix: ra. at uba/; + next if /^vmunix: ra.: media/; + next if /^vmunix: real mem/; + next if /^vmunix: syncing disks/; + next if /^vmunix: tms/; + next if /^vmunix: tmscp. at uba/; + next if /^vmunix: uba. at /; + next if /^vmunix: uda. at /; + next if /^vmunix: uda.: unit . ONLIN/; + next if /^vmunix: .*buffers containing/; + next if /^syslogd: .*newslog/; +#endif + next if /unknown service/; + next if /^\.\.\.$/; + if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) { + $pfx = ''; + next; + } + next if /^[ \t]*$/; + next if /^[ 0-9]*done$/; + if (/^A/) { + next if /^Accounting [sr]/; + } + elsif (/^C/) { + next if /^Called from/; + next if /^Copyright/; + } + elsif (/^E/) { + next if /^End traceback/; + next if /^Ethernet address =/; + } + elsif (/^K/) { + next if /^KERNEL MODE/; + } + elsif (/^R/) { + next if /^Rebooting Unix/; + } + elsif (/^S/) { + next if /^Sun UNIX 4\.2 Release/; + } + elsif (/^W/) { + next if /^WARNING: clock gained/; + } + elsif (/^a/) { + next if /^arg /; + next if /^avail mem =/; + } + elsif (/^b/) { + next if /^bwtwo[0-9] at /; + } + elsif (/^c/) { + next if /^cgone[0-9] at /; + next if /^cdp[0-9] at /; + next if /^csr /; + } + elsif (/^d/) { + next if /^dcpa: init/; + next if /^done$/; + next if /^dts/; + next if /^dump i\/o error/; + next if /^dumping to dev/; + next if /^dump succeeded/; + $pfx = '*' if /^dev = /; + } + elsif (/^e/) { + next if /^end \*\*/; + next if /^error in copy/; + } + elsif (/^f/) { + next if /^found /; + } + elsif (/^i/) { + next if /^ib[0-9] at /; + next if /^ie[0-9] at /; + } + elsif (/^l/) { + next if /^le[0-9] at /; + } + elsif (/^m/) { + next if /^mem = /; + next if /^mt[0-9] at /; + next if /^mti[0-9] at /; + $pfx = '*' if /^mode = /; + } + elsif (/^n/) { + next if /^not found /; + } + elsif (/^p/) { + next if /^page map /; + next if /^pi[0-9] at /; + $pfx = '*' if /^panic/; + } + elsif (/^q/) { + next if /^qqq /; + } + elsif (/^r/) { + next if /^read /; + next if /^revarp: Requesting/; + next if /^root [od]/; + } + elsif (/^s/) { + next if /^sc[0-9] at /; + next if /^sd[0-9] at /; + next if /^sd[0-9]: oldmsgs.tmp') || die "Can't create tmp file: $!\n"; +while ($_ = pop(@seen)) { + print tmp $_; +} +close(tmp); +open(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n"; +while () { + if (/^nd:/) { + next if $seen{$_} < 20; + } + if (/NFS/) { + next if $seen{$_} < 20; + } + if (/no carrier/) { + next if $seen{$_} < 20; + } + if (/silo overflow/) { + next if $seen{$_} < 20; + } + print $seen{$_},":\t",$_; +} + +print `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`; diff --git a/contrib/perl5/eg/scan/scan_passwd b/contrib/perl5/eg/scan/scan_passwd new file mode 100644 index 0000000..50f6fc8 --- /dev/null +++ b/contrib/perl5/eg/scan/scan_passwd @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +# $RCSfile: scan_passwd,v $$Revision: 4.1 $$Date: 92/08/07 17:20:38 $ + +# This scans passwd file for security holes. + +open(Pass,'/etc/passwd') || die "Can't open passwd file: $!\n"; +# $dotriv = (`date` =~ /^Mon/); +$dotriv = 1; + +while () { + ($login,$pass,$uid,$gid,$gcos,$home,$shell) = split(/:/); + if ($shell eq '') { + print "Short: $_"; + } + next if /^[+]/; + if ($pass eq '') { + if (index(":sync:lpq:+:", ":$login:") < 0) { + print "No pass: $login\t$gcos\n"; + } + } + elsif ($dotriv && crypt($login,substr($pass,0,2)) eq $pass) { + print "Trivial: $login\t$gcos\n"; + } + if ($uid == 0) { + if ($login !~ /^.?root$/ && $pass ne '*') { + print "Extra root: $_"; + } + } +} diff --git a/contrib/perl5/eg/scan/scan_ps b/contrib/perl5/eg/scan/scan_ps new file mode 100644 index 0000000..18b5cb2 --- /dev/null +++ b/contrib/perl5/eg/scan/scan_ps @@ -0,0 +1,32 @@ +#!/usr/bin/perl -P + +# $RCSfile: scan_ps,v $$Revision: 4.1 $$Date: 92/08/07 17:20:40 $ + +# This looks for looping processes. + +#if defined(mc300) || defined(mc500) || defined(mc700) +open(Ps, '/bin/ps -el|') || die "scan_ps: can't run ps"; + +while () { + next if /rwhod/; + print if index(' T', substr($_,62,1)) < 0; +} +#else +open(Ps, '/bin/ps auxww|') || die "scan_ps: can't run ps"; + +while () { + next if /dataserver/; + next if /nfsd/; + next if /update/; + next if /ypserv/; + next if /rwhod/; + next if /routed/; + next if /pagedaemon/; +#ifdef vax + ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$start,$time) = split; +#else + ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$time) = split; +#endif + print if length($time) > 4; +} +#endif diff --git a/contrib/perl5/eg/scan/scan_sudo b/contrib/perl5/eg/scan/scan_sudo new file mode 100644 index 0000000..5b143e9 --- /dev/null +++ b/contrib/perl5/eg/scan/scan_sudo @@ -0,0 +1,54 @@ +#!/usr/bin/perl -P + +# $RCSfile: scan_sudo,v $$Revision: 4.1 $$Date: 92/08/07 17:20:42 $ + +# Analyze the sudo log. + +chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n"; + +if (open(Oldsudo,'oldsudo')) { + $maxpos = ; + close Oldsudo; +} +else { + $maxpos = 0; + `echo 0 >oldsudo`; +} + +unless (open(Sudo, '/usr/adm/sudo.log')) { + print "Somebody removed sudo.log!!!\n" if $maxpos; + exit 0; +} + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat(Sudo); + +if ($size < $maxpos) { + $maxpos = 0; + print "Somebody reset sudo.log!!!\n"; +} + +seek(Sudo,$maxpos,0); + +while () { + s/^.* :[ \t]+//; + s/ipcrm.*/ipcrm/; + s/kill.*/kill/; + unless ($seen{$_}++) { + push(@seen,$_); + } + $last = $_; +} +$max = tell(Sudo); + +open(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file: $!\n"; +while ($_ = pop(@seen)) { + print tmp $_; +} +close(tmp); +open(tmp,'oldsudo.tmp') || die "Can't reopen tmp file: $!\n"; +while () { + print $seen{$_},":\t",$_; +} + +print `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`; diff --git a/contrib/perl5/eg/scan/scan_suid b/contrib/perl5/eg/scan/scan_suid new file mode 100644 index 0000000..c10aa58 --- /dev/null +++ b/contrib/perl5/eg/scan/scan_suid @@ -0,0 +1,84 @@ +#!/usr/bin/perl -P + +# $RCSfile: scan_suid,v $$Revision: 4.1 $$Date: 92/08/07 17:20:43 $ + +# Look for new setuid root files. + +chdir '/usr/adm/private/memories' || die "Can't cd to memories: $!\n"; + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat('oldsuid'); +if ($nlink) { + $lasttime = $mtime; + $tmp = $ctime - $atime; + if ($tmp <= 0 || $tmp >= 10) { + print "WARNING: somebody has read oldsuid!\n"; + } + $tmp = $ctime - $mtime; + if ($tmp <= 0 || $tmp >= 10) { + print "WARNING: somebody has modified oldsuid!!!\n"; + } +} else { + $lasttime = time - 60 * 60 * 24; # one day ago +} +$thistime = time; + +#if defined(mc300) || defined(mc500) || defined(mc700) +open(Find, 'find / -perm -04000 -print |') || + die "scan_find: can't run find"; +#else +open(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') || + die "scan_find: can't run find"; +#endif + +open(suid, '>newsuid.tmp'); + +while () { + +#if defined(mc300) || defined(mc500) || defined(mc700) + $x = `/bin/ls -il $_`; + $_ = $x; + s/^ *//; + ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name) + = split; +#else + s/^ *//; + ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name) + = split; +#endif + + if ($perm =~ /[sS]/ && $owner eq 'root') { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($name); + $foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n", + $perm,$links,$owner,$group,$size,$month,$day,$name,$inode); + print suid $foo; + if ($ctime > $lasttime) { + if ($ctime > $thistime) { + print "Future file: $foo"; + } + else { + $ct .= $foo; + } + } + } +} +close(suid); + +print `sort +7 -8 newsuid.tmp >newsuid 2>&1`; +$foo = `/bin/diff oldsuid newsuid 2>&1`; +print "Differences in suid info:\n",$foo if $foo; +print `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`; +print `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`; +print `rm -f newsuid.tmp 2>&1`; + +@ct = split(/\n/,$ct); +$ct = ''; +$* = 1; +while ($#ct >= 0) { + $tmp = shift(@ct); + unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; } +} + +print "Inode changed since last time:\n",$ct if $ct; + diff --git a/contrib/perl5/eg/scan/scanner b/contrib/perl5/eg/scan/scanner new file mode 100644 index 0000000..e73cdc8 --- /dev/null +++ b/contrib/perl5/eg/scan/scanner @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +# $RCSfile: scanner,v $$Revision: 4.1 $$Date: 92/08/07 17:20:44 $ + +# This runs all the scan_* routines on all the machines in /etc/ghosts. +# We run this every morning at about 6 am: + +# !/bin/sh +# cd /usr/adm/private +# decrypt scanner | perl >scan.out 2>&1 +# mail admin = 0) { + @scanlist = @ARGV; +} else { + @scanlist = split(/[ \t\n]+/,`echo scan_*`); +} + +scan: while ($scan = shift(@scanlist)) { + print "\n********** $scan **********\n"; + $showhost++; + + $systype = 'all'; + + open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file'; + + $one_of_these = ":$systype:"; + if ($systype =~ s/\+/[+]/g) { + $one_of_these =~ s/\+/:/g; + } + + line: while () { + s/[ \t]*\n//; + if (!$_ || /^#/) { + next line; + } + if (/^([a-zA-Z_0-9]+)=(.+)/) { + $name = $1; $repl = $2; + $repl =~ s/\+/:/g; + $one_of_these =~ s/:$name:/:$repl:/; + next line; + } + @gh = split; + $host = $gh[0]; + if ($showhost) { $showhost = "$host:\t"; } + class: while ($class = pop(gh)) { + if (index($one_of_these,":$class:") >=0) { + $iter = 0; + `exec crypt -inquire <$scan >.x 2>/dev/null`; + unless (open(scan,'.x')) { + print "Can't run $scan: $!\n"; + next scan; + } + $cmd = ; + unless ($cmd =~ s/#!(.*)\n/$1/) { + $cmd = '/usr/bin/perl'; + } + close(scan); + if (open(PIPE,"exec rsh $host '$cmd' <.x|")) { + sleep(5); + unlink '.x'; + while () { + last if $iter++ > 1000; # must be looping + next if /^[0-9.]+u [0-9.]+s/; + print $showhost,$_; + } + close(PIPE); + } else { + print "(Can't execute rsh: $!)\n"; + } + last class; + } + } + } +} diff --git a/contrib/perl5/eg/server b/contrib/perl5/eg/server new file mode 100755 index 0000000..49a140a --- /dev/null +++ b/contrib/perl5/eg/server @@ -0,0 +1,27 @@ +#!./perl + +$pat = 'S n C4 x8'; +$inet = 2; +$echo = 7; +$smtp = 25; +$nntp = 119; + +$this = pack($pat,$inet,2345, 0,0,0,0); +select(NS); $| = 1; select(stdout); + +if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; } +if (bind(S,$this)) { print "bind ok\n"; } else { die $!; } +if (listen(S,5)) { print "listen ok\n"; } else { die $!; } +for (;;) { + print "Listening again\n"; + if ($addr = accept(NS,S)) { print "accept ok\n"; } else { die $!; } + + @ary = unpack($pat,$addr); + $, = ' '; + print @ary; print "\n"; + + while () { + print; + print NS; + } +} diff --git a/contrib/perl5/eg/shmkill b/contrib/perl5/eg/shmkill new file mode 100644 index 0000000..b91ee6f --- /dev/null +++ b/contrib/perl5/eg/shmkill @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +# $RCSfile: shmkill,v $$Revision: 4.1 $$Date: 92/08/07 17:20:45 $ + +# A script to call from crontab periodically when people are leaving shared +# memory sitting around unattached. + +open(ipcs,'ipcs -m -o|') || die "Can't run ipcs: $!"; + +while () { + $tmp = index($_,'NATTCH'); + $pos = $tmp if $tmp >= 0; + if (/^m/) { + ($m,$id,$key,$mode,$owner,$group,$attach) = split; + if ($attach != substr($_,$pos,6)) { + die "Different ipcs format--can't parse!\n"; + } + if ($attach == 0) { + push(@goners,'-m',$id); + } + } +} + +exec 'ipcrm', @goners if $#goners >= 0; diff --git a/contrib/perl5/eg/sysvipc/README b/contrib/perl5/eg/sysvipc/README new file mode 100644 index 0000000..54094f1 --- /dev/null +++ b/contrib/perl5/eg/sysvipc/README @@ -0,0 +1,9 @@ +FYEnjoyment, here are the test scripts I used while implementing SysV +IPC in Perl. Each of them must be run with the parameter "s" for +"send" or "r" for "receive"; in each case, the receiver is the server +and the sender is the client. + +-- +Chip Salzenberg at ComDev/TCT , + + diff --git a/contrib/perl5/eg/sysvipc/ipcmsg b/contrib/perl5/eg/sysvipc/ipcmsg new file mode 100644 index 0000000..646d8b6 --- /dev/null +++ b/contrib/perl5/eg/sysvipc/ipcmsg @@ -0,0 +1,47 @@ +#!/usr/bin/perl +eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if $running_under_some_shell; + +require 'sys/ipc.ph'; +require 'sys/msg.ph'; + +$| = 1; + +$mode = shift; +die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/; +$send = ($mode eq "s"); + +$id = msgget(0x1234, ($send ? 0 : &IPC_CREAT) | 0644); +die "Can't get message queue: $!\n" unless defined($id); +print "message queue id: $id\n"; + +if ($send) { + while () { + chop; + unless (msgsnd($id, pack("LA*", $., $_), 0)) { + die "Can't send message: $!\n"; + } + } +} +else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + unless (msgrcv($id, $_, 512, 0, 0)) { + die "Can't receive message: $!\n"; + } + ($type, $message) = unpack("La*", $_); + printf "[%d] %s\n", $type, $message; + } +} + +&leave; + +sub leave { + if (!$send) { + $x = msgctl($id, &IPC_RMID, 0); + if (!defined($x) || $x < 0) { + die "Can't remove message queue: $!\n"; + } + } + exit; +} diff --git a/contrib/perl5/eg/sysvipc/ipcsem b/contrib/perl5/eg/sysvipc/ipcsem new file mode 100644 index 0000000..e0dc551 --- /dev/null +++ b/contrib/perl5/eg/sysvipc/ipcsem @@ -0,0 +1,46 @@ +#!/usr/bin/perl +eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if $running_under_some_shell; + +require 'sys/ipc.ph'; +require 'sys/msg.ph'; + +$| = 1; + +$mode = shift; +die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/; +$signal = ($mode eq "s"); + +$id = semget(0x1234, 1, ($signal ? 0 : &IPC_CREAT) | 0644); +die "Can't get semaphore: $!\n" unless defined($id); +print "semaphore id: $id\n"; + +if ($signal) { + while () { + print "Signalling\n"; + unless (semop($id, pack("sss", 0, 1, 0))) { + die "Can't signal semaphore: $!\n"; + } + } +} +else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + unless (semop($id, pack("sss", 0, -1, 0))) { + die "Can't wait for semaphore: $!\n"; + } + print "Unblocked\n"; + } +} + +&leave; + +sub leave { + if (!$signal) { + $x = semctl($id, 0, &IPC_RMID, 0); + if (!defined($x) || $x < 0) { + die "Can't remove semaphore: $!\n"; + } + } + exit; +} diff --git a/contrib/perl5/eg/sysvipc/ipcshm b/contrib/perl5/eg/sysvipc/ipcshm new file mode 100644 index 0000000..ecc1ba4 --- /dev/null +++ b/contrib/perl5/eg/sysvipc/ipcshm @@ -0,0 +1,50 @@ +#!/usr/bin/perl +eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if $running_under_some_shell; + +require 'sys/ipc.ph'; +require 'sys/shm.ph'; + +$| = 1; + +$mode = shift; +die "usage: ipcshm {r|s}\n" unless $mode =~ /^[rs]$/; +$send = ($mode eq "s"); + +$SIZE = 32; +$id = shmget(0x1234, $SIZE, ($send ? 0 : &IPC_CREAT) | 0644); +die "Can't get shared memory: $!\n" unless defined($id); +print "shared memory id: $id\n"; + +if ($send) { + while () { + chop; + unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) { + die "Can't write to shared memory: $!\n"; + } + } +} +else { + $SIG{'INT'} = $SIG{'QUIT'} = "leave"; + for (;;) { + $_ = ; + unless (shmread($id, $_, 0, $SIZE)) { + die "Can't read shared memory: $!\n"; + } + $len = unpack("L", $_); + $message = substr($_, length(pack("L",0)), $len); + printf "[%d] %s\n", $len, $message; + } +} + +&leave; + +sub leave { + if (!$send) { + $x = shmctl($id, &IPC_RMID, 0); + if (!defined($x) || $x < 0) { + die "Can't remove shared memory: $!\n"; + } + } + exit; +} diff --git a/contrib/perl5/eg/travesty b/contrib/perl5/eg/travesty new file mode 100644 index 0000000..7e6f983 --- /dev/null +++ b/contrib/perl5/eg/travesty @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +while (<>) { + next if /^\./; + next if /^From / .. /^$/; + next if /^Path: / .. /^$/; + s/^\W+//; + push(@ary,split(' ')); + while ($#ary > 1) { + $a = $p; + $p = $n; + $w = shift(@ary); + $n = $num{$w}; + if ($n eq '') { + push(@word,$w); + $n = pack('S',$#word); + $num{$w} = $n; + } + $lookup{$a . $p} .= $n; + } +} + +for (;;) { + $n = $lookup{$a . $p}; + ($foo,$n) = each(lookup) if $n eq ''; + $n = substr($n,int(rand(length($n))) & 0177776,2); + $a = $p; + $p = $n; + ($w) = unpack('S',$n); + $w = $word[$w]; + $col += length($w) + 1; + if ($col >= 65) { + $col = 0; + print "\n"; + } + else { + print ' '; + } + print $w; + if ($w =~ /\.$/) { + if (rand() < .1) { + print "\n"; + $col = 80; + } + } +} diff --git a/contrib/perl5/eg/unuc b/contrib/perl5/eg/unuc new file mode 100755 index 0000000..ae5c652 --- /dev/null +++ b/contrib/perl5/eg/unuc @@ -0,0 +1,186 @@ +#!/usr/bin/perl + +print STDERR "Loading proper nouns...\n"; +open(DICT,"/usr/dict/words") || die "Can't find /usr/dict/words: $!\n"; +while () { + if (/^[A-Z]/) { + chop; + ($lower = $_) =~ y/A-Z/a-z/; + $proper{$lower} = $_; + } +} +close DICT; +print STDERR "Loading exceptions...\n"; + +$prog = <<'EOT'; +while (<>) { + next if /[a-z]/; + y/A-Z/a-z/; + s/(\w+)/$proper{$1} ? $proper{$1} : $1/eg; + s/^(\s*)([a-z])/$1 . (($tmp = $2) =~ y:a-z:A-Z:,$tmp)/e; + s/([-.?!]["']?(\n\s*| \s*)["']?)([a-z])/$1 . (($tmp = $3) =~ y:a-z:A-Z:,$tmp)/eg; + s/\b([b-df-hj-np-tv-xz]+)\b/(($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg; + s/([a-z])'([SDT])\b/$1 . "'" . (($tmp = $2) =~ y:A-Z:a-z:,$tmp)/eg; +EOT +while () { + chop; + next if /^$/; + next if /^#/; + if (! /;$/) { + $foo = $_; + $foo =~ y/A-Z/a-z/; + print STDERR "Dup $_\n" if $proper{$foo}; + $foo =~ s/([^\w ])/\\$1/g; + $foo =~ s/ /(\\s+)/g; + $foo = "\\b" . $foo if $foo =~ /^\w/; # XXX till patch 9 + $foo .= "\\b" if $foo =~ /\w$/; + $i = 0; + ($bar = $_) =~ s/ /'$' . ++$i/eg; + $_ = "s/$foo/$bar/gi;"; + } + $prog .= ' ' . $_ . "\n"; +} +$prog .= "}\ncontinue {\n print;\n}\n"; + +$/ = ''; +#print $prog; +eval $prog; die $@ if $@; +__END__ +A.M. +Air Force +Air Force Base +Air Force Station +American +Apr. +Ariane +Aug. +August +Bureau of Labor Statistics +CIT +Caltech +Cape Canaveral +Challenger +China +Corporation +Crippen +Daily News in Brief +Daniel Quayle +Dec. +Discovery +Edwards +Endeavour +Feb. +Ford Aerospace +Fri. +General Dynamics +George Bush +Headline News +HOTOL +I +II +III +IV +IX +Institute of Technology +JPL +Jan. +Jul. +Jun. +Kennedy Space Center +LDEF +Long Duration Exposure Facility +Long March +Mar. +March +Martin +Martin Marietta +Mercury +Mon. +in May +s/\bmay (\d)/May $1/g; +s/\boffice of (\w)/'Office of ' . (($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg; +National Science Foundation +NASA Select +New Mexico +Nov. +OMB +Oct. +Office of Management and Budget +President +President Bush +Richard Truly +Rocketdyne +Russian +Russians +Sat. +Sep. +Soviet +Soviet Union +Soviets +Space Shuttle +Sun. +Thu. +Tue. +U.S. +Union of Soviet Socialist Republics +United States +VI +VII +VIII +Vice President +Vice President Quayle +Wed. +White Sands +Kaman Aerospace +Aerospace Daily +Aviation Week +Space Technology +Washington Post +Los Angeles Times +New York Times +Aerospace Industries Association +president of +Johnson Space Center +Space Services +Inc. +Co. +Hughes Aircraft +Company +Orbital Sciences +Swedish Space +Arnauld +Nicogosian +Magellan +Galileo +Mir +Jet Propulsion Laboratory +University +Department of Defense +Orbital Science +OMS +United Press International +United Press +UPI +Associated Press +AP +Cable News Network +Cape York +Zenit +SYNCOM +Eastern +Western +Test Range +Jcsat +Japanese Satellite Communications +Defence Ministry +Defense Ministry +Skynet +Fixed Service Structure +Launch Processing System +Asiasat +Launch Control Center +Earth +CNES +Glavkosmos +Pacific +Atlantic diff --git a/contrib/perl5/eg/uudecode b/contrib/perl5/eg/uudecode new file mode 100644 index 0000000..3b3cb60 --- /dev/null +++ b/contrib/perl5/eg/uudecode @@ -0,0 +1,15 @@ +#!/usr/bin/perl +while (<>) { + next unless ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/; + open(OUT,"> $file") || die "Can't create $file: $!\n"; + while (<>) { + last if /^end/; + next if /[a-z]/; + next unless int((((ord() - 32) & 077) + 2) / 3) == + int(length() / 4); + print OUT unpack("u", $_); + } + chmod oct($mode), $file; + eof() && die "Missing end: $file may be truncated.\n"; +} + diff --git a/contrib/perl5/eg/van/empty b/contrib/perl5/eg/van/empty new file mode 100644 index 0000000..d699319 --- /dev/null +++ b/contrib/perl5/eg/van/empty @@ -0,0 +1,45 @@ +#!/usr/bin/perl + +# $RCSfile: empty,v $$Revision: 4.1 $$Date: 92/08/07 17:20:50 $ + +# This script empties a trashcan. + +$recursive = shift if $ARGV[0] eq '-r'; + +@ARGV = '.' if $#ARGV < 0; + +chop($pwd = `pwd`); + +dir: foreach $dir (@ARGV) { + unless (chdir $dir) { + print stderr "Can't find directory $dir: $!\n"; + next dir; + } + if ($recursive) { + do cmd('find . -name .deleted -exec /bin/rm -rf {} ;'); + } + else { + if (-d '.deleted') { + do cmd('rm -rf .deleted'); + } + else { + if ($dir eq '.' && $pwd =~ m|/\.deleted$|) { + chdir '..'; + do cmd('rm -rf .deleted'); + } + else { + print stderr "No trashcan found in directory $dir\n"; + } + } + } +} +continue { + chdir $pwd; +} + +# force direct execution with no shell + +sub cmd { + system split(' ',join(' ',@_)); +} + diff --git a/contrib/perl5/eg/van/unvanish b/contrib/perl5/eg/van/unvanish new file mode 100644 index 0000000..acb1603 --- /dev/null +++ b/contrib/perl5/eg/van/unvanish @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +# $RCSfile: unvanish,v $$Revision: 4.1 $$Date: 92/08/07 17:20:52 $ + +sub it { + if ($olddir ne '.') { + chop($pwd = `pwd`) if $pwd eq ''; + (chdir $olddir) || die "Directory $olddir is not accesible"; + } + unless ($olddir eq '.deleted') { + if (-d '.deleted') { + chdir '.deleted' || die "Directory .deleted is not accesible"; + } + else { + chop($pwd = `pwd`) if $pwd eq ''; + die "Directory .deleted does not exist" unless $pwd =~ /\.deleted$/; + } + } + print `mv $startfiles$filelist..$force`; + if ($olddir ne '.') { + (chdir $pwd) || die "Can't get back to original directory $pwd: $!\n"; + } +} + +if ($#ARGV < 0) { + open(lastcmd,'.deleted/.lastcmd') || + open(lastcmd,'.lastcmd') || + die "No previous vanish in this dir"; + $ARGV = ; + close(lastcmd); + @ARGV = split(/[\n ]+/,$ARGV); +} + +while ($ARGV[0] =~ /^-/) { + $_ = shift; + /^-f/ && ($force = ' >/dev/null 2>&1'); + /^-i/ && ($interactive = 1); + if (/^-+$/) { + $startfiles = '- '; + last; + } +} + +while ($file = shift) { + if ($file =~ s|^(.*)/||) { + $dir = $1; + } + else { + $dir = '.'; + } + + if ($dir ne $olddir) { + do it() if $olddir; + $olddir = $dir; + } + + if ($interactive) { + print "unvanish: restore $dir/$file? "; + next unless =~ /^y/i; + } + + $filelist .= $file; $filelist .= ' '; + +} + +do it() if $olddir; diff --git a/contrib/perl5/eg/van/vanexp b/contrib/perl5/eg/van/vanexp new file mode 100644 index 0000000..415b73b --- /dev/null +++ b/contrib/perl5/eg/van/vanexp @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +# $RCSfile: vanexp,v $$Revision: 4.1 $$Date: 92/08/07 17:20:53 $ + +# This is for running from a find at night to expire old .deleteds + +$can = $ARGV[0]; + +exit 1 unless $can =~ /.deleted$/; + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($can); + +exit 0 unless $size; + +if (time - $mtime > 2 * 24 * 60 * 60) { + `/bin/rm -rf $can`; +} +else { + `find $can -ctime +2 -exec rm -f {} \;`; +} diff --git a/contrib/perl5/eg/van/vanish b/contrib/perl5/eg/van/vanish new file mode 100644 index 0000000..09b9679 --- /dev/null +++ b/contrib/perl5/eg/van/vanish @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +# $RCSfile: vanish,v $$Revision: 4.1 $$Date: 92/08/07 17:20:54 $ + +sub it { + if ($olddir ne '.') { + chop($pwd = `pwd`) if $pwd eq ''; + (chdir $olddir) || die "Directory $olddir is not accesible"; + } + if (!-d .deleted) { + print `mkdir .deleted; chmod 775 .deleted`; + die "You can't remove files from $olddir" if $?; + } + $filelist =~ s/ $//; + $filelist =~ s/#/\\#/g; + if ($filelist !~ /^[ \t]*$/) { + open(lastcmd,'>.deleted/.lastcmd'); + print lastcmd $filelist,"\n"; + close(lastcmd); + print `/bin/mv $startfiles$filelist .deleted$force`; + } + if ($olddir ne '.') { + (chdir $pwd) || die "Can't get back to original directory $pwd: $!\n"; + } +} + +while ($ARGV[0] =~ /^-/) { + $_ = shift; + /^-f/ && ($force = ' >/dev/null 2>&1'); + /^-i/ && ($interactive = 1); + if (/^-+$/) { + $startfiles = '- '; + last; + } +} + +chop($pwd = `pwd`); + +while ($file = shift) { + if ($file =~ s|^(.*)/||) { + $dir = $1; + } + else { + $dir = '.'; + } + + if ($interactive) { + print "vanish: remove $dir/$file? "; + next unless =~ /^y/i; + } + + if ($file eq '.deleted') { + print stderr "To delete .deleted (the trashcan) use the 'empty' command.\n"; + next; + } + + if ($dir ne $olddir) { + do it() if $olddir; + $olddir = $dir; + } + + $filelist .= $file; $filelist .= ' '; +} + +do it() if $olddir; diff --git a/contrib/perl5/eg/who b/contrib/perl5/eg/who new file mode 100644 index 0000000..ac15246 --- /dev/null +++ b/contrib/perl5/eg/who @@ -0,0 +1,13 @@ +#!/usr/bin/perl +# This assumes your /etc/utmp file looks like ours +open(UTMP,'/etc/utmp'); +@mo = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec); +while (read(UTMP,$utmp,36)) { + ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp); + if ($name) { + $host = "($host)" if ord($host); + ($sec,$min,$hour,$mday,$mon) = localtime($time); + printf "%-9s%-8s%s %2d %02d:%02d %s\n", + $name,$line,$mo[$mon],$mday,$hour,$min,$host; + } +} diff --git a/contrib/perl5/eg/wrapsuid b/contrib/perl5/eg/wrapsuid new file mode 100755 index 0000000..3b1fc6e --- /dev/null +++ b/contrib/perl5/eg/wrapsuid @@ -0,0 +1,104 @@ +#!/usr/bin/perl +'di'; +'ig00'; +# +# $Header: wrapsuid,v 1.1 90/08/11 13:51:29 lwall Locked $ +# +# $Log: wrapsuid,v $ +# Revision 1.1 90/08/11 13:51:29 lwall +# Initial revision +# + +$xdev = '-xdev' unless -d '/dev/iop'; + +if ($#ARGV >= 0) { + @list = @ARGV; + foreach $name (@ARGV) { + die "You must use absolute pathnames.\n" unless $name =~ m|^/|; + } +} +else { + open(DF,"/etc/mount|") || die "Can't run /etc/mount"; + + while () { + chop; + $_ .= if length($_) < 50; + @ary = split; + push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|); + } +} +$fslist = join(' ',@list); + +die "Can't find local filesystems" unless $fslist; + +open(FIND, + "find $fslist $xdev -type f \\( -perm -04000 -o -perm -02000 \\) -print|"); + +while () { + chop; + next unless -T; + print "Fixing ", $_, "\n"; + ($dir,$file) = m|(.*)/(.*)|; + chdir $dir || die "Can't chdir to $dir"; + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($file); + die "Can't stat $_" unless $ino; + chmod $mode & 01777, $file; # wipe out set[ug]id bits + rename($file,".$file"); + open(C,">.tmp$$.c") || die "Can't write C program for $_"; + $real = "$dir/.$file"; + print C ' +main(argc,argv) +int argc; +char **argv; +{ + execv("' . $real . '",argv); +} +'; + close C; + system '/bin/cc', ".tmp$$.c", '-o', $file; + die "Can't compile new $_" if $?; + chmod $mode, $file; + chown $uid, $gid, $file; + unlink ".tmp$$.c"; + chdir '/'; +} +############################################################################## + + # These next few lines are legal in both Perl and nroff. + +.00; # finish .ig + +'di \" finish diversion--previous line must be blank +.nr nl 0-1 \" fake up transition to first page again +.nr % 0 \" start at page 1 +'; __END__ ############# From here on it's a standard manual page ############ +.TH SUIDSCRIPT 1 "July 30, 1990" +.AT 3 +.SH NAME +wrapsuid \- puts a compiled C wrapper around a setuid or setgid script +.SH SYNOPSIS +.B wrapsuid [dirlist] +.SH DESCRIPTION +.I Wrapsuid +creates a small C program to execute a script with setuid or setgid privileges +without having to set the setuid or setgid bit on the script, which is +a security problem on many machines. +Specify the list of directories or files that you wish to process. +The names must be absolute pathnames. +With no arguments it will attempt to process all the local directories +for this machine. +The scripts to be processed must have the setuid or setgid bit set. +The wrapsuid program will delete the bits and set them on the wrapper. +.PP +Non-superusers may only process their own files. +.SH ENVIRONMENT +No environment variables are used. +.SH FILES +None. +.SH AUTHOR +Larry Wall +.SH "SEE ALSO" +.SH DIAGNOSTICS +.SH BUGS +.ex diff --git a/contrib/perl5/embed.h b/contrib/perl5/embed.h index 592f39b..e7deb32 100644 --- a/contrib/perl5/embed.h +++ b/contrib/perl5/embed.h @@ -159,6 +159,7 @@ #define do_trans Perl_do_trans #define do_vecset Perl_do_vecset #define do_vop Perl_do_vop +#define dofile Perl_dofile #define dofindlabel Perl_dofindlabel #define dopoptoeval Perl_dopoptoeval #define dounwind Perl_dounwind @@ -204,6 +205,7 @@ #define get_op_names Perl_get_op_names #define get_opargs Perl_get_opargs #define get_specialsv_list Perl_get_specialsv_list +#define get_vtbl Perl_get_vtbl #define gp_free Perl_gp_free #define gp_ref Perl_gp_ref #define gt_amg Perl_gt_amg @@ -859,6 +861,7 @@ #define save_freeop Perl_save_freeop #define save_freepv Perl_save_freepv #define save_freesv Perl_save_freesv +#define save_generic_svref Perl_save_generic_svref #define save_gp Perl_save_gp #define save_hash Perl_save_hash #define save_helem Perl_save_helem diff --git a/contrib/perl5/embed.pl b/contrib/perl5/embed.pl index a7fb0ed..497b97d 100755 --- a/contrib/perl5/embed.pl +++ b/contrib/perl5/embed.pl @@ -37,7 +37,6 @@ sub readsyms (\%$) { } readsyms %global, 'global.sym'; -readsyms %interp, 'interp.sym'; sub readvars(\%$$) { my ($syms, $file,$pre) = @_; @@ -63,11 +62,10 @@ readvars %globvar, 'perlvars.h','G'; foreach my $sym (sort keys %intrp) { - warn "$sym not in interp.sym\n" unless exists $interp{$sym}; if (exists $global{$sym}) { delete $global{$sym}; - warn "$sym in global.sym as well as interp\n"; + warn "$sym in global.sym as well as intrpvar.h\n"; } } @@ -80,19 +78,13 @@ foreach my $sym (sort keys %globvar) } } -foreach my $sym (keys %interp) - { - warn "extra $sym in interp.sym\n" - unless exists $intrp{$sym} || exists $thread{$sym}; - } - foreach my $sym (sort keys %thread) { - warn "$sym in intrpvar.h\n" if exists $intrp{$sym}; + warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym}; if (exists $global{$sym}) { delete $global{$sym}; - warn "$sym in global.sym as well as thread\n"; + warn "$sym in global.sym as well as thrdvar.h\n"; } } diff --git a/contrib/perl5/embedvar.h b/contrib/perl5/embedvar.h index 7a258b0..25b31e0 100644 --- a/contrib/perl5/embedvar.h +++ b/contrib/perl5/embedvar.h @@ -250,6 +250,7 @@ #define PL_stdingv (PL_curinterp->Istdingv) #define PL_strchop (PL_curinterp->Istrchop) #define PL_strtab (PL_curinterp->Istrtab) +#define PL_strtab_mutex (PL_curinterp->Istrtab_mutex) #define PL_sub_generation (PL_curinterp->Isub_generation) #define PL_sublex_info (PL_curinterp->Isublex_info) #define PL_sv_arenaroot (PL_curinterp->Isv_arenaroot) @@ -384,6 +385,7 @@ #define PL_Istdingv PL_stdingv #define PL_Istrchop PL_strchop #define PL_Istrtab PL_strtab +#define PL_Istrtab_mutex PL_strtab_mutex #define PL_Isub_generation PL_sub_generation #define PL_Isublex_info PL_sublex_info #define PL_Isv_arenaroot PL_sv_arenaroot @@ -647,6 +649,7 @@ #define PL_collxfrm_base (PL_Vars.Gcollxfrm_base) #define PL_collxfrm_mult (PL_Vars.Gcollxfrm_mult) #define PL_cop_seqmax (PL_Vars.Gcop_seqmax) +#define PL_cred_mutex (PL_Vars.Gcred_mutex) #define PL_cryptseen (PL_Vars.Gcryptseen) #define PL_cshlen (PL_Vars.Gcshlen) #define PL_cshname (PL_Vars.Gcshname) @@ -757,6 +760,7 @@ #define PL_Gcollxfrm_base PL_collxfrm_base #define PL_Gcollxfrm_mult PL_collxfrm_mult #define PL_Gcop_seqmax PL_cop_seqmax +#define PL_Gcred_mutex PL_cred_mutex #define PL_Gcryptseen PL_cryptseen #define PL_Gcshlen PL_cshlen #define PL_Gcshname PL_cshname diff --git a/contrib/perl5/ext/B/B.pm b/contrib/perl5/ext/B/B.pm index d5137d4..75dcfb3 100644 --- a/contrib/perl5/ext/B/B.pm +++ b/contrib/perl5/ext/B/B.pm @@ -13,7 +13,7 @@ require Exporter; class peekop cast_I32 cstring cchar hash threadsv_names main_root main_start main_cv svref_2object walkoptree walkoptree_slow walkoptree_exec walksymtable - parents comppadlist sv_undef compile_stats timing_info); + parents comppadlist sv_undef compile_stats timing_info init_av); use strict; @B::SV::ISA = 'B::OBJECT'; @@ -530,6 +530,8 @@ C (corresponding to the C function C). =item XSUBANY +=item CvFLAGS + =back =head2 B::HV METHODS @@ -576,7 +578,7 @@ This returns the function name as a string (e.g. pp_add, pp_rv2av). =item desc -This returns the op description from the global C op_desc array +This returns the op description from the global C PL_op_desc array (e.g. "addition" "array deref"). =item targ @@ -720,6 +722,10 @@ get an initial "handle" on an internal object. Return the (faked) CV corresponding to the main part of the Perl program. +=item init_av + +Returns the AV object (i.e. in class B::AV) representing INIT blocks. + =item main_root Returns the root op (i.e. an object in the appropriate B::OP-derived diff --git a/contrib/perl5/ext/B/B.xs b/contrib/perl5/ext/B/B.xs index 8dbc915..6610ae8 100644 --- a/contrib/perl5/ext/B/B.xs +++ b/contrib/perl5/ext/B/B.xs @@ -267,7 +267,8 @@ static SV * cchar(SV *sv) { SV *sstr = newSVpv("'", 0); - char *s = SvPV(sv, PL_na); + STRLEN n_a; + char *s = SvPV(sv, n_a); if (*s == '\'') sv_catpv(sstr, "\\'"); @@ -437,6 +438,7 @@ BOOT: INIT_SPECIALSV_LIST; #define B_main_cv() PL_main_cv +#define B_init_av() PL_initav #define B_main_root() PL_main_root #define B_main_start() PL_main_start #define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv)) @@ -444,6 +446,9 @@ BOOT: #define B_sv_yes() &PL_sv_yes #define B_sv_no() &PL_sv_no +B::AV +B_init_av() + B::CV B_main_cv() @@ -1164,6 +1169,13 @@ CvXSUBANY(cv) CODE: ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv)); +MODULE = B PACKAGE = B::CV + +U8 +CvFLAGS(cv) + B::CV cv + + MODULE = B PACKAGE = B::HV PREFIX = Hv STRLEN diff --git a/contrib/perl5/ext/B/B/Assembler.pm b/contrib/perl5/ext/B/B/Assembler.pm index defcbdf..06e00ad 100644 --- a/contrib/perl5/ext/B/B/Assembler.pm +++ b/contrib/perl5/ext/B/B/Assembler.pm @@ -53,6 +53,8 @@ sub B::Asmdata::PUT_U16 { pack("n", $_[0]) } sub B::Asmdata::PUT_U32 { pack("N", $_[0]) } sub B::Asmdata::PUT_I32 { pack("N", $_[0]) } sub B::Asmdata::PUT_objindex { pack("N", $_[0]) } # could allow names here +sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex } +sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex } sub B::Asmdata::PUT_strconst { my $arg = shift; @@ -78,7 +80,7 @@ sub B::Asmdata::PUT_PV { error "bad string argument: $arg" unless defined($arg); return pack("N", length($arg)) . $arg; } -sub B::Asmdata::PUT_comment { +sub B::Asmdata::PUT_comment_t { my $arg = shift; $arg = uncstring($arg); error "bad string argument: $arg" unless defined($arg); diff --git a/contrib/perl5/ext/B/B/C.pm b/contrib/perl5/ext/B/B/C.pm index 0b7d6eb..e695cc2 100644 --- a/contrib/perl5/ext/B/B/C.pm +++ b/contrib/perl5/ext/B/B/C.pm @@ -13,7 +13,7 @@ use Exporter (); use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop class cstring cchar svref_2object compile_stats comppadlist hash - threadsv_names); + threadsv_names main_cv init_av); use B::Asmdata qw(@specialsv_name); use FileHandle; @@ -44,7 +44,7 @@ my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, $cvopsect, $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect, $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect, - $xrvsect, $xpvbmsect, $xpviosect); + $xrvsect, $xpvbmsect, $xpviosect, $bootstrap); sub walk_and_save_optree; my $saveoptree_callback = \&walk_and_save_optree; @@ -596,10 +596,15 @@ sub B::CV::save { warn sprintf("No definition for sub %s::%s (unable to autoload)\n", $cvstashname, $cvname); # debug } - $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0", + $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0x%x", $xpvcv_ix, cstring($pv), length($pv), $cv->IVX, $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH, - $$padlist, ${$cv->OUTSIDE})); + $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS)); + + if (${$cv->OUTSIDE} == ${main_cv()}){ + $init->add(sprintf("CvOUTSIDE(s\\_%x)=PL_main_cv;",$$cv)); + } + if ($$gv) { $gv->save; $init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv)); @@ -691,7 +696,7 @@ sub B::GV::save { } my $gvfilegv = $gv->FILEGV; if ($$gvfilegv) { - $init->add(sprintf("GvFILEGV($sym) = s\\_%x;",$$gvfilegv)); + $init->add(sprintf("GvFILEGV($sym) = (GV*)s\\_%x;",$$gvfilegv)); # warn "GV::save GvFILEGV(*$name)\n"; # debug $gvfilegv->save; } @@ -847,6 +852,7 @@ sub output_all { $cvopsect, $loopsect, $copsect, $svsect, $xpvsect, $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect); + $bootstrap->output(\*STDOUT, "/* bootstrap %s */\n"); $symsect->output(\*STDOUT, "#define %s\n"); print "\n"; output_declarations(); @@ -1046,30 +1052,61 @@ sub save_object { foreach $sv (@_) { svref_2object($sv)->save; } -} +} + +sub Dummy_BootStrap { } sub B::GV::savecv { my $gv = shift; my $cv = $gv->CV; my $name = $gv->NAME; - if ($$cv && !objsym($cv) && !($name eq "bootstrap" && $cv->XSUB)) { + if ($$cv) { + if ($name eq "bootstrap" && $cv->XSUB) { + my $file = $cv->FILEGV->SV->PV; + $bootstrap->add($file); + my $name = $gv->STASH->NAME.'::'.$name; + no strict 'refs'; + *{$name} = \&Dummy_BootStrap; + $cv = $gv->CV; + } if ($debug_cv) { warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n", $gv->STASH->NAME, $name, $$cv, $$gv); } + my $package=$gv->STASH->NAME; + # This seems to undo all the ->isa and prefix stuff we do below + # so disable again for now + if (0 && ! grep(/^$package$/,@unused_sub_packages)){ + warn sprintf("omitting cv in superclass %s", $gv->STASH->NAME) + if $debug_cv; + return ; + } $gv->save; } + elsif ($name eq 'ISA') + { + $gv->save; + } + } + + sub save_unused_subs { my %search_pack; map { $search_pack{$_} = 1 } @_; + @unused_sub_packages=@_; no strict qw(vars refs); walksymtable(\%{"main::"}, "savecv", sub { my $package = shift; $package =~ s/::$//; + return 0 if ($package =~ /::::/); # skip ::::ISA::CACHE etc. #warn "Considering $package\n";#debug return 1 if exists $search_pack{$package}; + #sub try for a partial match + if (grep(/^$package\:\:/,@unused_sub_packages)){ + return 1; + } #warn " (nothing explicit)\n";#debug # Omit the packages which we use (and which cause grief # because of fancy "goto &$AUTOLOAD" stuff). @@ -1079,10 +1116,21 @@ sub save_unused_subs { || $package eq "SelectSaver") { return 0; } - my $m; - foreach $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) { + foreach my $u (keys %search_pack) { + if ($package =~ /^${u}::/) { + warn "$package starts with $u\n"; + return 1 + } + if ($package->isa($u)) { + warn "$package isa $u\n"; + return 1 + } + return 1 if $package->isa($u); + } + foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) { if (defined(&{$package."::$m"})) { warn "$package has method $m: -u$package assumed\n";#debug + push @unused_sub_package, $package; return 1; } } @@ -1091,14 +1139,25 @@ sub save_unused_subs { } sub save_main { + warn "Walking tree\n"; + my $curpad_nam = (comppadlist->ARRAY)[0]->save; my $curpad_sym = (comppadlist->ARRAY)[1]->save; + my $init_av = init_av->save; + my $inc_hv = svref_2object(\%INC)->save; + my $inc_av = svref_2object(\@INC)->save; walkoptree(main_root, "save"); warn "done main optree, walking symtable for extras\n" if $debug_cv; save_unused_subs(@unused_sub_packages); $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}), sprintf("PL_main_start = s\\_%x;", ${main_start()}), - "PL_curpad = AvARRAY($curpad_sym);"); + "PL_curpad = AvARRAY($curpad_sym);", + "PL_initav = $init_av;", + "GvHV(PL_incgv) = $inc_hv;", + "GvAV(PL_incgv) = $inc_av;", + "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));", + "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));"); + warn "Writing output\n"; output_boilerplate(); print "\n"; output_all("perl_init"); @@ -1118,7 +1177,7 @@ sub init_sections { xpviv => \$xpvivsect, xpvnv => \$xpvnvsect, xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect, xrv => \$xrvsect, xpvbm => \$xpvbmsect, - xpvio => \$xpviosect); + xpvio => \$xpviosect, bootstrap => \$bootstrap); my ($name, $sectref); while (($name, $sectref) = splice(@sections, 0, 2)) { $$sectref = new B::Section $name, \%symtable, 0; diff --git a/contrib/perl5/ext/B/B/CC.pm b/contrib/perl5/ext/B/B/CC.pm index 9991d8e..d200d70 100644 --- a/contrib/perl5/ext/B/B/CC.pm +++ b/contrib/perl5/ext/B/B/CC.pm @@ -878,7 +878,7 @@ sub pp_sassign { } runtime("SvSETMAGIC(TOPs);"); } else { - my $dst = pop @stack; + my $dst = $stack[-1]; my $type = $dst->{type}; runtime("sv = POPs;"); runtime("MAYBE_TAINT_SASSIGN_SRC(sv);"); @@ -946,13 +946,25 @@ sub pp_entersub { write_back_lexicals(REGISTER|TEMPORARY); write_back_stack(); my $sym = doop($op); - runtime("if (PL_op != ($sym)->op_next) PL_op = (*PL_op->op_ppaddr)(ARGS);"); - runtime("SPAGAIN;"); + runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){"); + runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);"); + runtime("SPAGAIN;}"); $know_op = 0; invalidate_lexicals(REGISTER|TEMPORARY); return $op->next; } +sub pp_goto{ + + my $op = shift; + my $ppname = $op->ppaddr; + write_back_lexicals() unless $skip_lexicals{$ppname}; + write_back_stack() unless $skip_stack{$ppname}; + my $sym=doop($op); + runtime("if (PL_op != ($sym)->op_next && PL_op != (OP*)0){return PL_op;}"); + invalidate_lexicals() unless $skip_invalidate{$ppname}; + return $op->next; +} sub pp_enterwrite { my $op = shift; pp_entersub($op); @@ -1051,7 +1063,7 @@ sub pp_return { write_back_lexicals(REGISTER|TEMPORARY); write_back_stack(); doop($op); - runtime("PUTBACK;", "return 0;"); + runtime("PUTBACK;", "return (PL_op)?PL_op->op_next:0;"); $know_op = 0; return $op->next; } @@ -1344,7 +1356,7 @@ sub cc { $need_freetmps = 0; } if (!$$op) { - runtime("PUTBACK;", "return 0;"); + runtime("PUTBACK;","return (PL_op)?PL_op->op_next:0;"); } elsif ($done{$$op}) { runtime(sprintf("goto %s;", label($op))); } @@ -1375,6 +1387,7 @@ sub cc_obj { sub cc_main { my @comppadlist = comppadlist->ARRAY; + my $curpad_nam = $comppadlist[0]->save; my $curpad_sym = $comppadlist[1]->save; my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist); save_unused_subs(@unused_sub_packages); @@ -1384,7 +1397,9 @@ sub cc_main { if (!defined($module)) { $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}), "PL_main_start = $start;", - "PL_curpad = AvARRAY($curpad_sym);"); + "PL_curpad = AvARRAY($curpad_sym);", + "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));", + "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));"); } output_boilerplate(); print "\n"; diff --git a/contrib/perl5/ext/B/B/Disassembler.pm b/contrib/perl5/ext/B/B/Disassembler.pm index f26441d..4a008a3 100644 --- a/contrib/perl5/ext/B/B/Disassembler.pm +++ b/contrib/perl5/ext/B/B/Disassembler.pm @@ -77,7 +77,7 @@ sub GET_PV { } } -sub GET_comment { +sub GET_comment_t { my $fh = shift; my ($str, $c); while (defined($c = $fh->getc) && $c ne "\n") { diff --git a/contrib/perl5/ext/B/Makefile.PL b/contrib/perl5/ext/B/Makefile.PL index cdcc4ed..80e5e1b 100644 --- a/contrib/perl5/ext/B/Makefile.PL +++ b/contrib/perl5/ext/B/Makefile.PL @@ -16,7 +16,7 @@ if ($^O eq 'MSWin32') { WriteMakefile( NAME => "B", VERSION => "a5", - MAN3PODS => ' ', + MAN3PODS => {}, clean => { FILES => "perl$e byteperl$e *$o B.c *~" } diff --git a/contrib/perl5/ext/B/README b/contrib/perl5/ext/B/README index 4e4ed25..fa3f085 100644 --- a/contrib/perl5/ext/B/README +++ b/contrib/perl5/ext/B/README @@ -20,8 +20,8 @@ in the file named "Artistic". If not, you can get one from the Perl distribution. You should also have received a copy of the GNU General Public License, in the file named "Copying". If not, you can get one - from the Perl distribution or else write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + from the Perl distribution or else write to the Free Software Foundation, + Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. CHANGES diff --git a/contrib/perl5/ext/DB_File/Changes b/contrib/perl5/ext/DB_File/Changes index 993fe32..2fab919 100644 --- a/contrib/perl5/ext/DB_File/Changes +++ b/contrib/perl5/ext/DB_File/Changes @@ -203,3 +203,32 @@ 1.60 Changed the test to check for full tied array support + +1.61 19th November 1998 + + Added a note to README about how to build Berkeley DB 2.x when + using HP-UX. + Minor modifications to get the module to build with DB 2.5.x + Fixed a typo in the definition of O_RDONLY, courtesy of Mark Kettenis. + +1.62 30th November 1998 + + Added hints/dynixptx.pl. + Fixed typemap -- 1.61 used PL_na instead of na + +1.63 19th December 1998 + + * Fix to allow DB 2.6.x to build with DB_File + * Documentation updated to use push,pop etc in the RECNO example & + to include the find_dup & del_dup methods. + +1.64 21st February 1999 + + * Tidied the 1.x to 2.x flag mapping code. + * Added a patch from Mark Kettenis to fix a flag + mapping problem with O_RDONLY on the Hurd + * Updated the message that db-recno.t prints when tests 51, 53 or 55 fail. + +1.65 6th March 1999 + * Fixed a bug in the recno PUSH logic. + * The BOOT version check now needs 2.3.4 when using Berkeley DB version 2 diff --git a/contrib/perl5/ext/DB_File/DB_File.pm b/contrib/perl5/ext/DB_File/DB_File.pm index fcd0746..e5759ff 100644 --- a/contrib/perl5/ext/DB_File/DB_File.pm +++ b/contrib/perl5/ext/DB_File/DB_File.pm @@ -1,10 +1,10 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # -# written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 16th May 1998 -# version 1.60 +# written by Paul Marquess (Paul.Marquess@btinternet.com) +# last modified 6th March 1999 +# version 1.65 # -# Copyright (c) 1995-8 Paul Marquess. All rights reserved. +# Copyright (c) 1995-9 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. @@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver use Carp; -$VERSION = "1.60" ; +$VERSION = "1.65" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -300,6 +300,40 @@ sub STORESIZE } } +sub find_dup +{ + croak "Usage: \$db->find_dup(key,value)\n" + unless @_ == 3 ; + + my $db = shift ; + my ($origkey, $value_wanted) = @_ ; + my ($key, $value) = ($origkey, 0); + my ($status) = 0 ; + + for ($status = $db->seq($key, $value, R_CURSOR() ) ; + $status == 0 ; + $status = $db->seq($key, $value, R_NEXT() ) ) { + + return 0 if $key eq $origkey and $value eq $value_wanted ; + } + + return $status ; +} + +sub del_dup +{ + croak "Usage: \$db->del_dup(key,value)\n" + unless @_ == 3 ; + + my $db = shift ; + my ($key, $value) = @_ ; + my ($status) = $db->find_dup($key, $value) ; + return $status if $status != 0 ; + + $status = $db->del($key, R_CURSOR() ) ; + return $status ; +} + sub get_dup { croak "Usage: \$db->get_dup(key [,flag])\n" @@ -364,6 +398,8 @@ DB_File - Perl5 access to Berkeley DB version 1.x $count = $X->get_dup($key) ; @list = $X->get_dup($key) ; %list = $X->get_dup($key, 1) ; + $status = $X->find_dup($key, $value) ; + $status = $X->del_dup($key, $value) ; # RECNO only $a = $X->length; @@ -443,11 +479,11 @@ is considered stable enough for real work. B The database file format has changed in Berkeley DB version 2. If you cannot recreate your databases, you must dump any existing databases with the C utility that comes with Berkeley DB. -Once you have upgraded DB_File to use Berkeley DB version 2, your +Once you have rebuilt DB_File to use Berkeley DB version 2, your databases can be recreated using C. Refer to the Berkeley DB documentation for further details. -Please read L before using version 2.x of Berkeley DB with +Please read L<"COPYRIGHT"> before using version 2.x of Berkeley DB with DB_File. =head2 Interface to Berkeley DB @@ -837,9 +873,12 @@ that prints: This time we have got all the key/value pairs, including the multiple values associated with the key C. +To make life easier when dealing with duplicate keys, B comes with +a few utility methods. + =head2 The get_dup() Method -B comes with a utility method, called C, to assist in +The C method assists in reading duplicate values from BTREE databases. The method can take the following forms: @@ -888,6 +927,79 @@ and it will print: Smith => [John] Dog => [] +=head2 The find_dup() Method + + $status = $X->find_dup($key, $value) ; + +This method checks for the existance of a specific key/value pair. If the +pair exists, the cursor is left pointing to the pair and the method +returns 0. Otherwise the method returns a non-zero value. + +Assuming the database from the previous example: + + use strict ; + use DB_File ; + + use vars qw($filename $x %h $found) ; + + my $filename = "tree" ; + + # Enable duplicate records + $DB_BTREE->{'flags'} = R_DUP ; + + $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE + or die "Cannot open $filename: $!\n"; + + $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; + print "Larry Wall is $found there\n" ; + + $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; + print "Harry Wall is $found there\n" ; + + undef $x ; + untie %h ; + +prints this + + Larry Wall is there + Harry Wall is not there + + +=head2 The del_dup() Method + + $status = $X->del_dup($key, $value) ; + +This method deletes a specific key/value pair. It returns +0 if they exist and have been deleted successfully. +Otherwise the method returns a non-zero value. + +Again assuming the existance of the C database + + use strict ; + use DB_File ; + + use vars qw($filename $x %h $found) ; + + my $filename = "tree" ; + + # Enable duplicate records + $DB_BTREE->{'flags'} = R_DUP ; + + $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE + or die "Cannot open $filename: $!\n"; + + $x->del_dup("Wall", "Larry") ; + + $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; + print "Larry Wall is $found there\n" ; + + undef $x ; + untie %h ; + +prints this + + Larry Wall is not there + =head2 Matching Partial Keys The BTREE interface has a feature which allows partial keys to be @@ -970,7 +1082,7 @@ Here is the output: DB_RECNO provides an interface to flat text files. Both variable and fixed length records are supported. -In order to make RECNO more compatible with Perl the array offset for +In order to make RECNO more compatible with Perl, the array offset for all RECNO arrays begins at 0 rather than 1 as in Berkeley DB. As with normal Perl arrays, a RECNO array can be accessed using @@ -999,7 +1111,7 @@ error will be fixed in the next release of Berkeley DB. That clarifies the situation with regards Berkeley DB itself. What about B? Well, the behavior defined in the quote above is -quite useful, so B conforms it. +quite useful, so B conforms to it. That means that you can specify other options (e.g. cachesize) and still have bval default to C<"\n"> for variable length records, and @@ -1007,7 +1119,9 @@ space for fixed length records. =head2 A Simple Example -Here is a simple example that uses RECNO. +Here is a simple example that uses RECNO (if you are using a version +of Perl earlier than 5.004_57 this example won't work -- see +L for a workaround). use strict ; use DB_File ; @@ -1021,6 +1135,18 @@ Here is a simple example that uses RECNO. $h[1] = "blue" ; $h[2] = "yellow" ; + push @h, "green", "black" ; + + my $elements = scalar @h ; + print "The array contains $elements entries\n" ; + + my $last = pop @h ; + print "popped $last\n" ; + + unshift @h, "white" ; + my $first = shift @h ; + print "shifted $first\n" ; + # Check for existence of a key print "Element 1 Exists with value $h[1]\n" if $h[1] ; @@ -1032,17 +1158,19 @@ Here is a simple example that uses RECNO. Here is the output from the script: - + The array contains 5 entries + popped black + unshifted white Element 1 Exists with value blue - The last element is yellow - The 2nd last element is blue + The last element is green + The 2nd last element is yellow -=head2 Extra Methods +=head2 Extra RECNO Methods If you are using a version of Perl earlier than 5.004_57, the tied -array interface is quite limited. The example script above will work, -but you won't be able to use C, C, C, C -etc. with the tied array. +array interface is quite limited. In the example script above +C, C, C, C +or determining the array length will not work with a tied array. To make the interface more useful for older versions of Perl, a number of methods are supplied with B to simulate the missing array @@ -1657,7 +1785,7 @@ compile properly on IRIX 5.3. =head1 COPYRIGHT -Copyright (c) 1995-8 Paul Marquess. All rights reserved. This program +Copyright (c) 1995-9 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -1688,7 +1816,7 @@ L, L, L, L, L =head1 AUTHOR The DB_File interface was written by Paul Marquess -Epmarquess@bfsec.bt.co.ukE. +EPaul.Marquess@btinternet.comE. Questions about the DB system itself may be addressed to Edb@sleepycat.com. diff --git a/contrib/perl5/ext/DB_File/DB_File.xs b/contrib/perl5/ext/DB_File/DB_File.xs index c661023..94113eb 100644 --- a/contrib/perl5/ext/DB_File/DB_File.xs +++ b/contrib/perl5/ext/DB_File/DB_File.xs @@ -2,13 +2,13 @@ DB_File.xs -- Perl 5 interface to Berkeley DB - written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 16th May 1998 - version 1.60 + written by Paul Marquess + last modified 6th March 1999 + version 1.65 All comments/suggestions/problems are welcome - Copyright (c) 1995, 1996, 1997, 1998 Paul Marquess. All rights reserved. + Copyright (c) 1995-9 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -56,6 +56,15 @@ This was ok for DB 1.x, but isn't for DB 2.x. 1.59 - No change to DB_File.xs 1.60 - Some code tidy up + 1.61 - added flagSet macro for DB 2.5.x + fixed typo in O_RDONLY test. + 1.62 - No change to DB_File.xs + 1.63 - Fix to alllow DB 2.6.x to build. + 1.64 - Tidied up the 1.x to 2.x flags mapping code. + Added a patch from Mark Kettenis + to fix a flag mapping problem with O_RDONLY on the Hurd + 1.65 - Fixed a bug in the PUSH logic. + Added BOOT check that using 2.3.4 or greater @@ -65,6 +74,20 @@ #include "perl.h" #include "XSUB.h" +#ifndef PERL_VERSION +#include "patchlevel.h" +#define PERL_REVISION 5 +#define PERL_VERSION PATCHLEVEL +#define PERL_SUBVERSION SUBVERSION +#endif + +#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 )) + +# define PL_sv_undef sv_undef +# define PL_na na + +#endif + /* Being the Berkeley DB we prefer the (which will be * shortly #included by the ) __attribute__ to the possibly * already defined __attribute__, for example by GNUC or by Perl. */ @@ -153,6 +176,12 @@ typedef db_recno_t recno_t; #define DBT_flags(x) x.flags = 0 #define DB_flags(x, v) x |= v +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 +#define flagSet(flags, bitmask) ((flags) & (bitmask)) +#else +#define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask)) +#endif + #else /* db version 1.x */ typedef union INFO { @@ -205,6 +234,7 @@ typedef union INFO { #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag) #define DBT_flags(x) #define DB_flags(x, v) +#define flagSet(flags, bitmask) ((flags) & (bitmask)) #endif /* db version 1 */ @@ -216,10 +246,11 @@ typedef union INFO { #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags) #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) + #ifdef DB_VERSION_MAJOR #define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0) #define db_close(db) ((db->dbp)->close)(db->dbp, 0) -#define db_del(db, key, flags) ((flags & R_CURSOR) \ +#define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \ ? ((db->cursor)->c_del)(db->cursor, 0) \ : ((db->dbp)->del)(db->dbp, NULL, &key, flags) ) @@ -232,6 +263,7 @@ typedef union INFO { #endif + #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags) typedef struct { @@ -288,12 +320,17 @@ u_int flags ; { int status ; - if (flags & R_CURSOR) { + if (flagSet(flags, R_CURSOR)) { status = ((db->cursor)->c_del)(db->cursor, 0); if (status != 0) return status ; +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 flags &= ~R_CURSOR ; +#else + flags &= ~DB_OPFLAGS_MASK ; +#endif + } return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ; @@ -311,12 +348,12 @@ GetVersionInfo() (void)db_version(&Major, &Minor, &Patch) ; - /* check that libdb is recent enough */ - if (Major == 2 && Minor == 0 && Patch < 5) - croak("DB_File needs Berkeley DB 2.0.5 or greater, you have %d.%d.%d\n", + /* check that libdb is recent enough -- we need 2.3.4 or greater */ + if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4))) + croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n", Major, Minor, Patch) ; -#if PATCHLEVEL > 3 +#if PERL_VERSION > 3 sv_setpvf(ver_sv, "%d.%d", Major, Minor) ; #else { @@ -577,6 +614,7 @@ SV * sv ; DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; void * openinfo = NULL ; INFO * info = &RETVAL->info ; + STRLEN n_a; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ Zero(RETVAL, 1, DB_File_type) ; @@ -718,11 +756,11 @@ SV * sv ; #endif svp = hv_fetch(action, "bfname", 6, FALSE); if (svp && SvOK(*svp)) { - char * ptr = SvPV(*svp,PL_na) ; + char * ptr = SvPV(*svp,n_a) ; #ifdef DB_VERSION_MAJOR - name = (char*) PL_na ? ptr : NULL ; + name = (char*) n_a ? ptr : NULL ; #else - info->db_RE_bfname = (char*) (PL_na ? ptr : NULL) ; + info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ; #endif } else @@ -738,7 +776,7 @@ SV * sv ; { int value ; if (SvPOK(*svp)) - value = (int)*SvPV(*svp, PL_na) ; + value = (int)*SvPV(*svp, n_a) ; else value = SvIV(*svp) ; @@ -756,7 +794,7 @@ SV * sv ; if (svp && SvOK(*svp)) { if (SvPOK(*svp)) - info->db_RE_bval = (u_char)*SvPV(*svp, PL_na) ; + info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ; else info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ; DB_flags(info->flags, DB_DELIMITER) ; @@ -800,26 +838,26 @@ SV * sv ; if ((flags & O_CREAT) == O_CREAT) Flags |= DB_CREATE ; -#ifdef O_NONBLOCK - if ((flags & O_NONBLOCK) == O_NONBLOCK) - Flags |= DB_EXCL ; -#endif - #if O_RDONLY == 0 if (flags == O_RDONLY) #else - if (flags & O_RDONLY) == O_RDONLY) + if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR) #endif Flags |= DB_RDONLY ; -#ifdef O_NONBLOCK +#ifdef O_TRUNC if ((flags & O_TRUNC) == O_TRUNC) Flags |= DB_TRUNCATE ; #endif status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ; if (status == 0) +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ; +#else + status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, + 0) ; +#endif if (status) RETVAL->dbp = NULL ; @@ -1100,9 +1138,10 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H { char * name = (char *) NULL ; SV * sv = (SV *) NULL ; + STRLEN n_a; if (items >= 3 && SvOK(ST(2))) - name = (char*) SvPV(ST(2), PL_na) ; + name = (char*) SvPV(ST(2), n_a) ; if (items == 6) sv = ST(5) ; @@ -1191,7 +1230,6 @@ db_FIRSTKEY(db) { DBTKEY key ; DBT value ; - DB * Db = db->dbp ; DBT_flags(key) ; DBT_flags(value) ; @@ -1208,7 +1246,6 @@ db_NEXTKEY(db, key) CODE: { DBT value ; - DB * Db = db->dbp ; DBT_flags(value) ; CurrentDB = db ; @@ -1232,6 +1269,7 @@ unshift(db, ...) int i ; int One ; DB * Db = db->dbp ; + STRLEN n_a; DBT_flags(key) ; DBT_flags(value) ; @@ -1245,8 +1283,8 @@ unshift(db, ...) #endif for (i = items-1 ; i > 0 ; --i) { - value.data = SvPV(ST(i), PL_na) ; - value.size = PL_na ; + value.data = SvPV(ST(i), n_a) ; + value.size = n_a ; One = 1 ; key.data = &One ; key.size = sizeof(int) ; @@ -1270,7 +1308,6 @@ pop(db) { DBTKEY key ; DBT value ; - DB * Db = db->dbp ; DBT_flags(key) ; DBT_flags(value) ; @@ -1298,7 +1335,6 @@ shift(db) { DBT value ; DBTKEY key ; - DB * Db = db->dbp ; DBT_flags(key) ; DBT_flags(value) ; @@ -1325,42 +1361,42 @@ push(db, ...) CODE: { DBTKEY key ; - DBTKEY * keyptr = &key ; DBT value ; DB * Db = db->dbp ; int i ; + STRLEN n_a; DBT_flags(key) ; DBT_flags(value) ; CurrentDB = db ; - /* Set the Cursor to the Last element */ - RETVAL = do_SEQ(db, key, value, R_LAST) ; - if (RETVAL >= 0) - { - if (RETVAL == 1) - keyptr = &empty ; #ifdef DB_VERSION_MAJOR + RETVAL = 0 ; + key = empty ; for (i = 1 ; i < items ; ++i) { - - ++ (* (int*)key.data) ; - value.data = SvPV(ST(i), PL_na) ; - value.size = PL_na ; - RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ; + value.data = SvPV(ST(i), n_a) ; + value.size = n_a ; + RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ; if (RETVAL != 0) break; } #else + /* Set the Cursor to the Last element */ + RETVAL = do_SEQ(db, key, value, R_LAST) ; + if (RETVAL >= 0) + { + if (RETVAL == 1) + key = empty ; for (i = items - 1 ; i > 0 ; --i) { - value.data = SvPV(ST(i), PL_na) ; - value.size = PL_na ; - RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ; + value.data = SvPV(ST(i), n_a) ; + value.size = n_a ; + RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ; if (RETVAL != 0) break; } -#endif } +#endif } OUTPUT: RETVAL @@ -1436,7 +1472,7 @@ db_put(db, key, value, flags=0) #endif OUTPUT: RETVAL - key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key); + key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key); int db_fd(db) diff --git a/contrib/perl5/ext/DB_File/Makefile.PL b/contrib/perl5/ext/DB_File/Makefile.PL index dbe19f1..1a13e0b 100644 --- a/contrib/perl5/ext/DB_File/Makefile.PL +++ b/contrib/perl5/ext/DB_File/Makefile.PL @@ -11,7 +11,7 @@ $LIB = "-llibdb" if $^O eq 'MSWin32' ; WriteMakefile( NAME => 'DB_File', LIBS => ["-L/usr/local/lib $LIB"], - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. #INC => '-I/usr/local/include', VERSION_FROM => 'DB_File.pm', XSPROTOARG => '-noprototypes', diff --git a/contrib/perl5/ext/DB_File/dbinfo b/contrib/perl5/ext/DB_File/dbinfo index 9640ba4..24a7944 100644 --- a/contrib/perl5/ext/DB_File/dbinfo +++ b/contrib/perl5/ext/DB_File/dbinfo @@ -3,7 +3,7 @@ # Name: dbinfo -- identify berkeley DB version used to create # a database file # -# Author: Paul Marquess +# Author: Paul Marquess # Version: 1.01 # Date 16th April 1998 # diff --git a/contrib/perl5/ext/DB_File/hints/dynixptx.pl b/contrib/perl5/ext/DB_File/hints/dynixptx.pl new file mode 100644 index 0000000..bb5ffa5 --- /dev/null +++ b/contrib/perl5/ext/DB_File/hints/dynixptx.pl @@ -0,0 +1,3 @@ +# Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug + +$self->{LIBS} = ['-lm -lc']; diff --git a/contrib/perl5/ext/DB_File/typemap b/contrib/perl5/ext/DB_File/typemap index 7af55ae..994ba27 100644 --- a/contrib/perl5/ext/DB_File/typemap +++ b/contrib/perl5/ext/DB_File/typemap @@ -1,8 +1,8 @@ # typemap for Perl 5 interface to Berkeley # -# written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 13th May 1998 -# version 1.59 +# written by Paul Marquess +# last modified 21st February 1999 +# version 1.65 # #################################### DB SECTION # diff --git a/contrib/perl5/ext/Data/Dumper/Changes b/contrib/perl5/ext/Data/Dumper/Changes index a164958..9a96eda 100644 --- a/contrib/perl5/ext/Data/Dumper/Changes +++ b/contrib/perl5/ext/Data/Dumper/Changes @@ -6,6 +6,24 @@ HISTORY - public release history for Data::Dumper =over 8 +=item 2.10 (31 Oct 1998) + +Bugfixes for dumping related undef values, globs, and better double +quoting: three patches suggested by Gisle Aas . + +Escaping of single quotes in the XS version could get tripped up +by the presence of nulls in the string. Fix suggested by +Slaven Rezic . + +Rather large scale reworking of the logic in how seen values +are stashed. Anonymous scalars that may be encountered while +traversing the structure are properly tracked, in case they become +used in data dumped in a later pass. There used to be a problem +with the previous logic that prevented such structures from being +dumped correctly. + +Various additions to the testsuite. + =item 2.09 (9 July 1998) Implement $Data::Dumper::Bless, suggested by Mark Daku . diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.pm b/contrib/perl5/ext/Data/Dumper/Dumper.pm index e3c361f..b1fd2b7 100644 --- a/contrib/perl5/ext/Data/Dumper/Dumper.pm +++ b/contrib/perl5/ext/Data/Dumper/Dumper.pm @@ -9,7 +9,7 @@ package Data::Dumper; -$VERSION = $VERSION = '2.09'; +$VERSION = $VERSION = '2.101'; #$| = 1; @@ -208,8 +208,6 @@ sub _dump { my($sname); my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad); - return "undef" unless defined $val; - $type = ref $val; $out = ""; @@ -218,47 +216,47 @@ sub _dump { # prep it, if it looks like an object if ($type =~ /[a-z_:]/) { my $freezer = $s->{freezer}; - # UNIVERSAL::can should be used here, when we can require 5.004 - if ($freezer) { - eval { $val->$freezer() }; - carp "WARNING(Freezer method call failed): $@" if $@; - } + $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer); } ($realpack, $realtype, $id) = (overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/); - # keep a tab on it so that we dont fall into recursive pit - if (exists $s->{seen}{$id}) { -# if ($s->{expdepth} < $s->{level}) { - if ($s->{purity} and $s->{level} > 0) { - $out = ($realtype eq 'HASH') ? '{}' : - ($realtype eq 'ARRAY') ? '[]' : - "''" ; - push @post, $name . " = " . $s->{seen}{$id}[0]; - } - else { - $out = $s->{seen}{$id}[0]; - if ($name =~ /^([\@\%])/) { - my $start = $1; - if ($out =~ /^\\$start/) { - $out = substr($out, 1); + # if it has a name, we need to either look it up, or keep a tab + # on it so we know when we hit it later + if (defined($name) and length($name)) { + # keep a tab on it so that we dont fall into recursive pit + if (exists $s->{seen}{$id}) { +# if ($s->{expdepth} < $s->{level}) { + if ($s->{purity} and $s->{level} > 0) { + $out = ($realtype eq 'HASH') ? '{}' : + ($realtype eq 'ARRAY') ? '[]' : + "''" ; + push @post, $name . " = " . $s->{seen}{$id}[0]; } else { - $out = $start . '{' . $out . '}'; - } - } + $out = $s->{seen}{$id}[0]; + if ($name =~ /^([\@\%])/) { + my $start = $1; + if ($out =~ /^\\$start/) { + $out = substr($out, 1); + } + else { + $out = $start . '{' . $out . '}'; + } + } + } + return $out; +# } + } + else { + # store our name + $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) : + ($realtype eq 'CODE' and + $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) : + $name ), + $val ]; } - return $out; -# } - } - else { - # store our name - $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) : - ($realtype eq 'CODE' and - $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) : - $name ), - $val ]; } $s->{level}++; @@ -272,14 +270,14 @@ sub _dump { if ($realtype eq 'SCALAR') { if ($realpack) { - $out .= 'do{\\(my $o = ' . $s->_dump($$val, "") . ')}'; + $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; } else { - $out .= '\\' . $s->_dump($$val, ""); + $out .= '\\' . $s->_dump($$val, "\${$name}"); } } elsif ($realtype eq 'GLOB') { - $out .= '\\' . $s->_dump($$val, ""); + $out .= '\\' . $s->_dump($$val, "*{$name}"); } elsif ($realtype eq 'ARRAY') { my($v, $pad, $mname); @@ -287,7 +285,9 @@ sub _dump { $out .= ($name =~ /^\@/) ? '(' : '['; $pad = $s->{sep} . $s->{pad} . $s->{apad}; ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : - ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->'); + # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} + ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : + ($mname = $name . '->'); $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; for $v (@$val) { $sname = $mname . '[' . $i . ']'; @@ -303,8 +303,10 @@ sub _dump { $out .= ($name =~ /^\%/) ? '(' : '{'; $pad = $s->{sep} . $s->{pad} . $s->{apad}; $lpad = $s->{apad}; - ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : - ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->'); + ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : + # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} + ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : + ($mname = $name . '->'); $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; while (($k, $v) = each %$val) { my $nk = $s->_dump($k, ""); @@ -324,8 +326,7 @@ sub _dump { $out .= ($name =~ /^\%/) ? ')' : '}'; } elsif ($realtype eq 'CODE') { - $out .= '"DUMMY"'; - $out = 'sub { ' . $out . ' }'; + $out .= 'sub { "DUMMY" }'; carp "Encountered CODE ref, using dummy placeholder" if $s->{purity}; } else { @@ -347,11 +348,15 @@ sub _dump { if ($name ne '') { ($id) = ("$ref" =~ /\(([^\(]*)\)$/); if (exists $s->{seen}{$id}) { - $out = $s->{seen}{$id}[0]; - return $out; + if ($s->{seen}{$id}[2]) { + $out = $s->{seen}{$id}[0]; + #warn "[<$out]\n"; + return "\${$out}"; + } } else { - $s->{seen}{$id} = ["\\$name", $val]; + #warn "[>\\$name]\n"; + $s->{seen}{$id} = ["\\$name", $ref]; } } if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob @@ -368,21 +373,28 @@ sub _dump { my $k; local ($s->{level}) = 0; for $k (qw(SCALAR ARRAY HASH)) { + my $gval = *$val{$k}; + next unless defined $gval; + next if $k eq "SCALAR" && ! defined $$gval; # always there + # _dump can push into @post, so we hold our place using $postlen my $postlen = scalar @post; $post[$postlen] = "\*$sname = "; local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2; - $post[$postlen] .= $s->_dump(*{$name}{$k}, "\*$sname\{$k\}"); + $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}"); } } $out .= '*' . $sname; } + elsif (!defined($val)) { + $out .= "undef"; + } elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number $out .= $val; } else { # string if ($s->{useqq}) { - $out .= qquote($val); + $out .= qquote($val, $s->{useqq}); } else { $val =~ s/([\\\'])/\\$1/g; @@ -390,10 +402,16 @@ sub _dump { } } } - - # if we made it this far, $id was added to seen list at current - # level, so remove it to get deep copies - delete($s->{seen}{$id}) if $id and $s->{deepcopy}; + if ($id) { + # if we made it this far, $id was added to seen list at current + # level, so remove it to get deep copies + if ($s->{deepcopy}) { + delete($s->{seen}{$id}); + } + elsif ($name) { + $s->{seen}{$id}[2] = 1; + } + } return $out; } @@ -493,22 +511,41 @@ sub Bless { defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'}; } +# used by qquote below +my %esc = ( + "\a" => "\\a", + "\b" => "\\b", + "\t" => "\\t", + "\n" => "\\n", + "\f" => "\\f", + "\r" => "\\r", + "\e" => "\\e", +); + # put a string value in double quotes sub qquote { local($_) = shift; - s/([\\\"\@\$\%])/\\$1/g; - s/\a/\\a/g; - s/[\b]/\\b/g; - s/\t/\\t/g; - s/\n/\\n/g; - s/\f/\\f/g; - s/\r/\\r/g; - s/\e/\\e/g; - -# this won't work! -# s/([^\a\b\t\n\f\r\e\038-\176])/'\\'.sprintf('%03o',ord($1))/eg; - s/([\000-\006\013\016-\032\034-\037\177\200-\377])/'\\'.sprintf('%03o',ord($1))/eg; - return "\"$_\""; + s/([\\\"\@\$])/\\$1/g; + return qq("$_") unless /[^\040-\176]/; # fast exit + + my $high = shift || ""; + s/([\a\b\t\n\f\r\e])/$esc{$1}/g; + + # no need for 3 digits in escape for these + s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg; + + s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg; + if ($high eq "iso8859") { + s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; + } elsif ($high eq "utf8") { +# use utf8; +# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; + } elsif ($high eq "8bit") { + # leave it as it is + } else { + s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg; + } + return qq("$_"); } 1; @@ -954,7 +991,7 @@ modify it under the same terms as Perl itself. =head1 VERSION -Version 2.09 (9 July 1998) +Version 2.10 (31 Oct 1998) =head1 SEE ALSO diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.xs b/contrib/perl5/ext/Data/Dumper/Dumper.xs index d8012ee..a3da110 100644 --- a/contrib/perl5/ext/Data/Dumper/Dumper.xs +++ b/contrib/perl5/ext/Data/Dumper/Dumper.xs @@ -2,8 +2,19 @@ #include "perl.h" #include "XSUB.h" -static SV *freezer; -static SV *toaster; +#include "patchlevel.h" + +#if PATCHLEVEL < 5 +# ifndef PL_sv_undef +# define PL_sv_undef sv_undef +# endif +# ifndef ERRSV +# define ERRSV GvSV(errgv) +# endif +# ifndef newSVpvn +# define newSVpvn newSVpv +# endif +#endif static I32 num_q _((char *s, STRLEN slen)); static I32 esc_q _((char *dest, char *src, STRLEN slen)); @@ -84,7 +95,7 @@ static SV * sv_x(SV *sv, register char *str, STRLEN len, I32 n) { if (sv == Nullsv) - sv = newSVpv("", 0); + sv = newSVpvn("", 0); else assert(SvTYPE(sv) >= SVt_PV); @@ -121,11 +132,9 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, U32 i; char *c, *r, *realpack, id[128]; SV **svp; - SV *sv; + SV *sv, *ipad, *ival; SV *blesspad = Nullsv; - SV *ipad; - SV *ival; - AV *seenentry; + AV *seenentry = Nullav; char *iname; STRLEN inamelen, idlen = 0; U32 flags; @@ -139,10 +148,6 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, if (SvGMAGICAL(val)) mg_get(val); - if (val == &PL_sv_undef || !SvOK(val)) { - sv_catpvn(retval, "undef", 5); - return 1; - } if (SvROK(val)) { if (SvOBJECT(SvRV(val)) && freezer && @@ -152,9 +157,9 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, XPUSHs(val); PUTBACK; i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR); SPAGAIN; - if (SvTRUE(GvSV(PL_errgv))) + if (SvTRUE(ERRSV)) warn("WARNING(Freezer method call failed): %s", - SvPVX(GvSV(PL_errgv))); + SvPVX(ERRSV)); else if (i) val = newSVsv(POPs); PUTBACK; FREETMPS; LEAVE; @@ -171,67 +176,77 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, realpack = HvNAME(SvSTASH(ival)); else realpack = Nullch; - if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) && - (sv = *svp) && SvROK(sv) && - (seenentry = (AV*)SvRV(sv))) { - SV *othername; - if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) { - if (purity && *levelp > 0) { - SV *postentry; - - if (realtype == SVt_PVHV) - sv_catpvn(retval, "{}", 2); - else if (realtype == SVt_PVAV) - sv_catpvn(retval, "[]", 2); - else - sv_catpvn(retval, "''", 2); - postentry = newSVpv(name, namelen); - sv_catpvn(postentry, " = ", 3); - sv_catsv(postentry, othername); - av_push(postav, postentry); - } - else { - if (name[0] == '@' || name[0] == '%') { - if ((SvPVX(othername))[0] == '\\' && - (SvPVX(othername))[1] == name[0]) { - sv_catpvn(retval, SvPVX(othername)+1, SvCUR(othername)-1); + + /* if it has a name, we need to either look it up, or keep a tab + * on it so we know when we hit it later + */ + if (namelen) { + if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) + && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv))) + { + SV *othername; + if ((svp = av_fetch(seenentry, 0, FALSE)) + && (othername = *svp)) + { + if (purity && *levelp > 0) { + SV *postentry; + + if (realtype == SVt_PVHV) + sv_catpvn(retval, "{}", 2); + else if (realtype == SVt_PVAV) + sv_catpvn(retval, "[]", 2); + else + sv_catpvn(retval, "''", 2); + postentry = newSVpvn(name, namelen); + sv_catpvn(postentry, " = ", 3); + sv_catsv(postentry, othername); + av_push(postav, postentry); + } + else { + if (name[0] == '@' || name[0] == '%') { + if ((SvPVX(othername))[0] == '\\' && + (SvPVX(othername))[1] == name[0]) { + sv_catpvn(retval, SvPVX(othername)+1, + SvCUR(othername)-1); + } + else { + sv_catpvn(retval, name, 1); + sv_catpvn(retval, "{", 1); + sv_catsv(retval, othername); + sv_catpvn(retval, "}", 1); + } } - else { - sv_catpvn(retval, name, 1); - sv_catpvn(retval, "{", 1); + else sv_catsv(retval, othername); - sv_catpvn(retval, "}", 1); - } } - else - sv_catsv(retval, othername); + return 1; + } + else { + warn("ref name not found for %s", id); + return 0; } - return 1; - } - else { - warn("ref name not found for %s", id); - return 0; - } - } - else { /* store our name and continue */ - SV *namesv; - if (name[0] == '@' || name[0] == '%') { - namesv = newSVpv("\\", 1); - sv_catpvn(namesv, name, namelen); } - else if (realtype == SVt_PVCV && name[0] == '*') { - namesv = newSVpv("\\", 2); - sv_catpvn(namesv, name, namelen); - (SvPVX(namesv))[1] = '&'; + else { /* store our name and continue */ + SV *namesv; + if (name[0] == '@' || name[0] == '%') { + namesv = newSVpvn("\\", 1); + sv_catpvn(namesv, name, namelen); + } + else if (realtype == SVt_PVCV && name[0] == '*') { + namesv = newSVpvn("\\", 2); + sv_catpvn(namesv, name, namelen); + (SvPVX(namesv))[1] = '&'; + } + else + namesv = newSVpvn(name, namelen); + seenentry = newAV(); + av_push(seenentry, namesv); + (void)SvREFCNT_inc(val); + av_push(seenentry, val); + (void)hv_store(seenhv, id, strlen(id), + newRV((SV*)seenentry), 0); + SvREFCNT_dec(seenentry); } - else - namesv = newSVpv(name, namelen); - seenentry = newAV(); - av_push(seenentry, namesv); - (void)SvREFCNT_inc(val); - av_push(seenentry, val); - (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0); - SvREFCNT_dec(seenentry); } (*levelp)++; @@ -249,20 +264,34 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, } } - if (realtype <= SVt_PVBM || realtype == SVt_PVGV) { /* scalars */ - if (realpack && realtype != SVt_PVGV) { /* blessed */ + if (realtype <= SVt_PVBM) { /* scalar ref */ + SV *namesv = newSVpvn("${", 2); + sv_catpvn(namesv, name, namelen); + sv_catpvn(namesv, "}", 1); + if (realpack) { /* blessed */ sv_catpvn(retval, "do{\\(my $o = ", 13); - DD_dump(ival, "", 0, retval, seenhv, postav, - levelp, indent, pad, xpad, apad, sep, + DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv, + postav, levelp, indent, pad, xpad, apad, sep, freezer, toaster, purity, deepcopy, quotekeys, bless); sv_catpvn(retval, ")}", 2); - } + } /* plain */ else { sv_catpvn(retval, "\\", 1); - DD_dump(ival, "", 0, retval, seenhv, postav, - levelp, indent, pad, xpad, apad, sep, + DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv, + postav, levelp, indent, pad, xpad, apad, sep, freezer, toaster, purity, deepcopy, quotekeys, bless); } + SvREFCNT_dec(namesv); + } + else if (realtype == SVt_PVGV) { /* glob ref */ + SV *namesv = newSVpvn("*{", 2); + sv_catpvn(namesv, name, namelen); + sv_catpvn(namesv, "}", 1); + sv_catpvn(retval, "\\", 1); + DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv, + postav, levelp, indent, pad, xpad, apad, sep, + freezer, toaster, purity, deepcopy, quotekeys, bless); + SvREFCNT_dec(namesv); } else if (realtype == SVt_PVAV) { SV *totpad; @@ -280,7 +309,16 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, } else { sv_catpvn(retval, "[", 1); - if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') { + /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */ + /*if (namelen > 0 + && name[namelen-1] != ']' && name[namelen-1] != '}' + && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/ + if ((namelen > 0 + && name[namelen-1] != ']' && name[namelen-1] != '}') + || (namelen > 4 + && (name[1] == '{' + || (name[0] == '\\' && name[2] == '{')))) + { iname[inamelen++] = '-'; iname[inamelen++] = '>'; iname[inamelen] = '\0'; } @@ -346,14 +384,20 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, I32 klen; SV *hval; - iname = newSVpv(name, namelen); + iname = newSVpvn(name, namelen); if (name[0] == '%') { sv_catpvn(retval, "(", 1); (SvPVX(iname))[0] = '$'; } else { sv_catpvn(retval, "{", 1); - if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') { + /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */ + if ((namelen > 0 + && name[namelen-1] != ']' && name[namelen-1] != '}') + || (namelen > 4 + && (name[1] == '{' + || (name[0] == '\\' && name[2] == '{')))) + { sv_catpvn(iname, "->", 2); } } @@ -472,33 +516,36 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, (void) sprintf(id, "0x%lx", (unsigned long)val); if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) && (sv = *svp) && SvROK(sv) && - (seenentry = (AV*)SvRV(sv))) { + (seenentry = (AV*)SvRV(sv))) + { SV *othername; - if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) { + if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp) + && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0) + { + sv_catpvn(retval, "${", 2); sv_catsv(retval, othername); + sv_catpvn(retval, "}", 1); return 1; } } else { SV *namesv; - namesv = newSVpv("\\", 1); + namesv = newSVpvn("\\", 1); sv_catpvn(namesv, name, namelen); seenentry = newAV(); av_push(seenentry, namesv); - (void)SvREFCNT_inc(val); - av_push(seenentry, val); + av_push(seenentry, newRV(val)); (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0); SvREFCNT_dec(seenentry); } } - + if (SvIOK(val)) { STRLEN len; i = SvIV(val); (void) sprintf(tmpbuf, "%d", i); len = strlen(tmpbuf); sv_catpvn(retval, tmpbuf, len); - return 1; } else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */ c = SvPV(val, i); @@ -522,21 +569,27 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, r[0] = '*'; strcpy(r+1, c); i++; } + SvCUR_set(retval, SvCUR(retval)+i); if (purity) { static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" }; static STRLEN sizes[] = { 8, 7, 6 }; SV *e; - SV *nname = newSVpv("", 0); - SV *newapad = newSVpv("", 0); + SV *nname = newSVpvn("", 0); + SV *newapad = newSVpvn("", 0); GV *gv = (GV*)val; I32 j; for (j=0; j<3; j++) { e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv)); - if (e) { + if (!e) + continue; + if (j == 0 && !SvOK(e)) + continue; + + { I32 nlevel = 0; - SV *postentry = newSVpv(r,i); + SV *postentry = newSVpvn(r,i); sv_setsv(nname, postentry); sv_catpvn(nname, entries[j], sizes[j]); @@ -560,6 +613,9 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, SvREFCNT_dec(nname); } } + else if (val == &PL_sv_undef || !SvOK(val)) { + sv_catpvn(retval, "undef", 5); + } else { c = SvPV(val, i); sv_grow(retval, SvCUR(retval)+3+2*i); @@ -569,13 +625,18 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, ++i; r[i++] = '\''; r[i] = '\0'; + SvCUR_set(retval, SvCUR(retval)+i); } - SvCUR_set(retval, SvCUR(retval)+i); } - if (deepcopy && idlen) - (void)hv_delete(seenhv, id, idlen, G_DISCARD); - + if (idlen) { + if (deepcopy) + (void)hv_delete(seenhv, id, idlen, G_DISCARD); + else if (namelen && seenentry) { + SV *mark = *av_fetch(seenentry, 2, TRUE); + sv_setiv(mark,1); + } + } return 1; } @@ -647,7 +708,7 @@ Data_Dumper_Dumpxs(href, ...) terse = useqq = purity = deepcopy = 0; quotekeys = 1; - retval = newSVpv("", 0); + retval = newSVpvn("", 0); if (SvROK(href) && (hv = (HV*)SvRV((SV*)href)) && SvTYPE(hv) == SVt_PVHV) { @@ -692,7 +753,7 @@ Data_Dumper_Dumpxs(href, ...) imax = av_len(todumpav); else imax = -1; - valstr = newSVpv("",0); + valstr = newSVpvn("",0); for (i = 0; i <= imax; ++i) { SV *newapad; @@ -787,7 +848,7 @@ Data_Dumper_Dumpxs(href, ...) if (gimme == G_ARRAY) { XPUSHs(sv_2mortal(retval)); if (i < imax) /* not the last time thro ? */ - retval = newSVpv("",0); + retval = newSVpvn("",0); } } SvREFCNT_dec(postav); diff --git a/contrib/perl5/ext/Data/Dumper/Makefile.PL b/contrib/perl5/ext/Data/Dumper/Makefile.PL index 6c94e95d..12930c5 100644 --- a/contrib/perl5/ext/Data/Dumper/Makefile.PL +++ b/contrib/perl5/ext/Data/Dumper/Makefile.PL @@ -7,5 +7,5 @@ WriteMakefile( SUFFIX => 'gz', DIST_DEFAULT => 'all tardist', }, - MAN3PODS => ' ', + MAN3PODS => {}, ); diff --git a/contrib/perl5/ext/Data/Dumper/Todo b/contrib/perl5/ext/Data/Dumper/Todo index 4a41f97..7dcd40b 100644 --- a/contrib/perl5/ext/Data/Dumper/Todo +++ b/contrib/perl5/ext/Data/Dumper/Todo @@ -29,4 +29,6 @@ where we don't care so much for cross-references). =item Implement redesign that allows various backends (Perl, Lisp, some-binary-data-format, graph-description-languages, etc.) +=item Dump traversal in breadth-first order + =back diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL index 4c41559..cf7d708 100644 --- a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL +++ b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL @@ -101,7 +101,8 @@ push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH})) # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. -boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader); +boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && + !defined(&dl_load_file); if ($dl_debug) { diff --git a/contrib/perl5/ext/DynaLoader/Makefile.PL b/contrib/perl5/ext/DynaLoader/Makefile.PL index 7a75115..2141fde 100644 --- a/contrib/perl5/ext/DynaLoader/Makefile.PL +++ b/contrib/perl5/ext/DynaLoader/Makefile.PL @@ -4,7 +4,7 @@ WriteMakefile( NAME => 'DynaLoader', LINKTYPE => 'static', DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'DynaLoader_pm.PL', diff --git a/contrib/perl5/ext/DynaLoader/dl_beos.xs b/contrib/perl5/ext/DynaLoader/dl_beos.xs new file mode 100644 index 0000000..42a27cb --- /dev/null +++ b/contrib/perl5/ext/DynaLoader/dl_beos.xs @@ -0,0 +1,115 @@ +/* + * dl_beos.xs, by Tom Spindler + * based on dl_dlopen.xs, by Paul Marquess + * $Id:$ + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include +#include +#include +#include + +#define dlerror() strerror(errno) + +#include "dlutils.c" /* SaveError() etc */ + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +void * +dl_load_file(filename, flags=0) + char * filename + int flags + CODE: +{ image_id bogo; + char *path; + path = malloc(PATH_MAX); + if (*filename != '/') { + getcwd(path, PATH_MAX); + strcat(path, "/"); + strcat(path, filename); + } else { + strcpy(path, filename); + } + + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags)); + bogo = load_add_on(path); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); + ST(0) = sv_newmortal() ; + if (bogo < 0) { + SaveError("%s", strerror(bogo)); + PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); + } else { + RETVAL = (void *) bogo; + sv_setiv( ST(0), (IV)RETVAL); + } + free(path); +} + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: + status_t retcode; + void *adr = 0; +#ifdef DLSYM_NEEDS_UNDERSCORE + symbolname = form("_%s", symbolname); +#endif + RETVAL = NULL; + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + "dl_find_symbol(handle=%lx, symbol=%s)\n", + (unsigned long) libhandle, symbolname)); + retcode = get_image_symbol((image_id) libhandle, symbolname, + B_SYMBOL_TYPE_TEXT, (void **) &adr); + RETVAL = adr; + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + " symbolref = %lx\n", (unsigned long) RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) { + SaveError("%s", strerror(retcode)) ; + PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode)); + } else + sv_setiv( ST(0), (IV)RETVAL); + + +void +dl_undef_symbols() + PPCODE: + + + +# These functions should not need changing on any platform: + +void +dl_install_xsub(perl_name, symref, filename="$Package") + char * perl_name + void * symref + char * filename + CODE: + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", + perl_name, (unsigned long) symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs index 2b75637..b64ab3e 100644 --- a/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs +++ b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs @@ -82,11 +82,11 @@ dl_load_file(filename,flags=0) int flags PREINIT: CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL){ SaveError("%d",GetLastError()) ; @@ -113,10 +113,10 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%d",GetLastError()) ; @@ -138,7 +138,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs index 808c3b0..4cc07ec 100644 --- a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs +++ b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs @@ -2,6 +2,7 @@ * Author: Mark Klein (mklein@dis.com) * Version: 2.1, 1996/07/25 * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu) + * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu) */ #include "EXTERN.h" @@ -59,13 +60,13 @@ flags)); ",filename); obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld)); memzero(obj, sizeof(t_mpe_dld)); - if (filename[0] == '.') + if (filename[0] != '/') { getcwd(buf,sizeof(buf)); - sprintf(obj->filename,"$%s/%s$",buf,filename); + sprintf(obj->filename," %s/%s ",buf,filename); } else - sprintf(obj->filename,"$%s$",filename); + sprintf(obj->filename," %s ",filename); DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj)); @@ -90,11 +91,11 @@ dl_find_symbol(libhandle, symbolname) ST(0) = sv_newmortal() ; errno = 0; - sprintf(symname, "$%s$", symbolname); + sprintf(symname, " %s ", symbolname); HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1, 0, &datalen, 1, 0, 0); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x\n", symaddr)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); if (status != 0) { SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ; diff --git a/contrib/perl5/ext/DynaLoader/dl_next.xs b/contrib/perl5/ext/DynaLoader/dl_next.xs index 2b547f0..dfa8a3e 100644 --- a/contrib/perl5/ext/DynaLoader/dl_next.xs +++ b/contrib/perl5/ext/DynaLoader/dl_next.xs @@ -172,6 +172,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) I32 i, psize; char *result; char **p; + STRLEN n_a; /* Do not load what is already loaded into this process */ if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) @@ -182,7 +183,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) p = (char **) safemalloc(psize * sizeof(char*)); p[0] = path; for(i=1; icatfile(File::Spec->updir, + File::Spec->updir, + "cppstdin"); + my $cppstdin_is_wrapper = + ($cppstdin eq 'cppstdin' + and -f $upup_cppstdin + and -x $upup_cppstdin); + $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper; + } + return "$cppstdin $Config{cppflags} $Config{cppminus}"; +} + sub get_files { my %file = (); # VMS keeps its include files in system libraries (well, except for Gcc) @@ -56,6 +76,9 @@ sub get_files { } elsif ($^O eq 'os390') { # OS/390 C compiler doesn't generate #file or #line directives $file{'/usr/include/errno.h'} = 1; + } elsif ($^O eq 'vmesa') { + # OS/390 C compiler doesn't generate #file or #line directives + $file{'../../vmesa/errno.h'} = 1; } else { open(CPPI,"> errno.c") or die "Cannot open errno.c"; @@ -65,9 +88,14 @@ sub get_files { close(CPPI); # invoke CPP and read the output - - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot exec $Config{cpprun}"; + if ($^O eq 'MSWin32') { + open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or + die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + } else { + my $cpp = default_cpp(); + open(CPPO,"$cpp < errno.c |") or + die "Cannot exec $cpp"; + } my $pat; if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) { @@ -77,7 +105,16 @@ sub get_files { $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"'; } while() { - $file{$1} = 1 if /$pat/o; + if ($^O eq 'os2' or $^O eq 'MSWin32') { + if (/$pat/o) { + my $f = $1; + $f =~ s,\\\\,/,g; + $file{$f} = 1; + } + } + else { + $file{$1} = 1 if /$pat/o; + } } close(CPPO); } @@ -87,6 +124,10 @@ sub get_files { sub write_errno_pm { my $err; + # quick sanity check + + die "No error definitions found" unless keys %err; + # create the CPP input open(CPPI,"> errno.c") or @@ -107,14 +148,13 @@ sub write_errno_pm { $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; - } elsif(!$Config{'cpprun'} or $^O eq 'next') { - # NeXT will do syntax checking unless it is reading from stdin - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + } elsif ($^O eq 'MSWin32') { + open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or + die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + } else { + my $cpp = default_cpp(); open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; - } else { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot exec $Config{cpprun}"; } %err = (); diff --git a/contrib/perl5/ext/Errno/Makefile.PL b/contrib/perl5/ext/Errno/Makefile.PL index ffc8c4b..604d4fb 100644 --- a/contrib/perl5/ext/Errno/Makefile.PL +++ b/contrib/perl5/ext/Errno/Makefile.PL @@ -1,10 +1,11 @@ use ExtUtils::MakeMaker; -@VMS = ($^O eq 'VMS') ? (MAN3PODS => ' ') : (); +@VMS = ($^O eq 'VMS') ? (MAN3PODS => {}) : (); WriteMakefile( NAME => 'Errno', VERSION_FROM => 'Errno_pm.PL', + MAN3PODS => {}, # Pods will be built by installman. PL_FILES => {'Errno_pm.PL'=>'Errno.pm'}, PM => {'Errno.pm' => '$(INST_LIBDIR)/Errno.pm'}, 'clean' => {FILES => 'Errno.pm'}, diff --git a/contrib/perl5/ext/Fcntl/Makefile.PL b/contrib/perl5/ext/Fcntl/Makefile.PL index 66a6df6..0346373 100644 --- a/contrib/perl5/ext/Fcntl/Makefile.PL +++ b/contrib/perl5/ext/Fcntl/Makefile.PL @@ -1,7 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Fcntl', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'Fcntl.pm', ); diff --git a/contrib/perl5/ext/GDBM_File/Makefile.PL b/contrib/perl5/ext/GDBM_File/Makefile.PL index d244613..2a7256f 100644 --- a/contrib/perl5/ext/GDBM_File/Makefile.PL +++ b/contrib/perl5/ext/GDBM_File/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'GDBM_File', LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"], - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'GDBM_File.pm', ); diff --git a/contrib/perl5/ext/GDBM_File/hints/sco.pl b/contrib/perl5/ext/GDBM_File/hints/sco.pl new file mode 100644 index 0000000..5c74a77 --- /dev/null +++ b/contrib/perl5/ext/GDBM_File/hints/sco.pl @@ -0,0 +1,2 @@ +# SCO OSR5 needs to link with libc.so again to have C defined +$self->{LIBS} = ['-lgdbm -lc']; diff --git a/contrib/perl5/ext/IO/IO.xs b/contrib/perl5/ext/IO/IO.xs index a434cca..300581e 100644 --- a/contrib/perl5/ext/IO/IO.xs +++ b/contrib/perl5/ext/IO/IO.xs @@ -111,7 +111,8 @@ fsetpos(handle, pos) SV * pos CODE: char *p; - if (handle && (p = SvPVx(pos, PL_na)) && PL_na == sizeof(Fpos_t)) + STRLEN n_a; + if (handle && (p = SvPVx(pos, n_a)) && n_a == sizeof(Fpos_t)) #ifdef PerlIO RETVAL = PerlIO_setpos(handle, (Fpos_t*)p); #else diff --git a/contrib/perl5/ext/IO/Makefile.PL b/contrib/perl5/ext/IO/Makefile.PL index 4a34be6..6a2d50d 100644 --- a/contrib/perl5/ext/IO/Makefile.PL +++ b/contrib/perl5/ext/IO/Makefile.PL @@ -1,7 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'IO', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'lib/IO/Handle.pm', XS_VERSION => 1.15 diff --git a/contrib/perl5/ext/IO/lib/IO/Pipe.pm b/contrib/perl5/ext/IO/lib/IO/Pipe.pm index ae6d9a5..23c51b0 100644 --- a/contrib/perl5/ext/IO/lib/IO/Pipe.pm +++ b/contrib/perl5/ext/IO/lib/IO/Pipe.pm @@ -14,7 +14,7 @@ use vars qw($VERSION); use Carp; use Symbol; -$VERSION = "1.0901"; +$VERSION = "1.0902"; sub new { my $type = shift; @@ -96,7 +96,7 @@ sub reader { close ${*$me}[1]; bless $me, ref($fh); - *{*$me} = *{*$fh}; # Alias self to handle + *$me = *$fh; # Alias self to handle bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; @@ -113,7 +113,7 @@ sub writer { close ${*$me}[0]; bless $me, ref($fh); - *{*$me} = *{*$fh}; # Alias self to handle + *$me = *$fh; # Alias self to handle bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; @@ -177,10 +177,10 @@ IO::pipe - supply object methods for pipes =head1 DESCRIPTION -C provides an interface to createing pipes between +C provides an interface to creating pipes between processes. -=head1 CONSTRCUTOR +=head1 CONSTRUCTOR =over 4 diff --git a/contrib/perl5/ext/IO/lib/IO/Seekable.pm b/contrib/perl5/ext/IO/lib/IO/Seekable.pm index 91c381a..86154c5 100644 --- a/contrib/perl5/ext/IO/lib/IO/Seekable.pm +++ b/contrib/perl5/ext/IO/lib/IO/Seekable.pm @@ -14,7 +14,7 @@ IO::Seekable - supply seek based methods for I/O objects =head1 DESCRIPTION -C does not have a constuctor of its own as is intended to +C does not have a constructor of its own as it is intended to be inherited by other C based objects. It provides methods which allow seeking of the file descriptors. diff --git a/contrib/perl5/ext/IO/lib/IO/Socket.pm b/contrib/perl5/ext/IO/lib/IO/Socket.pm index 406f74d..2b4bc49 100644 --- a/contrib/perl5/ext/IO/lib/IO/Socket.pm +++ b/contrib/perl5/ext/IO/lib/IO/Socket.pm @@ -664,7 +664,7 @@ Returns the pathname to the fifo at the local end =item peerpath() -Returns the pathanme to the fifo at the peer end +Returns the pathname to the fifo at the peer end =back diff --git a/contrib/perl5/ext/IPC/SysV/Makefile.PL b/contrib/perl5/ext/IPC/SysV/Makefile.PL index c8e320f..60dd74d 100644 --- a/contrib/perl5/ext/IPC/SysV/Makefile.PL +++ b/contrib/perl5/ext/IPC/SysV/Makefile.PL @@ -22,6 +22,7 @@ sub MY::libscan WriteMakefile( VERSION_FROM => "SysV.pm", NAME => "IPC::SysV", + MAN3PODS => {}, # Pods will be built by installman. 'dist' => {COMPRESS => 'gzip -9f', SUFFIX => 'gz', diff --git a/contrib/perl5/ext/IPC/SysV/Msg.pm b/contrib/perl5/ext/IPC/SysV/Msg.pm index 93d2ae1..a739ca2 100644 --- a/contrib/perl5/ext/IPC/SysV/Msg.pm +++ b/contrib/perl5/ext/IPC/SysV/Msg.pm @@ -84,7 +84,7 @@ sub remove { } sub rcv { - @_ == 5 || croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; + @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; my $self = shift; my $buf = ""; msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or @@ -95,7 +95,7 @@ sub rcv { } sub snd { - @_ == 4 || croak '$msg->snd( TYPE, BUF, FLAGS )'; + @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )'; my $self = shift; msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0); } diff --git a/contrib/perl5/ext/IPC/SysV/SysV.xs b/contrib/perl5/ext/IPC/SysV/SysV.xs index 0fbf783..ecd5270 100644 --- a/contrib/perl5/ext/IPC/SysV/SysV.xs +++ b/contrib/perl5/ext/IPC/SysV/SysV.xs @@ -4,32 +4,52 @@ #include #ifdef __linux__ -#include +# include #endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) -#include -#ifdef HAS_MSG -#include -#endif -#ifdef HAS_SEM -#include -#endif -#ifdef HAS_SHM -#if defined(PERL_SCO5) || defined(PERL_ISC) -#include -#endif -#include -# ifndef HAS_SHMAT_PROTOTYPE - extern Shmat_t shmat _((int, char *, int)); -# endif +#ifndef HAS_SEM +# include +#endif +# ifdef HAS_MSG +# include +# endif +# ifdef HAS_SHM +# if defined(PERL_SCO) || defined(PERL_ISC) +# include /* SHMLBA */ +# endif +# include +# ifndef HAS_SHMAT_PROTOTYPE + extern Shmat_t shmat _((int, char *, int)); +# endif +# if defined(__sparc__) && (defined(__NetBSD__) || defined(__OpenBSD__)) +# undef SHMLBA /* not static: determined at boot time */ +# define SHMLBA getpagesize() +# endif +# endif #endif + +/* Required to get 'struct pte' for SHMLBA on ULTRIX. */ +#if defined(__ultrix) || defined(__ultrix__) || defined(ultrix) +# include #endif /* Required in BSDI to get PAGE_SIZE definition for SHMLBA. * Ugly. More beautiful solutions welcome. * Shouting at BSDI sounds quite beautiful. */ #ifdef __bsdi__ -# include +# include /* move upwards under HAS_SHM? */ +#endif + +#ifndef S_IRWXU +# ifdef S_IRUSR +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IWUSR) +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IWGRP) +# define S_IRWXO (S_IROTH|S_IWOTH|S_IWOTH) +# else +# define S_IRWXU 0700 +# define S_IRWXG 0070 +# define S_IRWXO 0007 +# endif #endif MODULE=IPC::SysV PACKAGE=IPC::Msg::stat diff --git a/contrib/perl5/ext/NDBM_File/Makefile.PL b/contrib/perl5/ext/NDBM_File/Makefile.PL index ca4c107..6ceab55 100644 --- a/contrib/perl5/ext/NDBM_File/Makefile.PL +++ b/contrib/perl5/ext/NDBM_File/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'NDBM_File', LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'NDBM_File.pm', ); diff --git a/contrib/perl5/ext/ODBM_File/Makefile.PL b/contrib/perl5/ext/ODBM_File/Makefile.PL index 76a5d19..2732a32 100644 --- a/contrib/perl5/ext/ODBM_File/Makefile.PL +++ b/contrib/perl5/ext/ODBM_File/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'ODBM_File', LIBS => ["-ldbm -lucb"], - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'ODBM_File.pm', ); diff --git a/contrib/perl5/ext/Opcode/Makefile.PL b/contrib/perl5/ext/Opcode/Makefile.PL index 48a6ed8..d7e781f 100644 --- a/contrib/perl5/ext/Opcode/Makefile.PL +++ b/contrib/perl5/ext/Opcode/Makefile.PL @@ -1,7 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Opcode', - MAN3PODS => ' ', + MAN3PODS => {}, VERSION_FROM => 'Opcode.pm', XS_VERSION => '1.03' ); diff --git a/contrib/perl5/ext/Opcode/Opcode.xs b/contrib/perl5/ext/Opcode/Opcode.xs index e853cf1..e93b900 100644 --- a/contrib/perl5/ext/Opcode/Opcode.xs +++ b/contrib/perl5/ext/Opcode/Opcode.xs @@ -400,7 +400,8 @@ PPCODE: } else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { int b, j; - char *bitmap = SvPV(bitspec,PL_na); + STRLEN n_a; + char *bitmap = SvPV(bitspec,n_a); myopcode = 0; for (b=0; b < opset_len; b++) { U16 bits = bitmap[b]; diff --git a/contrib/perl5/ext/Opcode/Safe.pm b/contrib/perl5/ext/Opcode/Safe.pm index 940a972..2d09c2e 100644 --- a/contrib/perl5/ext/Opcode/Safe.pm +++ b/contrib/perl5/ext/Opcode/Safe.pm @@ -283,8 +283,8 @@ perl code is compiled into an internal format before execution. Evaluating perl code (e.g. via "eval" or "do 'file'") causes the code to be compiled into an internal format and then, provided there was no error in the compilation, executed. -Code evaulated in a compartment compiles subject to the -compartment's operator mask. Attempting to evaulate code in a +Code evaluated in a compartment compiles subject to the +compartment's operator mask. Attempting to evaluate code in a compartment which contains a masked operator will cause the compilation to fail with an error. The code will not be executed. diff --git a/contrib/perl5/ext/Opcode/ops.pm b/contrib/perl5/ext/Opcode/ops.pm index b9ea36c..9b553b7 100644 --- a/contrib/perl5/ext/Opcode/ops.pm +++ b/contrib/perl5/ext/Opcode/ops.pm @@ -31,7 +31,7 @@ ops - Perl pragma to restrict unsafe operations when compiling =head1 DESCRIPTION -Since the ops pragma currently has an irreversable global effect, it is +Since the ops pragma currently has an irreversible global effect, it is only of significant practical use with the C<-M> option on the command line. See the L module for information about opcodes, optags, opmasks diff --git a/contrib/perl5/ext/POSIX/Makefile.PL b/contrib/perl5/ext/POSIX/Makefile.PL index bc1dda9..d379fdb 100644 --- a/contrib/perl5/ext/POSIX/Makefile.PL +++ b/contrib/perl5/ext/POSIX/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'POSIX', ($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])), - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', ); diff --git a/contrib/perl5/ext/POSIX/POSIX.pm b/contrib/perl5/ext/POSIX/POSIX.pm index 5d3ef5c..84298cb 100644 --- a/contrib/perl5/ext/POSIX/POSIX.pm +++ b/contrib/perl5/ext/POSIX/POSIX.pm @@ -268,25 +268,25 @@ sub toupper { sub closedir { usage "closedir(dirhandle)" if @_ != 1; - closedir($_[0]); + CORE::closedir($_[0]); } sub opendir { usage "opendir(directory)" if @_ != 1; my $dirhandle = gensym; - opendir($dirhandle, $_[0]) + CORE::opendir($dirhandle, $_[0]) ? $dirhandle : undef; } sub readdir { usage "readdir(dirhandle)" if @_ != 1; - readdir($_[0]); + CORE::readdir($_[0]); } sub rewinddir { usage "rewinddir(dirhandle)" if @_ != 1; - rewinddir($_[0]); + CORE::rewinddir($_[0]); } sub errno { @@ -301,42 +301,42 @@ sub creat { sub fcntl { usage "fcntl(filehandle, cmd, arg)" if @_ != 3; - fcntl($_[0], $_[1], $_[2]); + CORE::fcntl($_[0], $_[1], $_[2]); } sub getgrgid { usage "getgrgid(gid)" if @_ != 1; - getgrgid($_[0]); + CORE::getgrgid($_[0]); } sub getgrnam { usage "getgrnam(name)" if @_ != 1; - getgrnam($_[0]); + CORE::getgrnam($_[0]); } sub atan2 { usage "atan2(x,y)" if @_ != 2; - atan2($_[0], $_[1]); + CORE::atan2($_[0], $_[1]); } sub cos { usage "cos(x)" if @_ != 1; - cos($_[0]); + CORE::cos($_[0]); } sub exp { usage "exp(x)" if @_ != 1; - exp($_[0]); + CORE::exp($_[0]); } sub fabs { usage "fabs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub log { usage "log(x)" if @_ != 1; - log($_[0]); + CORE::log($_[0]); } sub pow { @@ -346,22 +346,22 @@ sub pow { sub sin { usage "sin(x)" if @_ != 1; - sin($_[0]); + CORE::sin($_[0]); } sub sqrt { usage "sqrt(x)" if @_ != 1; - sqrt($_[0]); + CORE::sqrt($_[0]); } sub getpwnam { usage "getpwnam(name)" if @_ != 1; - getpwnam($_[0]); + CORE::getpwnam($_[0]); } sub getpwuid { usage "getpwuid(uid)" if @_ != 1; - getpwuid($_[0]); + CORE::getpwuid($_[0]); } sub longjmp { @@ -382,12 +382,12 @@ sub sigsetjmp { sub kill { usage "kill(pid, sig)" if @_ != 2; - kill $_[1], $_[0]; + CORE::kill $_[1], $_[0]; } sub raise { usage "raise(sig)" if @_ != 1; - kill $_[0], $$; # Is this good enough? + CORE::kill $_[0], $$; # Is this good enough? } sub offsetof { @@ -480,12 +480,12 @@ sub fwrite { sub getc { usage "getc(handle)" if @_ != 1; - getc($_[0]); + CORE::getc($_[0]); } sub getchar { usage "getchar()" if @_ != 0; - getc(STDIN); + CORE::getc(STDIN); } sub gets { @@ -500,7 +500,7 @@ sub perror { sub printf { usage "printf(pattern, args...)" if @_ < 1; - printf STDOUT @_; + CORE::printf STDOUT @_; } sub putc { @@ -517,17 +517,17 @@ sub puts { sub remove { usage "remove(filename)" if @_ != 1; - unlink($_[0]); + CORE::unlink($_[0]); } sub rename { usage "rename(oldfilename, newfilename)" if @_ != 2; - rename($_[0], $_[1]); + CORE::rename($_[0], $_[1]); } sub rewind { usage "rewind(filehandle)" if @_ != 1; - seek($_[0],0,0); + CORE::seek($_[0],0,0); } sub scanf { @@ -536,7 +536,7 @@ sub scanf { sub sprintf { usage "sprintf(pattern,args)" if @_ == 0; - sprintf(shift,@_); + CORE::sprintf(shift,@_); } sub sscanf { @@ -565,7 +565,7 @@ sub vsprintf { sub abs { usage "abs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub atexit { @@ -598,7 +598,7 @@ sub div { sub exit { usage "exit(status)" if @_ != 1; - exit($_[0]); + CORE::exit($_[0]); } sub free { @@ -640,7 +640,7 @@ sub srand { sub system { usage "system(command)" if @_ != 1; - system($_[0]); + CORE::system($_[0]); } sub memchr { @@ -719,7 +719,7 @@ sub strspn { sub strstr { usage "strstr(big, little)" if @_ != 2; - index($_[0], $_[1]); + CORE::index($_[0], $_[1]); } sub strtok { @@ -728,71 +728,71 @@ sub strtok { sub chmod { usage "chmod(mode, filename)" if @_ != 2; - chmod($_[0], $_[1]); + CORE::chmod($_[0], $_[1]); } sub fstat { usage "fstat(fd)" if @_ != 1; local *TMP; open(TMP, "<&$_[0]"); # Gross. - my @l = stat(TMP); + my @l = CORE::stat(TMP); close(TMP); @l; } sub mkdir { usage "mkdir(directoryname, mode)" if @_ != 2; - mkdir($_[0], $_[1]); + CORE::mkdir($_[0], $_[1]); } sub stat { usage "stat(filename)" if @_ != 1; - stat($_[0]); + CORE::stat($_[0]); } sub umask { usage "umask(mask)" if @_ != 1; - umask($_[0]); + CORE::umask($_[0]); } sub wait { usage "wait()" if @_ != 0; - wait(); + CORE::wait(); } sub waitpid { usage "waitpid(pid, options)" if @_ != 2; - waitpid($_[0], $_[1]); + CORE::waitpid($_[0], $_[1]); } sub gmtime { usage "gmtime(time)" if @_ != 1; - gmtime($_[0]); + CORE::gmtime($_[0]); } sub localtime { usage "localtime(time)" if @_ != 1; - localtime($_[0]); + CORE::localtime($_[0]); } sub time { usage "time()" if @_ != 0; - time; + CORE::time; } sub alarm { usage "alarm(seconds)" if @_ != 1; - alarm($_[0]); + CORE::alarm($_[0]); } sub chdir { usage "chdir(directory)" if @_ != 1; - chdir($_[0]); + CORE::chdir($_[0]); } sub chown { usage "chown(filename, uid, gid)" if @_ != 3; - chown($_[0], $_[1], $_[2]); + CORE::chown($_[0], $_[1], $_[2]); } sub execl { @@ -821,7 +821,7 @@ sub execvp { sub fork { usage "fork()" if @_ != 0; - fork; + CORE::fork; } sub getcwd @@ -861,12 +861,12 @@ sub getgroups { sub getlogin { usage "getlogin()" if @_ != 0; - getlogin(); + CORE::getlogin(); } sub getpgrp { usage "getpgrp()" if @_ != 0; - getpgrp($_[0]); + CORE::getpgrp; } sub getpid { @@ -876,7 +876,7 @@ sub getpid { sub getppid { usage "getppid()" if @_ != 0; - getppid; + CORE::getppid; } sub getuid { @@ -891,12 +891,16 @@ sub isatty { sub link { usage "link(oldfilename, newfilename)" if @_ != 2; - link($_[0], $_[1]); + CORE::link($_[0], $_[1]); } sub rmdir { usage "rmdir(directoryname)" if @_ != 1; - rmdir($_[0]); + CORE::rmdir($_[0]); +} + +sub setbuf { + redef "IO::Handle::setbuf()"; } sub setgid { @@ -909,18 +913,22 @@ sub setuid { $< = $_[0]; } +sub setvbuf { + redef "IO::Handle::setvbuf()"; +} + sub sleep { usage "sleep(seconds)" if @_ != 1; - sleep($_[0]); + CORE::sleep($_[0]); } sub unlink { usage "unlink(filename)" if @_ != 1; - unlink($_[0]); + CORE::unlink($_[0]); } sub utime { usage "utime(filename, atime, mtime)" if @_ != 3; - utime($_[1], $_[2], $_[0]); + CORE::utime($_[1], $_[2], $_[0]); } diff --git a/contrib/perl5/ext/POSIX/POSIX.pod b/contrib/perl5/ext/POSIX/POSIX.pod index 4726487..6a4a61a 100644 --- a/contrib/perl5/ext/POSIX/POSIX.pod +++ b/contrib/perl5/ext/POSIX/POSIX.pod @@ -1009,13 +1009,14 @@ Convert date and time information to string. Returns the string. Synopsis: - strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) The month (C), weekday (C), and yearday (C) begin at zero. I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The -year (C) is given in years since 1900. I.e. The year 1995 is 95; the +year (C) is given in years since 1900. I.e., the year 1995 is 95; the year 2001 is 101. Consult your system's C manpage for details -about these and the other arguments. +about these and the other arguments. The given arguments are made consistent +by calling C before calling your system's C function. The string for Tuesday, December 12, 1995. diff --git a/contrib/perl5/ext/POSIX/POSIX.xs b/contrib/perl5/ext/POSIX/POSIX.xs index 6958c00..15e026e 100644 --- a/contrib/perl5/ext/POSIX/POSIX.xs +++ b/contrib/perl5/ext/POSIX/POSIX.xs @@ -10,8 +10,6 @@ # undef open # undef setmode # define open PerlLIO_open3 -# undef TAINT_PROPER -# define TAINT_PROPER(a) #endif #include #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ @@ -2569,7 +2567,7 @@ new(packname = "POSIX::SigSet", ...) CODE: { int i; - RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t)); + New(0, RETVAL, 1, sigset_t); sigemptyset(RETVAL); for (i = 1; i < items; i++) sigaddset(RETVAL, SvIV(ST(i))); @@ -2581,7 +2579,7 @@ void DESTROY(sigset) POSIX::SigSet sigset CODE: - safefree((char *)sigset); + Safefree(sigset); SysRet sigaddset(sigset, sig) @@ -2615,7 +2613,7 @@ new(packname = "POSIX::Termios", ...) CODE: { #ifdef I_TERMIOS - RETVAL = (struct termios*)safemalloc(sizeof(struct termios)); + New(0, RETVAL, 1, struct termios); #else not_here("termios"); RETVAL = 0; @@ -2629,7 +2627,7 @@ DESTROY(termios_ref) POSIX::Termios termios_ref CODE: #ifdef I_TERMIOS - safefree((char *)termios_ref); + Safefree(termios_ref); #else not_here("termios"); #endif @@ -3181,10 +3179,11 @@ sigaction(sig, action, oldaction = 0) sig_name[sig], strlen(sig_name[sig]), TRUE); + STRLEN n_a; /* Remember old handler name if desired. */ if (oldaction) { - char *hand = SvPVx(*sigsvp, PL_na); + char *hand = SvPVx(*sigsvp, n_a); svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); sv_setpv(*svp, *hand ? hand : "DEFAULT"); } @@ -3195,7 +3194,7 @@ sigaction(sig, action, oldaction = 0) svp = hv_fetch(action, "HANDLER", 7, FALSE); if (!svp) croak("Can't supply an action without a HANDLER"); - sv_setpv(*sigsvp, SvPV(*svp, PL_na)); + sv_setpv(*sigsvp, SvPV(*svp, n_a)); mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ act.sa_handler = sighandler; @@ -3234,7 +3233,7 @@ sigaction(sig, action, oldaction = 0) sigset = (sigset_t*) tmp; } else { - sigset = (sigset_t*)safemalloc(sizeof(sigset_t)); + New(0, sigset, 1, sigset_t); sv_setptrobj(*svp, sigset, "POSIX::SigSet"); } *sigset = oact.sa_mask; @@ -3256,7 +3255,20 @@ SysRet sigprocmask(how, sigset, oldsigset = 0) int how POSIX::SigSet sigset - POSIX::SigSet oldsigset + POSIX::SigSet oldsigset = NO_INIT +INIT: + if ( items < 3 ) { + oldsigset = 0; + } + else if (sv_derived_from(ST(2), "POSIX::SigSet")) { + IV tmp = SvIV((SV*)SvRV(ST(2))); + oldsigset = (POSIX__SigSet) tmp; + } + else { + New(0, oldsigset, 1, sigset_t); + sigemptyset(oldsigset); + sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset); + } SysRet sigsuspend(signal_mask) @@ -3591,7 +3603,7 @@ mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) RETVAL char * -strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) +strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) char * fmt int sec int min @@ -3617,8 +3629,45 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) mytm.tm_wday = wday; mytm.tm_yday = yday; mytm.tm_isdst = isdst; + (void) mktime(&mytm); len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm); - ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + /* + ** The following is needed to handle to the situation where + ** tmpbuf overflows. Basically we want to allocate a buffer + ** and try repeatedly. The reason why it is so complicated + ** is that getting a return value of 0 from strftime can indicate + ** one of the following: + ** 1. buffer overflowed, + ** 2. illegal conversion specifier, or + ** 3. the format string specifies nothing to be returned(not + ** an error). This could be because format is an empty string + ** or it specifies %p that yields an empty string in some locale. + ** If there is a better way to make it portable, go ahead by + ** all means. + */ + if ( ( len > 0 && len < sizeof(tmpbuf) ) + || ( len == 0 && strlen(fmt) == 0 ) ) { + ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + } else { + /* Possibly buf overflowed - try again with a bigger buf */ + int bufsize = strlen(fmt) + sizeof(tmpbuf); + char* buf; + int buflen; + + New(0, buf, bufsize, char); + while( buf ) { + buflen = strftime(buf, bufsize, fmt, &mytm); + if ( buflen > 0 && buflen < bufsize ) break; + bufsize *= 2; + Renew(buf, bufsize, char); + } + if ( buf ) { + ST(0) = sv_2mortal(newSVpv(buf, buflen)); + Safefree(buf); + } else { + ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + } + } } void diff --git a/contrib/perl5/ext/POSIX/hints/dynixptx.pl b/contrib/perl5/ext/POSIX/hints/dynixptx.pl new file mode 100644 index 0000000..9b63684 --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/dynixptx.pl @@ -0,0 +1,4 @@ +# Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug +# PR#227670 - linker error on fpgetround() + +$self->{LIBS} = ['-ldb -lm -lc']; diff --git a/contrib/perl5/ext/POSIX/hints/mint.pl b/contrib/perl5/ext/POSIX/hints/mint.pl new file mode 100644 index 0000000..b975cbb --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/mint.pl @@ -0,0 +1,2 @@ +$self->{CCFLAGS} = $Config{ccflags} . ' -DNO_LOCALECONV_GROUPING -DNO_LOCALECONV_MON_GROUPING'; + diff --git a/contrib/perl5/ext/SDBM_File/Makefile.PL b/contrib/perl5/ext/SDBM_File/Makefile.PL index b639b29..7494785 100644 --- a/contrib/perl5/ext/SDBM_File/Makefile.PL +++ b/contrib/perl5/ext/SDBM_File/Makefile.PL @@ -12,7 +12,7 @@ else { $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; } WriteMakefile( NAME => 'SDBM_File', MYEXTLIB => $myextlib, - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'SDBM_File.pm', DEFINE => $define, diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c index 637fbe9..c147e45 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c @@ -437,6 +437,7 @@ setdbit(register DBM *db, register long int dbit) dirb = c / DBLKSIZ; if (dirb != db->dirbno) { + (void) memset(db->dirbuf, 0, DBLKSIZ); if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) return 0; diff --git a/contrib/perl5/ext/Socket/Makefile.PL b/contrib/perl5/ext/Socket/Makefile.PL index 7b9469a..3819143 100644 --- a/contrib/perl5/ext/Socket/Makefile.PL +++ b/contrib/perl5/ext/Socket/Makefile.PL @@ -2,6 +2,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Socket', VERSION_FROM => 'Socket.pm', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? ); diff --git a/contrib/perl5/ext/Socket/Socket.pm b/contrib/perl5/ext/Socket/Socket.pm index 5a4870f..1ed19f7 100644 --- a/contrib/perl5/ext/Socket/Socket.pm +++ b/contrib/perl5/ext/Socket/Socket.pm @@ -193,10 +193,25 @@ require DynaLoader; AF_UNIX AF_UNSPEC AF_X25 + MSG_CTLFLAGS + MSG_CTLIGNORE + MSG_CTRUNC MSG_DONTROUTE + MSG_DONTWAIT + MSG_EOF + MSG_EOR + MSG_ERRQUEUE + MSG_FIN MSG_MAXIOVLEN + MSG_NOSIGNAL MSG_OOB MSG_PEEK + MSG_PROXY + MSG_RST + MSG_SYN + MSG_TRUNC + MSG_URG + MSG_WAITALL PF_802 PF_APPLETALK PF_CCITT @@ -221,6 +236,11 @@ require DynaLoader; PF_UNIX PF_UNSPEC PF_X25 + SCM_CONNECT + SCM_CREDENTIALS + SCM_CREDS + SCM_RIGHTS + SCM_TIMESTAMP SOCK_DGRAM SOCK_RAW SOCK_RDM diff --git a/contrib/perl5/ext/Socket/Socket.xs b/contrib/perl5/ext/Socket/Socket.xs index de0217b..0bd6e59 100644 --- a/contrib/perl5/ext/Socket/Socket.xs +++ b/contrib/perl5/ext/Socket/Socket.xs @@ -330,42 +330,114 @@ constant(char *name, int arg) case 'L': break; case 'M': + if (strEQ(name, "MSG_CTLFLAGS")) +#ifdef MSG_CTLFLAGS + return MSG_CTLFLAGS; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_CTLIGNORE")) +#ifdef MSG_CTLIGNORE + return MSG_CTLIGNORE; +#else + goto not_there; +#endif if (strEQ(name, "MSG_CTRUNC")) -#if defined(MSG_CTRUNC) || defined(HAS_GNULIBC) /* XXX it's an enum */ +#if defined(MSG_TRUNC) || defined(HAS_MSG_CTRUNC) /* might be an enum */ return MSG_CTRUNC; #else goto not_there; #endif if (strEQ(name, "MSG_DONTROUTE")) -#if defined(MSG_DONTROUTE) || defined(HAS_GNULIBC) /* XXX it's an enum */ +#if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /* might be an enum */ return MSG_DONTROUTE; #else goto not_there; #endif + if (strEQ(name, "MSG_DONTWAIT")) +#ifdef MSG_DONTWAIT + return MSG_DONTWAIT; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_EOF")) +#ifdef MSG_EOF + return MSG_EOF; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_EOR")) +#ifdef MSG_EOR + return MSG_EOR; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_ERRQUEUE")) +#ifdef MSG_ERRQUEUE + return MSG_ERRQUEUE; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_FIN")) +#ifdef MSG_FIN + return MSG_FIN; +#else + goto not_there; +#endif if (strEQ(name, "MSG_MAXIOVLEN")) #ifdef MSG_MAXIOVLEN return MSG_MAXIOVLEN; #else goto not_there; #endif + if (strEQ(name, "MSG_NOSIGNAL")) +#ifdef MSG_NOSIGNAL + return MSG_NOSIGNAL; +#else + goto not_there; +#endif if (strEQ(name, "MSG_OOB")) -#if defined(MSG_OOB) || defined(HAS_GNULIBC) /* XXX it's an enum */ +#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */ return MSG_OOB; #else goto not_there; #endif if (strEQ(name, "MSG_PEEK")) -#if defined(MSG_PEEK) || defined(HAS_GNULIBC) /* XXX it's an enum */ +#if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /* might be an enum */ return MSG_PEEK; #else goto not_there; #endif if (strEQ(name, "MSG_PROXY")) -#if defined(MSG_PROXY) || defined(HAS_GNULIBC) /* XXX it's an enum */ +#if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /* might be an enum */ return MSG_PROXY; #else goto not_there; #endif + if (strEQ(name, "MSG_RST")) +#ifdef MSG_RST + return MSG_RST; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_SYN")) +#ifdef MSG_SYN + return MSG_SYN; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_TRUNC")) +#ifdef MSG_TRUNC + return MSG_TRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_WAITALL")) +#ifdef MSG_WAITALL + return MSG_WAITALL; +#else + goto not_there; +#endif break; case 'N': break; @@ -522,6 +594,36 @@ constant(char *name, int arg) case 'R': break; case 'S': + if (strEQ(name, "SCM_CONNECT")) +#ifdef SCM_CONNECT + return SCM_CONNECT; +#else + goto not_there; +#endif + if (strEQ(name, "SCM_CREDENTIALS")) +#ifdef SCM_CREDENTIALS + return SCM_CREDENTIALS; +#else + goto not_there; +#endif + if (strEQ(name, "SCM_CREDS")) +#ifdef SCM_CREDS + return SCM_CREDS; +#else + goto not_there; +#endif + if (strEQ(name, "SCM_RIGHTS")) +#if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /* might be an enum */ + return SCM_RIGHTS; +#else + goto not_there; +#endif + if (strEQ(name, "SCM_TIMESTAMP")) +#ifdef SCM_TIMESTAMP + return SCM_TIMESTAMP; +#else + goto not_there; +#endif if (strEQ(name, "SOCK_DGRAM")) #ifdef SOCK_DGRAM return SOCK_DGRAM; diff --git a/contrib/perl5/ext/Thread/Makefile.PL b/contrib/perl5/ext/Thread/Makefile.PL index e252d4e..e67fbb7 100644 --- a/contrib/perl5/ext/Thread/Makefile.PL +++ b/contrib/perl5/ext/Thread/Makefile.PL @@ -2,6 +2,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Thread', VERSION_FROM => 'Thread.pm', - MAN3PODS => ' ' + MAN3PODS => {} ); diff --git a/contrib/perl5/ext/Thread/Thread.xs b/contrib/perl5/ext/Thread/Thread.xs index 48f8aa0..2337e8c 100644 --- a/contrib/perl5/ext/Thread/Thread.xs +++ b/contrib/perl5/ext/Thread/Thread.xs @@ -115,18 +115,21 @@ threadstart(void *arg) sv = POPs; PUTBACK; + ENTER; + SAVETMPS; perl_call_sv(sv, G_ARRAY|G_EVAL); SPAGAIN; retval = SP - (PL_stack_base + oldmark); SP = PL_stack_base + oldmark + 1; if (SvCUR(thr->errsv)) { + STRLEN n_a; MUTEX_LOCK(&thr->mutex); thr->flags |= THRf_DID_DIE; MUTEX_UNLOCK(&thr->mutex); av_store(av, 0, &PL_sv_no); av_store(av, 1, newSVsv(thr->errsv)); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", - thr, SvPV(thr->errsv, PL_na))); + thr, SvPV(thr->errsv, n_a))); } else { DEBUG_S(STMT_START { for (i = 1; i <= retval; i++) { @@ -138,6 +141,8 @@ threadstart(void *arg) for (i = 1; i <= retval; i++, SP++) sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP)); } + FREETMPS; + LEAVE; finishoff: #if 0 @@ -174,7 +179,7 @@ threadstart(void *arg) Safefree(PL_screamnext); Safefree(PL_reg_start_tmp); SvREFCNT_dec(PL_lastscream); - /*SvREFCNT_dec(PL_defoutgv);*/ + SvREFCNT_dec(PL_defoutgv); MUTEX_LOCK(&thr->mutex); DEBUG_S(PerlIO_printf(PerlIO_stderr(), @@ -233,6 +238,11 @@ newthread (SV *startsv, AV *initargs, char *classname) savethread = thr; thr = new_struct_thread(thr); + /* temporarily pretend to be the child thread in case the + * XPUSHs() below want to grow the child's stack. This is + * safe, since the other thread is not yet created, and we + * are the only ones who know about it */ + SET_THR(thr); SPAGAIN; DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: newthread (%p), tid is %u, preparing stack\n", @@ -244,11 +254,14 @@ newthread (SV *startsv, AV *initargs, char *classname) XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); XPUSHs(SvREFCNT_inc(startsv)); PUTBACK; + + /* On your marks... */ + SET_THR(savethread); + MUTEX_LOCK(&thr->mutex); + #ifdef THREAD_CREATE err = THREAD_CREATE(thr, threadstart); #else - /* On your marks... */ - MUTEX_LOCK(&thr->mutex); /* Get set... */ sigfillset(&fullmask); if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) @@ -279,10 +292,9 @@ newthread (SV *startsv, AV *initargs, char *classname) #else err = pthread_create(&thr->self, &attr, threadstart, (void*) thr); #endif - /* Go */ - MUTEX_UNLOCK(&thr->mutex); #endif if (err) { + MUTEX_UNLOCK(&thr->mutex); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: create of %p failed %d\n", savethread, thr, err)); @@ -295,16 +307,23 @@ newthread (SV *startsv, AV *initargs, char *classname) SvREFCNT_dec(startsv); return NULL; } + #ifdef THREAD_POST_CREATE THREAD_POST_CREATE(thr); #else if (sigprocmask(SIG_SETMASK, &oldmask, 0)) croak("panic: sigprocmask"); #endif + sv = newSViv(thr->tid); sv_magic(sv, thr->oursv, '~', 0, 0); SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; - return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); + sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); + + /* Go */ + MUTEX_UNLOCK(&thr->mutex); + + return sv; #else croak("No threads in this perl"); return &PL_sv_undef; @@ -371,7 +390,8 @@ join(t) for (i = 1; i <= AvFILL(av); i++) XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); } else { - char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na); + STRLEN n_a; + char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: join propagating die message: %s\n", thr, mess)); @@ -483,6 +503,7 @@ CODE: croak("cond_wait for lock that we don't own\n"); } MgOWNER(mg) = 0; + COND_SIGNAL(MgOWNERCONDP(mg)); COND_WAIT(MgCONDP(mg), MgMUTEXP(mg)); while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); diff --git a/contrib/perl5/ext/Thread/create.t b/contrib/perl5/ext/Thread/create.t index 7d6d189..df8fc77 100644 --- a/contrib/perl5/ext/Thread/create.t +++ b/contrib/perl5/ext/Thread/create.t @@ -1,4 +1,7 @@ -use Thread; +use Thread 'async'; +use Config; +use Tie::Hash; + sub start_here { my $i; print "In start_here with args: @_\n"; @@ -8,6 +11,12 @@ sub start_here { } } +async { + tie my(%h), 'Tie::StdHash'; + %h = %Config; + print "running on $h{archname}\n"; +}; + print "Starting new thread now\n"; $t = new Thread \&start_here, qw(foo bar baz); print "Started thread $t\n"; diff --git a/contrib/perl5/ext/attrs/Makefile.PL b/contrib/perl5/ext/attrs/Makefile.PL index c421757..86ed3f3 100644 --- a/contrib/perl5/ext/attrs/Makefile.PL +++ b/contrib/perl5/ext/attrs/Makefile.PL @@ -2,6 +2,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'attrs', VERSION_FROM => 'attrs.pm', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes' ); diff --git a/contrib/perl5/ext/attrs/attrs.xs b/contrib/perl5/ext/attrs/attrs.xs index da952d5..7f7970d 100644 --- a/contrib/perl5/ext/attrs/attrs.xs +++ b/contrib/perl5/ext/attrs/attrs.xs @@ -27,7 +27,8 @@ char * Class if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv))) croak("can't set attributes outside a subroutine scope"); for (i = 1; i < items; i++) { - char *attr = SvPV(ST(i), PL_na); + STRLEN n_a; + char *attr = SvPV(ST(i), n_a); cv_flags_t flag = get_flag(attr); if (!flag) croak("invalid attribute name %s", attr); @@ -47,7 +48,8 @@ SV * sub sub = Nullsv; } else { - char *name = SvPV(sub, PL_na); + STRLEN n_a; + char *name = SvPV(sub, n_a); sub = (SV*)perl_get_cv(name, FALSE); } if (!sub) diff --git a/contrib/perl5/ext/re/Makefile.PL b/contrib/perl5/ext/re/Makefile.PL index 9ed83d1..040b085 100644 --- a/contrib/perl5/ext/re/Makefile.PL +++ b/contrib/perl5/ext/re/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 're', VERSION_FROM => 're.pm', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', OBJECT => 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)', DEFINE => '-DPERL_EXT_RE_BUILD', diff --git a/contrib/perl5/ext/re/re.pm b/contrib/perl5/ext/re/re.pm index 7cea77d..83e7dba 100644 --- a/contrib/perl5/ext/re/re.pm +++ b/contrib/perl5/ext/re/re.pm @@ -41,11 +41,11 @@ on tainted data aren't meant to extract safe substrings, but to perform other transformations. When C is in effect, a regex is allowed to contain -C<(?{ ... })> zero-width assertions even if regular expression contains -variable interpolation. That is normally disallowed, since it is a +C<(?{ ... })> zero-width assertions even if the regex contains +variable interpolation. This is normally disallowed, since it is a potential security risk. Note that this pragma is ignored when the regular expression is obtained from tainted data, i.e. evaluation is always -disallowed with tainted regular expresssions. See L. +disallowed with tainted regular expressions. See L. For the purpose of this pragma, interpolation of precompiled regular expressions (i.e., the result of C) is I considered variable diff --git a/contrib/perl5/form.h b/contrib/perl5/form.h index 5e74c61..0d3053d 100644 --- a/contrib/perl5/form.h +++ b/contrib/perl5/form.h @@ -1,6 +1,6 @@ /* form.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/global.sym b/contrib/perl5/global.sym index f3c73fe..99edf17 100644 --- a/contrib/perl5/global.sym +++ b/contrib/perl5/global.sym @@ -276,6 +276,7 @@ do_tell do_trans do_vecset do_vop +dofile dofindlabel dopoptoeval dounwind @@ -312,6 +313,7 @@ get_op_names get_no_modify get_opargs get_specialsv_list +get_vtbl gp_free gp_ref gv_AVadd @@ -914,6 +916,7 @@ save_destructor save_freeop save_freepv save_freesv +save_generic_svref save_gp save_hash save_helem diff --git a/contrib/perl5/gv.c b/contrib/perl5/gv.c index 0d96ffa..1845058 100644 --- a/contrib/perl5/gv.c +++ b/contrib/perl5/gv.c @@ -1,6 +1,6 @@ /* gv.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -107,11 +107,12 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; - if (multi) + if (multi || doproto) /* doproto means it _was_ mentioned */ GvMULTI_on(gv); if (doproto) { /* Replicate part of newSUB here. */ SvIOK_off(gv); ENTER; + /* XXX unsafe for threads if eval_owner isn't held */ start_subparse(0,0); /* Create CV in compcv. */ GvCV(gv) = PL_compcv; LEAVE; @@ -122,9 +123,10 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) CvSTASH(GvCV(gv)) = PL_curstash; #ifdef USE_THREADS CvOWNER(GvCV(gv)) = 0; - if (!CvMUTEXP(GvCV(gv))) + if (!CvMUTEXP(GvCV(gv))) { New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex); - MUTEX_INIT(CvMUTEXP(GvCV(gv))); + MUTEX_INIT(CvMUTEXP(GvCV(gv))); + } #endif /* USE_THREADS */ if (proto) { sv_setpv((SV*)GvCV(gv), proto); @@ -614,12 +616,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; } break; - - case 'a': - case 'b': - if (len == 1) - GvMULTI_on(gv); - break; case 'E': if (strnEQ(name, "EXPORT", 6)) GvMULTI_on(gv); @@ -747,6 +743,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) case '/': case '|': case '\001': + case '\003': case '\004': case '\005': case '\006': @@ -850,7 +847,8 @@ newIO(void) SvREFCNT(io) = 1; SvOBJECT_on(io); iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV); - if (!iogv) + /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */ + if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv)))) iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); return io; @@ -991,6 +989,7 @@ Gv_AMupdate(HV *stash) MAGIC* mg=mg_find((SV*)stash,'c'); AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; + STRLEN n_a; if (mg && amtp->was_ok_am == PL_amagic_generation && amtp->was_ok_sub == PL_sub_generation) @@ -1038,7 +1037,7 @@ Gv_AMupdate(HV *stash) default: if (!SvROK(sv)) { if (!SvOK(sv)) break; - gv = gv_fetchmethod(stash, SvPV(sv, PL_na)); + gv = gv_fetchmethod(stash, SvPV(sv, n_a)); if (gv) cv = GvCV(gv); break; } @@ -1099,7 +1098,7 @@ Gv_AMupdate(HV *stash) GV *ngv; DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", - SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) ); + SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) ); if (!SvPOK(GvSV(gv)) || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), FALSE))) diff --git a/contrib/perl5/gv.h b/contrib/perl5/gv.h index 8d987ed..0226513 100644 --- a/contrib/perl5/gv.h +++ b/contrib/perl5/gv.h @@ -1,6 +1,6 @@ /* gv.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/handy.h b/contrib/perl5/handy.h index eb26ed8..7744c31 100644 --- a/contrib/perl5/handy.h +++ b/contrib/perl5/handy.h @@ -1,6 +1,6 @@ /* handy.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/hints/aix.sh b/contrib/perl5/hints/aix.sh index 25e2048..d2c45c0 100644 --- a/contrib/perl5/hints/aix.sh +++ b/contrib/perl5/hints/aix.sh @@ -19,6 +19,10 @@ alignbytes=8 usemymalloc='n' +# Intuiting the existence of system calls under AIX is difficult, +# at best; the safest technique is to find them empirically. +usenm='undef' + so="a" dlext="so" @@ -63,40 +67,51 @@ esac # symbol: boot_$(EXP) can it be auto-generated? case "$osvers" in 3*) -lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc' + lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc' ;; *) -lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' - -;; + lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' + ;; esac -if [ "X$usethreads" = "X$define" ]; then - ccflags="$ccflags -DNEED_PTHREAD_INIT" - case "$cc" in - xlc_r | cc_r) - ;; - cc | '') - cc=xlc_r # Let us be stricter. - ;; - *) - cat >&4 < UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + ccflags="$ccflags -DNEED_PTHREAD_INIT" + case "$cc" in + cc_r) ;; + cc|xlc_r) + echo >&4 "Switching cc to cc_r because of POSIX threads." + # xlc_r has been known to produce buggy code in AIX 4.3.2. + # (e.g. pragma/overload core dumps) + # --jhi@iki.fi + cc=cc_r + ;; + '') + cc=cc_r + ;; + *) + cat >&4 < # Merged by Andy Dougherty -# Last revised Fri Jun 2 11:21:27 EDT 1995 +# Last revised Tue Mar 16 19:12:22 EET 1999 by +# Jarkko Hietaniemi # uname -a looks like # DomainOS newton 10.4.1 bsd4.3 425t # We want to use both BSD includes and some of the features from the # /sys5 includes. -ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include" +ccflags="$ccflags -A cpu,mathchip -I`pwd`/apollo -I/usr/include -I/sys5/usr/include" + +# When Apollo runs a script with "#!", it sets argv[0] to the script name. +toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' # These adjustments are necessary (why?) to compile malloc.c. freetype='void' diff --git a/contrib/perl5/hints/beos.sh b/contrib/perl5/hints/beos.sh index ab75276..8d76bc5 100644 --- a/contrib/perl5/hints/beos.sh +++ b/contrib/perl5/hints/beos.sh @@ -1,11 +1,12 @@ # BeOS hints file # $Id: beos.sh,v 1.1 1998/02/16 03:51:45 dogcow Exp $ -if [ ! -f beos/nm ]; then mwcc -w all -o beos/nm beos/nm.c; fi +if [ ! -f beos/nm ]; then mwcc -w all -o beos/nm beos/nm.c 2>/dev/null; fi +# If this fails, that's all right - it's only for PPC. prefix="/boot/home/config" -cpp="mwcc -e" +#cpp="mwcc -e" libpth='/boot/beos/system/lib /boot/home/config/lib' usrinc='/boot/develop/headers/posix' @@ -37,9 +38,16 @@ d_syserrlst='undef' # the array syserrlst[] is useless for the most part. # large negative numbers really kind of suck in arrays. -#d_socket='undef' +d_socket='undef' +d_gethbyaddr='undef' +d_gethbyname='undef' +d_getsbyname='undef' + +ld='gcc' + # Sockets really don't work with the current version of perl and the # current BeOS sockets; I suspect that a new module a la GSAR's WIN32 port # will be required. +# Of course, this may also change with R5. export PATH="$PATH:$PWD/beos" diff --git a/contrib/perl5/hints/dec_osf.sh b/contrib/perl5/hints/dec_osf.sh index a531ea8..8758cbb 100644 --- a/contrib/perl5/hints/dec_osf.sh +++ b/contrib/perl5/hints/dec_osf.sh @@ -177,30 +177,37 @@ case "$optimize" in ;; esac -if [ "X$usethreads" = "X$define" ]; then - # Threads interfaces changed with V4.0. - case "$_DEC_uname_r" in - *[123].*) libswanted="$libswanted pthreads mach exc c_r" - ccflags="-threads $ccflags" - ;; - *) libswanted="$libswanted pthread exc" - ccflags="-pthread $ccflags" - ;; - esac - usemymalloc='n' -fi - # # Make embedding in things like INN and Apache more memory friendly. # Keep it overridable on the Configure command line, though, so that # "-Uuseshrplib" prevents this default. # -# This or the glibpth change above breaks the build. Commented out -# for this snapshot. -#case "$_DEC_cc_style.$useshrplib" in -# new.) useshrplib="$define" ;; -#esac +case "$_DEC_cc_style.$useshrplib" in + new.) useshrplib="$define" ;; +esac + +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + # Threads interfaces changed with V4.0. + case "`uname -r`" in + *[123].*) + libswanted="$libswanted pthreads mach exc c_r" + ccflags="-threads $ccflags" + ;; + *) + libswanted="$libswanted pthread exc" + ccflags="-pthread $ccflags" + ;; + esac + + usemymalloc='n' + ;; +esac +EOCBU # # Unset temporary variables no more needed. @@ -216,7 +223,7 @@ unset _DEC_uname_r # # 19-Dec-1997 Spider Boardman # -# * Newer Digial UNIX compilers enforce signaling for NaN without +# * Newer Digital UNIX compilers enforce signaling for NaN without # -ieee. Added -fprm d at the same time since it's friendlier for # embedding. # diff --git a/contrib/perl5/hints/dos_djgpp.sh b/contrib/perl5/hints/dos_djgpp.sh index 73bae63..7c59428 100644 --- a/contrib/perl5/hints/dos_djgpp.sh +++ b/contrib/perl5/hints/dos_djgpp.sh @@ -52,8 +52,14 @@ sitearch=$sitelib eagain='EAGAIN' rd_nodata='-1' -if [ "X$usethreads" = "X$define" ]; then - set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'` - shift - libswanted="$*" -fi +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'` + shift + libswanted="$*" + ;; +esac +EOCBU diff --git a/contrib/perl5/hints/dynixptx.sh b/contrib/perl5/hints/dynixptx.sh index 78a45e4..2edf026 100644 --- a/contrib/perl5/hints/dynixptx.sh +++ b/contrib/perl5/hints/dynixptx.sh @@ -1,5 +1,9 @@ # Sequent Dynix/Ptx v. 4 hints # Created 1996/03/15 by Brad Howerter, bhower@wgc.woodward.com + +# Modified 1998/11/10 by Martin J. Bligh, mbligh@sequent.com +# to incorporate work done by Kurtis D. Rader & myself. + # Use Configure -Dcc=gcc to use gcc. # cc wants -G for dynamic loading @@ -15,10 +19,41 @@ 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' +# for performance, apparently this makes a huge difference (~krader) + +d_vfork='define' +optimize='-Wc,-O3 -W0,-xstring' + +# We override d_socket because it's very hard for Configure to get it right +# in Dynix/Ptx, for several reasons. +# (1) the socket interface is in libsocket.so -- this wouldn't be so hard +# for Configure to fathom...but it gets more tangled. +# (2) if the system has been patched there can be libsocket.so.1.FOO.BAR, +# the FOO.BAR being the old version of the system before the patching. +# Configure picks up the old broken version. +# (3) libsocket.so points to either libsocket.so.1 (v4.2) +# or libsocket.so.1.1 (v4.4) The socket call in libsocket.so.1.1 +# (BSD socket library) is called bsd_socket(), and has a macro wrapper +# to hide this. +# This information kindly provided by Martin J. Bligh of Sequent. +# As he puts it: +# "Sequent has unusual capabilities, taking it above and beyond +# the complexity of any other vendor" :-) +# +# Jarkko Hietaniemi November 1998 + +case "$osvers" in +4.4*) # configure doesn't find sockets, as they're in libsocket, not libc + d_socket='define' + d_oldsock='undef' + d_sockpair='define' + ;; +4.2*) # on ptx/TCP 4.2, we can use BSD sockets, but they're not the default. + cppflags='-Wc,+bsd-socket' + ccflags='-Wc,+bsd-socket' + ldflags='-Wc,+bsd-socket' + d_socket='define' + d_oldsock='undef' + d_sockpair='define' + ;; +esac diff --git a/contrib/perl5/hints/freebsd.sh b/contrib/perl5/hints/freebsd.sh index 0f2a5a5..66f6ca0 100644 --- a/contrib/perl5/hints/freebsd.sh +++ b/contrib/perl5/hints/freebsd.sh @@ -23,6 +23,10 @@ # Andy Dougherty # Date: Tue Mar 10 16:07:00 EST 1998 # +# Support for FreeBSD/ELF +# Ollivier Robert +# Date: Wed Sep 2 16:22:12 CEST 1998 +# # The two flags "-fpic -DPIC" are used to indicate a # will-be-shared object. Configure will guess the -fpic, (and the # -DPIC is not used by perl proper) but the full define is included to @@ -95,12 +99,21 @@ esac case "$osvers" in 0.*|1.0*) ;; -3.0*) if [ -e /usr/lib/aout ]; then +3.*|4.0*) + objformat=`/usr/bin/objformat` + if [ x$objformat = xelf ]; then + libpth="/usr/lib /usr/local/lib" + glibpth="/usr/lib /usr/local/lib" + ldflags="-Wl,-E " + lddlflags="-shared " + else + if [ -e /usr/lib/aout ]; then libpth="/usr/lib/aout /usr/local/lib /usr/lib" glibpth="/usr/lib/aout /usr/local/lib /usr/lib" fi - cccdlflags='-DPIC -fpic' lddlflags='-Bshareable' + fi + cccdlflags='-DPIC -fpic' ;; *) cccdlflags='-DPIC -fpic' @@ -118,38 +131,91 @@ problem. Try EOM -# XXX EXPERIMENTAL A.D. 03/09/1998 -# XXX This script UU/usethreads.cbu will get 'called-back' by Configure -# XXX after it has prompted the user for whether to use threads. -cat > UU/usethreads.cbu <<'EOSH' +# From: Anton Berezin +# To: perl5-porters@perl.org +# Subject: [PATCH 5.005_54] Configure - hints/freebsd.sh signal handler type +# Date: 30 Nov 1998 19:46:24 +0100 +# Message-ID: <864srhhvcv.fsf@lion.plab.ku.dk> + +signal_t='void' +d_voidsig='define' + +# set libperl.so.X.X for 2.2.X +case "$osvers" in +2.2*) + # unfortunately this code gets executed before + # the equivalent in the main Configure so we copy a little + # from Configure XXX Configure should be fixed. + if $test -r $src/patchlevel.h;then + patchlevel=`awk '/define[ ]+PATCHLEVEL/ {print $3}' $src/patchlevel.h` + subversion=`awk '/define[ ]+SUBVERSION/ {print $3}' $src/patchlevel.h` + else + patchlevel=0 + subversion=0 + fi + libperl="libperl.so.$patchlevel.$subversion" + unset patchlevel + unset subversion + ;; +esac + +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in -$define) - case "$osvers" in - 3.0*) ldflags="-pthread $ldflags" - ;; - 2.2*) if [ ! -r /usr/lib/libc_r ]; then - cat <<'EOM' >&4 -POSIX threads are not supported by default on FreeBSD $uname_r. Follow the -instructions in 'man pthread' to build and install the needed libraries. +$define|true|[yY]*) + lc_r=`/sbin/ldconfig -r|grep ':-lc_r'|awk '{print $NF}'` + case "$osvers" in + 2.2.8*|3.*|4.*) + if [ ! -r "$lc_r" ]; then + cat <&4 +POSIX threads should be supported by FreeBSD $osvers -- +but your system is missing the shared libc_r. +(/sbin/ldconfig -r doesn't find any). + +Consider using the latest STABLE release. EOM - exit 1 - fi - set `echo X "$libswanted "| sed -e 's/ c / c_r /'` - shift - libswanted="$*" - # Configure will probably pick the wrong libc to use for nm - # scan. - # The safest quick-fix is just to not use nm at all. - usenm=false - ;; - *) cat <<'EOM' >&4 -It is not known if FreeBSD $uname_r supports POSIX threads or not. Consider -upgrading to the latest STABLE release. + exit 1 + fi + ldflags="-pthread $ldflags" + ;; + 2.2*) + cat <&4 +POSIX threads are not supported well by FreeBSD $osvers. + +Please consider upgrading to at least FreeBSD 2.2.8, +or preferably to 3.something. + +(While 2.2.7 does have pthreads, it has some problems + with the combination of threads and pipes and therefore + many Perl tests will either hang or fail.) EOM - exit 1 - ;; - esac - ;; + exit 1 + ;; + *) cat <&4 +I did not know that FreeBSD $osvers supports POSIX threads. + +Feel free to tell perlbug@perl.com otherwise. +EOM + exit 1 + ;; + esac + + set `echo X "$libswanted "| sed -e 's/ c / c_r /'` + shift + libswanted="$*" + # Configure will probably pick the wrong libc to use for nm scan. + # The safest quick-fix is just to not use nm at all... + usenm=false + + case "$osvers" in + 2.2.8*) + # ... but this does not apply for 2.2.8 - we know it's safe + libc="$lc_r" + usenm=true + ;; + esac + + unset lc_r esac -EOSH -# XXX EXPERIMENTAL --end of call-back +EOCBU diff --git a/contrib/perl5/hints/gnu.sh b/contrib/perl5/hints/gnu.sh new file mode 100644 index 0000000..927bcea --- /dev/null +++ b/contrib/perl5/hints/gnu.sh @@ -0,0 +1,33 @@ +# hints/gnu.sh +# Last modified: Thu Dec 10 20:47:28 CET 1998 +# Mark Kettenis + +# libnsl is unusable on the Hurd. +# XXX remove this once SUNRPC is implemented. +set `echo X "$libswanted "| sed -e 's/ nsl / /'` +shift +libswanted="$*" + +case "$optimize" in +'') optimize='-O2' ;; +esac + +# Flags needed to produce shared libraries. +lddlflags='-shared' + +# Flags needed by programs that use dynamic linking. +ccdlflags='-Wl,-E' + +# The following routines are only available as stubs in GNU libc. +# XXX remove this once metaconf detects the GNU libc stubs. +d_msgctl='undef' +d_msgget='undef' +d_msgrcv='undef' +d_msgsnd='undef' +d_semctl='undef' +d_semget='undef' +d_semop='undef' +d_shmat='undef' +d_shmctl='undef' +d_shmdt='undef' +d_shmget='undef' diff --git a/contrib/perl5/hints/hpux.sh b/contrib/perl5/hints/hpux.sh index 281f289..8a9e3cb 100644 --- a/contrib/perl5/hints/hpux.sh +++ b/contrib/perl5/hints/hpux.sh @@ -20,6 +20,7 @@ # Distinguish between MC68020, MC68030, MC68040 # Don't assume every OS != 10 is < 10, (e.g., 11). # From: Chuck Phillips +# HP-UX 10 pthreads hints: Matthew T Harden # This version: August 15, 1997 # Current maintainer: Jeff Okamoto @@ -80,6 +81,16 @@ EOM esac else ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C + # cppstdin and cpprun need the -Aa option if you use the unbundled + # ANSI C compiler (*not* the bundled K&R compiler or gcc) + # [XXX this should be set automatically by Configure, but isn't yet.] + # [XXX This is reported not to work. You may have to edit config.sh. + # After running Configure, set cpprun and cppstdin in config.sh, + # run "Configure -S" and then "make".] + cpprun="${cc:-cc} -E -Aa" + cppstdin="$cpprun" + cppminus='-' + cpplast='-' fi # For HP's ANSI C compiler, up to "+O3" is safe for everything # except shared libraries (PIC code). Max safe for PIC is "+O2". @@ -128,6 +139,60 @@ else selecttype='int *' fi +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + if [ "$xxOsRevMajor" -lt 10 ]; then + cat <&4 +HP-UX $xxOsRevMajor cannot support POSIX threads. +Consider upgrading to at least HP-UX 11. +Cannot continue, aborting. +EOM + exit 1 + fi + case "$xxOsRevMajor" in + 10) + # Under 10.X, a threaded perl can be built, but it needs + # libcma and OLD_PTHREADS_API. Also needs to + # be #included before any other includes (in perl.h) + if [ ! -f /usr/include/pthread.h -o ! -f /usr/lib/libcma.sl ]; then + cat <&4 +In HP-UX 10.X for POSIX threads you need both of the files +/usr/include/pthread.h and /usr/lib/libcma.sl. +Either you must install the CMA package or you must upgrade to HP-UX 11. +Cannot continue, aborting. +EOM + exit 1 + fi + + # HP-UX 10.X uses the old pthreads API + case "$d_oldpthreads" in + '') d_oldpthreads="$define" ;; + esac + + # include libcma before all the others + libswanted="cma $libswanted" + + # tell perl.h to include before other include files + ccflags="$ccflags -DPTHREAD_H_FIRST" + + # CMA redefines select to cma_select, and cma_select expects int * + # instead of fd_set * (just like 9.X) + selecttype='int *' + ;; + 11 | 12) # 12 may want upping the _POSIX_C_SOURCE datestamp... + ccflags=" -D_POSIX_C_SOURCE=199506L $ccflags" + set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + shift + libswanted="$*" + ;; + esac + usemymalloc='n' + ;; +esac +EOCBU # Remove bad libraries that will cause problems # (This doesn't remove libraries that don't actually exist) @@ -183,24 +248,3 @@ esac # assembler of the form: # (warning) Use of GR3 when frame >= 8192 may cause conflict. # These warnings are harmless and can be safely ignored. - -# -# cppstdin and cpprun need the -Aa option if you use the unbundled -# ANSI C compiler (*not* the bundled K&R compiler or gcc) -# [XXX this should be enabled automatically by Configure, but isn't yet.] -# [XXX This is reported not to work. You may have to edit config.sh. -# After running Configure, set cpprun and cppstdin in config.sh, -# run "Configure -S" and then "make".] -# -case "$cppstdin" in -'') - case "$ccflags" in - *-Aa*) - cpprun="${cc:-cc} -E -Aa" - cppstdin="$cpprun" - cppminus='-' - cpplast='-' - ;; - esac - ;; -esac diff --git a/contrib/perl5/hints/irix_4.sh b/contrib/perl5/hints/irix_4.sh index f5883f3..8013c8a 100644 --- a/contrib/perl5/hints/irix_4.sh +++ b/contrib/perl5/hints/irix_4.sh @@ -22,3 +22,14 @@ If you have problems, you might have try including -DSTANDARD_C -cckr in ccflags. EOM + +case "$usethreads" in +$define|true|[yY]*) + cat >&4 <&4 <&1`" in *7.0*) # Mongoose 7.0 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0" - optimize='none' + optimize='none' ;; *7.1*|*7.2|*7.20) # Mongoose 7.1+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" - optimize='-O3' + optimize='-O3' # This is a temporary fix for 5.005. # Leave pp_ctl_cflags line at left margin for Configure. See # hints/README.hints, especially the section @@ -65,12 +65,12 @@ case "$cc" in pp_ctl_cflags='optimize=-O' ;; *7.*) # Mongoose 7.2.1+ - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=on" - optimize='-O3' + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=ON" + optimize='-O3' ;; *6.2*) # Ragnarok 6.2 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184" - optimize='none' + optimize='none' ;; *) # Be safe and not optimize ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" @@ -78,9 +78,30 @@ pp_ctl_cflags='optimize=-O' ;; esac - ld=ld +# this is to accommodate the 'modules' capability of the +# 7.2 MIPSPro compilers, which allows for the compilers to be installed +# in a nondefault location. Almost everything works as expected, but +# /usr/include isn't caught properly. Hence see the /usr/include/pthread.h +# change below to include TOOLROOT (a modules environment variable), +# and the following code. Additional +# code to accommodate the 'modules' environment should probably be added +# here if possible, or be inserted as a ${TOOLROOT} reference before +# absolute paths (again, see the pthread.h change below). +# -- krishna@sgi.com, 8/23/98 + +if [ "X${TOOLROOT}" != "X" ]; then +# we cant set cppflags because it gets overwritten +# we dont actually need $TOOLROOT/usr/include on the cc line cuz the +# modules functionality already includes it but +# XXX - how do I change cppflags in the hints file? + ccflags="$ccflags -I${TOOLROOT}/usr/include" + usrinc="${TOOLROOT}/usr/include" +fi + + ld=$cc # perl's malloc can return improperly aligned buffer - usemymalloc='undef' + # usemymalloc='undef' +malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' # NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker ldflags=' -L/usr/local/lib32 -L/usr/local/lib' cccdlflags=' ' @@ -138,22 +159,23 @@ set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' shift libswanted="$*" -if [ "X$usethreads" = "X$define" -o "X$usethreads" = "Xy" ]; then - if test ! -f /usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then - uname_r=`uname -r` - case "`uname -r`" in - 5*|6.0|6.1) - echo >&4 "IRIX $uname_r does not have the POSIX threads." - echo >&4 "You should upgrade to at least IRIX 6.2 with pthread patches." - echo >&4 "Cannot continue, aborting." - exit 1 - ;; - 6.2) - echo >&4 "" -cat >&4 < UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + if test ! -f ${TOOLROOT}/usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then + case "`uname -r`" in + [1-5].*|6.[01]) + cat >&4 <&4 <&4 <&4 <&4 "IRIX $uname_r should have the POSIX threads." - echo >&4 "But somehow you do not seem to have them installed." - echo >&4 "Cannot continue, aborting." - exit 1 - ;; - esac - unset uname_r - fi - # -lpthread needs to come before -lc but after other libraries such - # as -lgdbm and such like. We assume here that -lc is present in - # libswanted. If that fails to be true in future, then this can be - # changed to add pthread to the very end of libswanted. - set `echo X "$libswanted "| sed -e 's/ c / pthread /'` - ld="${cc:-cc}" - shift - libswanted="$*" - usemymalloc='n' -fi +EOM + exit 1 + fi + set `echo X "$libswanted "| sed -e 's/ c / pthread /'` + ld="${cc:-cc}" + shift + libswanted="$*" + + usemymalloc='n' + ;; +esac +EOCBU + diff --git a/contrib/perl5/hints/irix_6_0.sh b/contrib/perl5/hints/irix_6_0.sh index b0a3994..e61db04 100644 --- a/contrib/perl5/hints/irix_6_0.sh +++ b/contrib/perl5/hints/irix_6_0.sh @@ -42,10 +42,13 @@ libswanted="$*" # shift # libswanted="$*" -if [ "X$usethreads" = "X$define" ]; then - echo >&4 "IRIX 6.0 does not have POSIX threads." - echo >&4 "You should upgrade to at least IRIX 6.3." - echo >&4 "Cannot continue, aborting." - exit 1 -fi +case "$usethreads" in +$define|true|[yY]*) + cat >&4 <&4 "IRIX 6.1 does not have POSIX threads." - echo >&4 "You should upgrade to at least IRIX 6.3." - echo >&4 "Cannot continue, aborting." - exit 1 -fi +case "$usethreads" in +$define|true|[yY]*) + cat >&4 < # Message-Id: <33EF1634.B36B6500@pobox.com> # -# MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other -# linuces, needs special flags passed in order for dynamic loading to work. +# The DR2 of MkLinux (osname=linux,archname=ppc-linux) may need +# special flags passed in order for dynamic loading to work. # instead of the recommended: +# # ccdlflags='-rdynamic' # # it should be: # ccdlflags='-Wl,-E' - -# XXX EXPERIMENTAL A.D. 2/27/1998 -# XXX This script UU/usethreads.cbu will get 'called-back' by Configure -# XXX after it has prompted the user for whether to use threads. -cat > UU/usethreads.cbu <<'EOSH' +# +# So if your DR2 (DR3 came out summer 1998, consider upgrading) +# has problems with dynamic loading, uncomment the +# following three lines, make distclean, and re-Configure: +#case "`uname -r | sed 's/^[0-9.-]*//'``arch`" in +#'osfmach3ppc') ccdlflags='-Wl,-E' ;; +#esac + +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" - # -lpthread needs to come before -lc but after other libraries such - # as -lgdbm and such like. We assume here that -lc is present in - # libswanted. If that fails to be true in future, then this can be - # changed to add pthread to the very end of libswanted. - set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` - shift - libswanted="$*" - ;; + ccflags="-D_REENTRANT $ccflags" + set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + shift + libswanted="$*" + ;; esac -EOSH -# XXX EXPERIMENTAL --end of call-back +EOCBU diff --git a/contrib/perl5/hints/mint.sh b/contrib/perl5/hints/mint.sh new file mode 100644 index 0000000..22d854c --- /dev/null +++ b/contrib/perl5/hints/mint.sh @@ -0,0 +1,94 @@ +# hints/mint.sh +# +# talk to gufl0000@stud.uni-sb.de if you want to change this file. +# Please read the README.mint file. +# +# misc stuff + +case `uname -m` in + atarist*) archname="m68000-mint" + ;; + *) archname="m68k-mint" + ;; +esac + +here=`pwd | tr -d '\015'` + +cc='gcc' + +# The weird include path is really to work around some bugs in +# broken system header files. +ccflags="-D__MINT__ -Uatarist -DDEBUGGING -I$here/../mint" + +# libs + +libpth="$prefix/lib /usr/lib /usr/local/lib" +glibpth="$libpth" +xlibpth="$libpth" + +libswanted='gdbm socket port m' +so='none' + +# +# compiler & linker flags +# +optimize='-O2 -fomit-frame-pointer -fno-defer-pop -fstrength-reduce' + +# The setlocale function in the MiNTLib is actually a bad joke. We +# lend a workaround from Ultrix. If neither LC_ALL nor LANG is +# set in the environment, perl won't complain. If one is set to +# anything but "C" you will see a warning. Note that you can +# still use the GNU extension "$LANGUAGE" if you want to use +# the i18n features of some GNU packages. +util_cflags='ccflags="$ccflags -DLOCALE_ENVIRON_REQUIRED"' + +# +# Some good answers to the questions in Configure: +usenm='true' +d_suidsafe='true' +clocktype='long' +usevfork='true' +d_fsetpos='fpos_t' +gidtype='gid_t' +groupstype='gid_t' +lseektype='long' +models='none' +modetype='mode_t' +sizetype='size_t' +timetype='time_t' +uidtype='uid_t' + +# Don't remove that leading tab character (Configure Black Magic (TM)). + broken_pwd= +case "`/bin/pwd|tr -d xy|tr '\015\012' 'xy'`" in +*xy) broken_pwd=yes ;; +esac + +if test X"$broken_pwd" = Xyes +then + echo " " + echo "*** Building fixed 'pwd'... (as described in README.mint) ***" + echo " " + cd mint + make pwd + cd .. + if test -x mint/pwd -a -w /usr/bin + then + echo " " + echo "*** Installing fixed 'pwd'... ***" + echo " " + cd mint + make install + cd .. + if cmp -s mint/pwd /usr/bin/pwd + then + echo "*** Installed fixed 'pwd' successfully. ***" + else + echo "*** Failed to install fixed 'pwd'. Aborting. ***" + exit 1 + fi + else + echo "*** Cannot install fixed 'pwd'. Aborting. ***" + exit 1 + fi +fi diff --git a/contrib/perl5/hints/mpeix.sh b/contrib/perl5/hints/mpeix.sh index 4a32b77..9ebb0ba 100644 --- a/contrib/perl5/hints/mpeix.sh +++ b/contrib/perl5/hints/mpeix.sh @@ -51,8 +51,8 @@ toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' # Linking. # lddlflags='-b' -libs='-lbind -lsvipc -lsocket -lm -lc' -loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib' +libs='-lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc' +loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB' # # External functions and data items. # diff --git a/contrib/perl5/hints/netbsd.sh b/contrib/perl5/hints/netbsd.sh index 71d5084..6d99a13 100644 --- a/contrib/perl5/hints/netbsd.sh +++ b/contrib/perl5/hints/netbsd.sh @@ -1,12 +1,11 @@ # hints/netbsd.sh # -# talk to mrg@eterna.com.au if you want to change this file. +# talk to packages@netbsd.org if you want to change this file. # # netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o, # so Configure doesn't find them (unless you abandon the nm scan). # this should be *just* 0.9 below as netbsd 0.9a was the first to -# introduce shared libraries. however, they don't work/build on -# pmax, powerpc and alpha ports correctly, yet. +# introduce shared libraries. case "$archname" in '') @@ -19,34 +18,26 @@ case "$osvers" in usedl="$undef" ;; *) - case `uname -m` in - alpha|powerpc|pmax) + if [ -f /usr/libexec/ld.elf_so ]; then + d_dlopen=$define + d_dlerror=$define + ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags" + cccdlflags="-DPIC -fPIC $cccdlflags" + lddlflags="--whole-archive -shared $lddlflags" + elif [ "`uname -m`" = "pmax" ]; then +# NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work. d_dlopen=$undef - ;; -# this doesn't work (yet). -# alpha) -# d_dlopen=$define -# d_dlerror=$define -# cccdlflags="-DPIC -fPIC $cccdlflags" -# lddlflags="-shared $lddlflags" -# ;; - *) + elif [ -f /usr/libexec/ld.so ]; then d_dlopen=$define d_dlerror=$define + ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags" # we use -fPIC here because -fpic is *NOT* enough for some of the # extensions like Tk on some netbsd platforms (the sparc is one) cccdlflags="-DPIC -fPIC $cccdlflags" lddlflags="-Bforcearchive -Bshareable $lddlflags" - ;; - esac - ;; -esac -# netbsd 1.3 linker warns about setr[gu]id being deprecated. -# (setregid, setreuid, preferred?) -case "$osvers" in -1.3|1.3*) - d_setrgid="$undef" - d_setruid="$undef" + else + d_dlopen=$undef + fi ;; esac @@ -55,25 +46,31 @@ esac # way to make perl call setuid() or setgid(). if they aren't, then # ($<, $>) = ($u, $u); will work (same for $(/$)). this is because # you can not change the real userid of a process under 4.4BSD. -# netbsd fixed this in 1.2A. +# netbsd fixed this in 1.3.2. case "$osvers" in -0.9*|1.0*|1.1*|1.2_*|1.2|1.2.*) +0.9*|1.[012]*|1.3|1.3.1) d_setregid="$undef" d_setreuid="$undef" - d_setrgid="$undef" - d_setruid="$undef" - ;; -esac -# netbsd 1.3 linker warns about setr[gu]id being deprecated. -# (setregid, setreuid, preferred?) -case "$osvers" in -1.3|1.3*) - d_setrgid="$undef" - d_setruid="$undef" ;; esac -# vfork is ok on NetBSD. +# These are obsolete in any netbsd. +d_setrgid="$undef" +d_setruid="$undef" + +# there's no problem with vfork. case "$usevfork" in '') usevfork=true ;; esac + +# Avoid telldir prototype conflict in pp_sys.c (NetBSD uses const DIR *) +# Configure should test for this. Volunteers? +pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' + +# Pre-empt the /usr/bin/perl question of installperl. +installusrbinperl='n' + +# Recognize the NetBSD packages collection. +# GDBM might be here. +test -d /usr/pkg/lib && loclibpth="$loclibpth /usr/pkg/lib" +test -d /usr/pkg/include && locincpth="$locincpth /usr/pkg/include" diff --git a/contrib/perl5/hints/next_3.sh b/contrib/perl5/hints/next_3.sh index 43340c0..99adf50 100644 --- a/contrib/perl5/hints/next_3.sh +++ b/contrib/perl5/hints/next_3.sh @@ -129,3 +129,13 @@ ranlib='sleep 5; /bin/ranlib' # This is true whether we're on an HPPA machine or cross-compiling # for one. pp_cflags='optimize=""' + +# The SysV IPC is optional (ftp://ftp.nluug.nl/pub/comp/next/SysVIPC/) +# Gerben_Wierda@RnA.nl +if [ -f /usr/local/lib/libIPC.a ]; then + libswanted="$libswanted IPC" + # As of Sep 1998 d_msg wasn't supported in that library, + # only d_sem and d_shm, but Configure should be able to + # figure that out. --jhi + # Note also the next3 ext/IPC/SysV hints file. +fi diff --git a/contrib/perl5/hints/next_4.sh b/contrib/perl5/hints/next_4.sh index b3887e6..d1d0398 100644 --- a/contrib/perl5/hints/next_4.sh +++ b/contrib/perl5/hints/next_4.sh @@ -12,7 +12,7 @@ # useposix='undef' -libpth='/lib /usr/lib' +libpth='/lib /usr/lib /usr/local/lib' libswanted=' ' libc='/NextLibrary/Frameworks/System.framework/System' @@ -35,7 +35,20 @@ ld='cc' # # archs='m68k i386' # -archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'` + +# On m68k machines, toke.c cannot be compiled at all for i386 and it can +# only be compiled for m68k itself without optimization (this is under +# OPENSTEP 4.2). +# +if [ `hostinfo | grep 'NeXT Mach.*:' | sed 's/.*RELEASE_//'` = M68K ] +then + echo "Cross compilation is impossible on m68k hardware under OS 4" + echo "Forcing architecture to m68k only" + toke_cflags='optimize=""' + archs='m68k' +else + archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'` +fi # # leave the following part alone diff --git a/contrib/perl5/hints/openbsd.sh b/contrib/perl5/hints/openbsd.sh index 4c98ec8..e9d8ea4 100644 --- a/contrib/perl5/hints/openbsd.sh +++ b/contrib/perl5/hints/openbsd.sh @@ -48,4 +48,14 @@ d_suidsafe='define' # Allow a command-line override, such as -Doptimize=-g test "$optimize" || optimize='-O2' +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + # any openbsd version dependencies with pthreads? + libswanted="$libswanted pthread" +esac +EOCBU + # end diff --git a/contrib/perl5/hints/os2.sh b/contrib/perl5/hints/os2.sh index 78d370a..310ae91 100644 --- a/contrib/perl5/hints/os2.sh +++ b/contrib/perl5/hints/os2.sh @@ -113,10 +113,11 @@ aout_lib_ext='.a' aout_ar='ar' aout_plibext='.a' aout_lddlflags="-Zdll $ld_dll_optimize" +# Cannot have 32000K stack: get SYS0170 ?! if [ $emxcrtrev -ge 50 ]; then - aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000' + aout_ldflags='-Zexe -Zsmall-conv -Zstack 16000' else - aout_ldflags='-Zexe -Zstack 32000' + aout_ldflags='-Zexe -Zstack 16000' fi # To get into config.sh: @@ -249,15 +250,6 @@ nm_opt='-p' d_getprior='define' d_setprior='define' -if [ "X$usethreads" = "X$define" ]; then - ccflags="-Zmt $ccflags" - cppflags="-Zmt $cppflags" # Do we really need to set this? - aout_ccflags="-DUSE_THREADS $aout_ccflags" - aout_cppflags="-DUSE_THREADS $aout_cppflags" - aout_lddlflags="-Zmt $aout_lddlflags" - aout_ldflags="-Zmt $aout_ldflags" -fi - # The next two are commented. pdksh handles #!, extproc gives no path part. # sharpbang='extproc ' # shsharp='false' @@ -269,6 +261,21 @@ fi cp ./README.os2 ./pod/perlos2.pod +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + ccflags="-Zmt $ccflags" + cppflags="-Zmt $cppflags" # Do we really need to set this? + aout_ccflags="-DUSE_THREADS $aout_ccflags" + aout_cppflags="-DUSE_THREADS $aout_cppflags" + aout_lddlflags="-Zmt $aout_lddlflags" + aout_ldflags="-Zmt $aout_ldflags" + ;; +esac +EOCBU + # Now install the external modules. We are in the ./hints directory. cd ./os2/OS2 diff --git a/contrib/perl5/hints/os390.sh b/contrib/perl5/hints/os390.sh index 1cf945d..08b60c8 100644 --- a/contrib/perl5/hints/os390.sh +++ b/contrib/perl5/hints/os390.sh @@ -17,6 +17,8 @@ # To get ANSI C, we need to use c89, and ld doesn't exist cc='c89' ld='c89' +# To link via definition side decks we need the dll option +cccdlflags='-W 0,dll,"langlvl(extended)"' # c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again, # YYDYNAMIC ensures that the OS/390 yacc generated parser is reentrant. # -DEBCDIC should come from Configure. @@ -54,3 +56,6 @@ case "$archname" in esac archobjs=ebcdic.o + +# We have our own cppstdin. +echo 'cat >.$$.c; '"$cc"' -E -Wc,NOLOC ${1+"$@"} .$$.c; rm .$$.c' > cppstdin diff --git a/contrib/perl5/hints/sco.sh b/contrib/perl5/hints/sco.sh index cef1c0c..eb59845 100644 --- a/contrib/perl5/hints/sco.sh +++ b/contrib/perl5/hints/sco.sh @@ -1,140 +1,233 @@ -# sco.sh +# sco.sh # Courtesy of Joel Rosi-Schwartz - +############################################################### # Additional SCO version info from # Peter Wolfe -# Last revised # Fri Jul 19 14:54:25 EDT 1996 -# by Andy Dougherty - -# To use gcc, use sh Configure -Dcc=gcc -# But gcc will *not* do dynamic laoding on 3.2.5, -# for that use sh Configure -Dcc=icc -# See below for more details. +# and again Tue Sep 29 16:37:25 EDT 1998 +# by Andy Dougherty +# Mostly rewritten on +# Tue Jan 19 23:00:00 CET 1999 +# by Francois Desarmenien +############################################################### +# +# To use cc, use sh Configure +# To use gcc, use sh Configure -Dcc=gcc +# +# Default on 3.2v4 is to use static link (dynamic loading unsupported). +# Default on 3.2v5 is to use dynamic loading. +# To use static linkink instead, use to sh Configure -Dusedl=n +# +# Warning: - to use dynamic loading with gcc, you need gcc 2.8.0 or later +# ******** - to compile with older releases of gcc, use Configure -Dusedl=n +# or it wont compile properly +# +############################################################### +# NOTES: +# ----- +# +# I Have removed inclusion of ODBM_File for OSR5 +# because it core dumps and make tests fails. +# +# Support for icc compiler has been removed, because it 'breaks' +# a lot of code :-( +# +# It's *always* a good idea to first make a static link to be sure to +# have all symbols resolved with the current choice of libraries, since +# with dynamic linking, unresolved symbols are allowed an will be detected +# only at runtime (when you try to load the module or worse, when you call +# the symbol) +# +# The best choice of compiler on OSR 5 (3.2v5.*) seems to be gcc >= 2.8.0: +# -You cannot optimize with genuine sco cc (miniperl core dumps), +# so Perl is faster if compiled with gcc. +# -Even optimized for speed, gcc generated code is smaller (!!!) +# -gcc is free +# -I use ld to link which is distributed with the core OS distribution, so you +# don't need to buy the developement kit, just find someone kind enough to +# give you a binary release of gcc. +# +# +############################################################### # figure out what SCO version we are. The output of uname -X is # something like: # System = SCO_SV # Node = xxxxx # Release = 3.2v5.0.0 # KernelID = 95/08/08 -# Machine = Pentium +# Machine = Pentium # BusType = ISA # Serial = xxxxx # Users = 5-user # OEM# = 0 # Origin# = 1 -# NumCPU = 1 - -# Use /bin/uname (because Gnu may be first on the path and +# NumCPU = 1 + +# Use /bin/uname (because GNU uname may be first in $PATH and # it does not support -X) to figure out what SCO version we are: -case `/bin/uname -X | egrep '^Release'` in -*3.2v4.*) scorls=3 ;; # I don't know why this is 3 instead of 4 :-) -*3.2v5.*) scorls=5 ;; -*) scorls=3 ;; # this probabaly shouldn't happen +# Matching '^Release' is broken by locale setting: +# matching '3.2v' should be enough -- FD +case `/bin/uname -X | egrep '3\.2v'` in +*3.2v4.*) scorls=3 ;; # OSR 3 +*3.2v5.*) scorls=5 ;; # OSR 5 +*) + # Future of SCO OSR is SCO UnixWare: there should not be new OSR releases + echo "************************************************************" >&4 + echo "" >&4 + echo " sco.sh hints file only supports:" >&4 + echo "" >&4 + echo " - SCO Unix 3.2v4.x (OSR 3)" >&4 + echo " - SCO Unix 3.2v5.x (OSR 5)" >&4 + echo "" >&4 + echo "" >&4 + echo " For UnixWare, use svr4.sh hints instead" >&4 + echo "" >&4 + echo "***********************************************************" >&4 + exit +;; esac +############################################################### +# Common fixes for all compilers an releases: + +############################################################### +# What is true for SCO5 is true for SCO3 too today, so let's have a single +# symbol for both +ccflags="-U M_XENIX -D PERL_SCO" + +############################################################### +# Compilers options section: +if test "$scorls" = "3" +then + dlext='' + case "$cc" in + gcc) optimize='-O2' ;; + *) ccflags="$ccflags -W0 -quiet" + optimize='-O' ;; + esac +else + ############################################################### + # Need this in release 5 because of changed fpu exeption rules + ccflags="$ccflags -D PERL_SCO5" + + ############################################################### + # In Release 5, always compile ELF objects + case "$cc" in + gcc) + ccflags="$ccflags -melf" + optimize='-O2' + ;; + *) + ccflags="$ccflags -w0 -belf" + optimize='-O0' + ;; + esac + ############################################################### + # Dynamic loading section: + # + # We use ld to build shared libraries as it is always available + # and seems to work better than GNU's one on SCO + # + # ccdlflags : must tell the linker to export all global symbols + # cccdlflags: must tell the compiler to generate relocatable code + # lddlflags : must tell the linker to output a shared library + # + # /usr/local/lib is added for convenience, since 'foreign' libraries + # are usually put there in sco + # + if test "$usedl" != "n"; then + ld='ld' + case "$cc" in + gcc) + ccdlflags='-Xlinker -Bexport -L/usr/local/lib' + cccdlflags='-fpic' + lddlflags='-G -L/usr/local/lib' + ;; + *) + ccdlflags='-Bexport -L/usr/local/lib' + cccdlflags='-Kpic' + lddlflags='-G -L/usr/local/lib' + ;; + esac + + ############################################################### + # Use dynamic loading + usedl='define' + dlext='so' + dlsrc='dl_dlopen.xs' + + ############################################################### + # Force to define those symbols, as they are #defines and not + # catched by Configure, and they are useful + d_dlopen='define' + d_dlerror='define' + fi +fi + + +############################################################### +# Various hints, common to all releases, to have it work better: + +############################################################### +# We need to remove libdl, as libdl.so exists, but ld complains +# it can't find libdl.a ! Bug or feature ? :-) +libswanted=`echo " $libswanted " | sed -e 's/ dl / /'` +set X $libswanted +shift +libswanted="$*" + +############################################################### # Try to use libintl.a since it has strcoll and strxfrm libswanted="intl $libswanted" + +############################################################### # Try to use libdbm.nfs.a since it has dbmclose. -# if test -f /usr/lib/libdbm.nfs.a ; then libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'` + set X $libswanted + shift + libswanted="$*" fi -set X $libswanted -shift -libswanted="$*" +############################################################### +# We disable ODBM_File if OSR5 because it's mostly broken +# but keep it for ODT3 as it seems to work. +if test "$scorls" = "5"; then + i_dbm='undef' +fi + +############################################################### # We don't want Xenix cross-development libraries glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'` xlibpth='' -case "$cc" in -*gcc*) ccflags="$ccflags -U M_XENIX" - optimize="$optimize -O2" - ;; -scocc) ;; - -# On SCO 3.2v5 both cc and icc can build dynamic load, but cc core -# dumps if optimised, so I am only setting this up for icc. -# It is possible that some 3.2v4.2 system have icc, I seem to -# recall it was available as a seperate product but I have no -# knowledge if it can do dynamic loading and if so how. -# Joel Rosi-Schwartz -icc)# Apparently, SCO's cc gives rather verbose warnings - # Set -w0 to turn them off. - case $scorls in - 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;; - 5) ccflags="$ccflags -belf -w0 -U M_XENIX" - optimize="-O1" # -g -O1 will not work - # optimize="-O0" may be needed for pack test to pass. - lddlflags='-G -L/usr/local/lib' - ldflags=' -W l,-Bexport -L/usr/local/lib' - dlext='so' - dlsrc='dl_dlopen.xs' - usedl='define' - ;; - esac - ;; - -*) # Apparently, miniperl core dumps if -O is used. - case "$optimize" in - '') optimize=none ;; - esac - # Apparently, SCO's cc gives rather verbose warnings - # Set -w0 to turn them off. - case $scorls in - 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;; - 5) ccflags="$ccflags -w0 -U M_XENIX -DPERL_SCO5" ;; - esac - ;; -esac -i_varargs=undef - +############################################################### # I have received one report that nm extraction doesn't work if you're # using the scocc compiler. This system had the following 'myconfig' # uname='xxx xxx 3.2 2 i386 ' # cc='scocc', optimize='-O' -usenm='false' +# You can override this with Configure -Dusenm. +case "$usenm" in +'') usenm='false' ;; +esac +############################################################### # If you want to use nm, you'll probably have to use nm -p. The # following does that for you: nm_opt='-p' +############################################################### # I have received one report that you can't include utime.h in # pp_sys.c. Uncomment the following line if that happens to you: # i_utime=undef -# Apparently, some versions of SCO include both .so and .a libraries, -# but they don't mix as they do on other ELF systems. The upshot is -# that Configure finds -ldl (libdl.so) but 'ld' complains it can't -# find libdl.a. -# I don't know which systems have this feature, so I'll just remove -# -dl from libswanted for all SCO systems until someone can figure -# out how to get dynamic loading working on SCO. -# -# The output of uname -X on one such system was -# System = SCO_SV -# Node = xxxxx -# Release = 3.2v5.0.0 -# KernelID = 95/08/08 -# Machine = Pentium -# BusType = ISA -# Serial = xxxxx -# Users = 5-user -# OEM# = 0 -# Origin# = 1 -# NumCPU = 1 -# -# The 5.0.0 on the Release= line is probably the thing to watch. -# Andy Dougherty -# Thu Feb 1 15:06:56 EST 1996 -libswanted=`echo " $libswanted " | sed -e 's/ dl / /'` -set X $libswanted -shift -libswanted="$*" - +############################################################### # Perl 5.003_05 and later try to include both and # in pp_sys.c, but that fails due to a redefinition of struct timeval. # This will generate a WHOA THERE. Accept the default. i_sysselct=$undef + + +############################################################### +#END of hint file diff --git a/contrib/perl5/hints/solaris_2.sh b/contrib/perl5/hints/solaris_2.sh index 856f801..935f00d 100644 --- a/contrib/perl5/hints/solaris_2.sh +++ b/contrib/perl5/hints/solaris_2.sh @@ -261,25 +261,26 @@ rm -f core # XXX EOSH -if [ "X$usethreads" = "X$define" ]; then - ccflags="-D_REENTRANT $ccflags" - # -lpthread needs to come before -lc but after other libraries such - # as -lgdbm and such like. We assume here that -lc is present in - # libswanted. If that fails to be true in future, then this can be - # changed to add pthread to the very end of libswanted. - # sched_yield is in -lposix4 - set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'` - shift - libswanted="$*" - - # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp() - # when linked with the threads library, such that whatever positive value - # you pass to siglongjmp(), sigsetjmp() returns 1. - # Thanks to Simon Parsons for this report. - # Sun BugID is 4117946, "sigsetjmp always returns 1 when called by - # siglongjmp in a MT program". As of 19980622, there is no patch - # available. - cat >try.c <<'EOM' +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + ccflags="-D_REENTRANT $ccflags" + + # sched_yield is in -lposix4 + set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'` + shift + libswanted="$*" + + # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp() + # when linked with the threads library, such that whatever positive + # value you pass to siglongjmp(), sigsetjmp() returns 1. + # Thanks to Simon Parsons for this report. + # Sun BugID is 4117946, "sigsetjmp always returns 1 when called by + # siglongjmp in a MT program". As of 19980622, there is no patch + # available. + cat >try.c <<'EOM' /* Test for sig(set|long)jmp bug. */ #include @@ -293,18 +294,20 @@ if [ "X$usethreads" = "X$define" ]; then siglongjmp(env, 2); } EOM - if test "`arch`" = i86pc -a "$osvers" = 2.6 \ - && ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then - d_sigsetjmp=$undef - cat << 'EOM' >&2 + if test "`arch`" = i86pc -a "$osvers" = 2.6 && \ + ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then + d_sigsetjmp=$undef + cat << 'EOM' >&2 You will see a *** WHOA THERE!!! *** message from Configure for d_sigsetjmp. Keep the recommended value. See hints/solaris_2.sh for more information. EOM - fi -fi + fi + ;; +esac +EOCBU # This is just a trick to include some useful notes. cat > /dev/null <<'End_of_Solaris_Notes' diff --git a/contrib/perl5/hints/ultrix_4.sh b/contrib/perl5/hints/ultrix_4.sh index d8d2063..7b841e5 100644 --- a/contrib/perl5/hints/ultrix_4.sh +++ b/contrib/perl5/hints/ultrix_4.sh @@ -34,16 +34,16 @@ case "$cc" in *gcc*) ;; *) case "$osvers" in - *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200" ;; - *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200" + *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3400" ;; + *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3400" # Prototypes sometimes cause compilation errors in 4.2. prototype=undef case "$myuname" in *risc*) d_volatile=undef ;; esac ;; - *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3200" ;; - *) ccflags="$ccflags -std -Olimit 3200" ;; + *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3400" ;; + *) ccflags="$ccflags -std -Olimit 3400" ;; esac ;; esac diff --git a/contrib/perl5/hints/uwin.sh b/contrib/perl5/hints/uwin.sh new file mode 100644 index 0000000..0e5e11a --- /dev/null +++ b/contrib/perl5/hints/uwin.sh @@ -0,0 +1,36 @@ +# +# hint file for U/WIN (UNIX for Windows 95/NT) +# +# created for U/WIN version 1.55 +# running under Windows NT 4.0 SP 3 +# using MSVC++ 5.0 for the compiler +# +# created by Joe Buehler (jbuehler@hekimian.com) +# +# for information about U/WIN see www.gtlinc.com +# + +#ccflags=-D_BSDCOMPAT +# confusion in Configure over preprocessor +cppstdin=`pwd`/cppstdin +cpprun=`pwd`/cppstdin +# pwd.h confuses Configure +d_pwcomment=undef +d_pwgecos=define +# work around case-insensitive file names +firstmakefile=GNUmakefile +# avoid compilation error +i_utime=undef +# compile/link flags +ldflags=-g +optimize=-g +static_ext="B Data/Dumper Fcntl IO IPC/SysV Opcode POSIX SDBM_File Socket attrs" +#static_ext=none +# dynamic loading needs work +usedl=undef +# perl malloc will not work +usemymalloc=n +# cannot use nm +usenm=undef +# vfork() is buggy (as of 1.55 anyway) +usevfork=false diff --git a/contrib/perl5/hv.c b/contrib/perl5/hv.c index 40bb9b8..e0091ea 100644 --- a/contrib/perl5/hv.c +++ b/contrib/perl5/hv.c @@ -1,6 +1,6 @@ /* hv.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -18,7 +18,7 @@ static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); #ifndef PERL_OBJECT static void hsplit _((HV *hv)); static void hfreeentries _((HV *hv)); -static HE* more_he _((void)); +static void more_he _((void)); #endif #if defined(STRANGE_MALLOC) || defined(MYMALLOC) @@ -32,22 +32,25 @@ STATIC HE* new_he(void) { HE* he; - if (PL_he_root) { - he = PL_he_root; - PL_he_root = HeNEXT(he); - return he; - } - return more_he(); + LOCK_SV_MUTEX; + if (!PL_he_root) + more_he(); + he = PL_he_root; + PL_he_root = HeNEXT(he); + UNLOCK_SV_MUTEX; + return he; } STATIC void del_he(HE *p) { + LOCK_SV_MUTEX; HeNEXT(p) = (HE*)PL_he_root; PL_he_root = p; + UNLOCK_SV_MUTEX; } -STATIC HE* +STATIC void more_he(void) { register HE* he; @@ -60,7 +63,6 @@ more_he(void) he++; } HeNEXT(he) = 0; - return new_he(); } STATIC HEK * @@ -830,19 +832,18 @@ HV * newHVhv(HV *ohv) { register HV *hv; - register XPVHV* xhv; STRLEN hv_max = ohv ? HvMAX(ohv) : 0; STRLEN hv_fill = ohv ? HvFILL(ohv) : 0; hv = newHV(); while (hv_max && hv_max + 1 >= hv_fill * 2) hv_max = hv_max / 2; /* Is always 2^n-1 */ - ((XPVHV*)SvANY(hv))->xhv_max = hv_max; + HvMAX(hv) = hv_max; if (!hv_fill) return hv; #if 0 - if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) { + if (! SvTIED_mg((SV*)ohv, 'P')) { /* Quick way ???*/ } else @@ -853,7 +854,7 @@ newHVhv(HV *ohv) HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */ /* Slow way */ - hv_iterinit(hv); + hv_iterinit(ohv); while (entry = hv_iternext(ohv)) { hv_store(hv, HeKEY(entry), HeKLEN(entry), SvREFCNT_inc(HeVAL(entry)), HeHASH(entry)); @@ -1014,7 +1015,7 @@ hv_iternext(HV *hv) xhv = (XPVHV*)SvANY(hv); oldentry = entry = xhv->xhv_eiter; - if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { + if (mg = SvTIED_mg((SV*)hv, 'P')) { SV *key = sv_newmortal(); if (entry) { sv_setsv(key, HeSVKEY_force(entry)); @@ -1149,6 +1150,7 @@ unsharepvn(char *str, I32 len, U32 hash) } */ xhv = (XPVHV*)SvANY(PL_strtab); /* assert(xhv_array != 0) */ + LOCK_STRTAB_MUTEX; oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ @@ -1168,6 +1170,7 @@ unsharepvn(char *str, I32 len, U32 hash) } break; } + UNLOCK_STRTAB_MUTEX; if (!found) warn("Attempt to free non-existent shared string"); @@ -1193,6 +1196,7 @@ share_hek(char *str, I32 len, register U32 hash) */ xhv = (XPVHV*)SvANY(PL_strtab); /* assert(xhv_array != 0) */ + LOCK_STRTAB_MUTEX; oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ @@ -1219,6 +1223,7 @@ share_hek(char *str, I32 len, register U32 hash) } ++HeVAL(entry); /* use value slot as REFCNT */ + UNLOCK_STRTAB_MUTEX; return HeKEY_hek(entry); } diff --git a/contrib/perl5/hv.h b/contrib/perl5/hv.h index 19694ac..007892d 100644 --- a/contrib/perl5/hv.h +++ b/contrib/perl5/hv.h @@ -1,6 +1,6 @@ /* hv.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/installman b/contrib/perl5/installman index e637720..6fa4231 100755 --- a/contrib/perl5/installman +++ b/contrib/perl5/installman @@ -134,7 +134,7 @@ sub runpod2man { # Convert name from File/Basename.pm to File::Basename.3 format, # if necessary. $manpage =~ s#\.p(m|od)$##; - if ($^O eq 'os2' || $^O eq 'amigaos') { + if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin') { $manpage =~ s#/#.#g; } else { $manpage =~ s#/#::#g; diff --git a/contrib/perl5/installperl b/contrib/perl5/installperl index 2db72d4..b1d5bfb 100755 --- a/contrib/perl5/installperl +++ b/contrib/perl5/installperl @@ -220,6 +220,11 @@ else { @corefiles = <*.h libperl*.*>; # AIX needs perl.exp installed as well. push(@corefiles,'perl.exp') if $^O eq 'aix'; + if ($^O eq 'mpeix') { + # MPE needs mpeixish.h installed as well. + mkpath("$installarchlib/CORE/mpeix", 1, 0777); + push(@corefiles,'mpeix/mpeixish.h'); + } # If they have built sperl.o... push(@corefiles,'sperl.o') if -f 'sperl.o'; } @@ -251,7 +256,8 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM my $mainperl_is_instperl = 0; -if (!$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR +if ($Config{installusrbinperl} eq 'define' && + !$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR && -w $mainperldir && ! samepath($mainperldir, $installbin)) { my($usrbinperl) = "$mainperldir/$perl$exe_ext"; my($instperl) = "$installbin/$perl$exe_ext"; @@ -327,7 +333,7 @@ if (! $versiononly) { # Install pod pages. Where? I guess in $installprivlib/pod. -if (! $versiononly || !($installprivlib =~ m/\Q$]/)) { +unless ( $versiononly && !($installprivlib =~ m/\Q$]/)) { # as line 200 mkpath("${installprivlib}/pod", 1, 0777); # If Perl 5.003's perldiag.pod is there, rename it. @@ -564,8 +570,6 @@ sub installlib { and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444, "$installlib/$name"); } - } elsif (-d $_) { - mkpath("$installlib/$name", 1, 0777); } } diff --git a/contrib/perl5/intrpvar.h b/contrib/perl5/intrpvar.h index dfdcca8..1f6244d 100644 --- a/contrib/perl5/intrpvar.h +++ b/contrib/perl5/intrpvar.h @@ -199,6 +199,7 @@ PERLVAR(Isublex_info, SUBLEXINFO) /* from toke.c */ #ifdef USE_THREADS PERLVAR(Ithrsv, SV *) /* struct perl_thread for main thread */ PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ +PERLVAR(Istrtab_mutex, perl_mutex) /* Mutex for string table access */ #endif /* USE_THREADS */ PERLVARI(Ibytecode_iv_overflows,int, 0) /* from bytecode.h */ diff --git a/contrib/perl5/iperlsys.h b/contrib/perl5/iperlsys.h index 91389a2..da8c5d6 100644 --- a/contrib/perl5/iperlsys.h +++ b/contrib/perl5/iperlsys.h @@ -114,7 +114,7 @@ public: virtual int Printf(PerlIO*, int &err, const char *,...) = 0; virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0; virtual long Tell(PerlIO*, int &err) = 0; - virtual int Seek(PerlIO*, off_t, int, int &err) = 0; + virtual int Seek(PerlIO*, Off_t, int, int &err) = 0; virtual void Rewind(PerlIO*, int &err) = 0; virtual PerlIO * Tmpfile(int &err) = 0; virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0; @@ -322,10 +322,10 @@ extern int PerlIO_sprintf _((char *, int, const char *,...)) extern int PerlIO_vprintf _((PerlIO *, const char *, va_list)); #endif #ifndef PerlIO_tell -extern long PerlIO_tell _((PerlIO *)); +extern Off_t PerlIO_tell _((PerlIO *)); #endif #ifndef PerlIO_seek -extern int PerlIO_seek _((PerlIO *,off_t,int)); +extern int PerlIO_seek _((PerlIO *, Off_t, int)); #endif #ifndef PerlIO_rewind extern void PerlIO_rewind _((PerlIO *)); @@ -907,6 +907,7 @@ public: #define PerlSock_inet_addr(c) inet_addr(c) #define PerlSock_inet_ntoa(i) inet_ntoa(i) #define PerlSock_listen(s, b) listen(s, b) +#define PerlSock_recv(s, b, l, f) recv(s, b, l, f) #define PerlSock_recvfrom(s, b, l, f, from, fromlen) \ recvfrom(s, b, l, f, from, fromlen) #define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) diff --git a/contrib/perl5/lib/AutoLoader.pm b/contrib/perl5/lib/AutoLoader.pm index 666c6ca..5b083a7 100644 --- a/contrib/perl5/lib/AutoLoader.pm +++ b/contrib/perl5/lib/AutoLoader.pm @@ -178,7 +178,7 @@ such a file exists, AUTOLOAD will read and evaluate it, thus (presumably) defining the needed subroutine. AUTOLOAD will then C the newly defined subroutine. -Once this process completes for a given funtion, it is defined, so +Once this process completes for a given function, it is defined, so future calls to the subroutine will bypass the AUTOLOAD mechanism. =head2 Subroutine Stubs @@ -266,7 +266,7 @@ C<__DATA__>, after which routines are cached. B can also handle multiple packages in a file. B only reads code as it is requested, and in many cases -should be faster, but requires a machanism like B be used to +should be faster, but requires a mechanism like B be used to create the individual files. L will invoke B automatically if B is used in a module source file. diff --git a/contrib/perl5/lib/AutoSplit.pm b/contrib/perl5/lib/AutoSplit.pm index 121d261..f818371 100644 --- a/contrib/perl5/lib/AutoSplit.pm +++ b/contrib/perl5/lib/AutoSplit.pm @@ -11,7 +11,7 @@ use vars qw( $Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime ); -$VERSION = "1.0302"; +$VERSION = "1.0303"; @ISA = qw(Exporter); @EXPORT = qw(&autosplit &autosplit_lib_modules); @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); @@ -219,7 +219,7 @@ sub autosplit_file { while () { # Skip pod text. $fnr++; - $in_pod = 1 if /^=/; + $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); diff --git a/contrib/perl5/lib/Benchmark.pm b/contrib/perl5/lib/Benchmark.pm index a28f510..ef12d02 100644 --- a/contrib/perl5/lib/Benchmark.pm +++ b/contrib/perl5/lib/Benchmark.pm @@ -124,6 +124,11 @@ The COUNT can be zero or negative, see timethis(). Returns the difference between two Benchmark times as a Benchmark object suitable for passing to timestr(). +=item timesum ( T1, T2 ) + +Returns the sum of two Benchmark times as a Benchmark object suitable +for passing to timestr(). + =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] ) Returns a string that formats the times in the TIMEDIFF object in @@ -293,6 +298,15 @@ sub timediff { bless \@r; } +sub timesum { + my($a, $b) = @_; + my @r; + for (my $i=0; $i < @$a; ++$i) { + push(@r, $a->[$i] + $b->[$i]); + } + bless \@r; +} + sub timestr { my($tr, $style, $f) = @_; my @t = @$tr; diff --git a/contrib/perl5/lib/CGI.pm b/contrib/perl5/lib/CGI.pm index 22d91a4..f5615f2 100644 --- a/contrib/perl5/lib/CGI.pm +++ b/contrib/perl5/lib/CGI.pm @@ -15,11 +15,10 @@ require 5.004; # listing the modifications you have made. # The most recent version and complete docs are available at: -# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html -# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ +# http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.32 1998/05/28 21:55:43 lstein Exp lstein $'; -$CGI::VERSION='2.42'; +$CGI::revision = '$Id: CGI.pm,v 1.5 1998/12/06 10:19:48 lstein Exp $'; +$CGI::VERSION='2.46'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. @@ -59,6 +58,12 @@ sub initialize_globals { # Change this to 1 to disable uploads entirely: $DISABLE_UPLOADS = 0; + # Change this to 1 to suppress redundant HTTP headers + $HEADERS_ONCE = 0; + + # separate the name=value pairs by semicolons rather than ampersands + $USE_PARAM_SEMICOLONS = 0; + # Other globals that you shouldn't worry about. undef $Q; $BEEN_THERE = 0; @@ -116,8 +121,9 @@ $SL = { $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; # Turn on special checking for Doug MacEachern's modperl -if (defined($ENV{'GATEWAY_INTERFACE'}) && - ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)) +if (exists $ENV{'GATEWAY_INTERFACE'} + && + ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/)) { $| = 1; require Apache; @@ -151,20 +157,21 @@ if ($needs_binmode) { tt u i b blockquote pre img a address cite samp dfn html head base body Link nextid title meta kbd start_html end_html input Select option comment/], - ':html3'=>[qw/div table caption th td TR Tr sup sub strike applet Param + ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param embed basefont style span layer ilayer font frameset frame script small big/], ':netscape'=>[qw/blink fontsize center/], ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group submit reset defaults radio_group popup_menu button autoEscape scrolling_list image_button start_form end_form startform endform - start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], - ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump - raw_cookie request_method query_string accept user_agent remote_host + start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], + ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie Dump + raw_cookie request_method query_string Accept user_agent remote_host remote_addr referer server_name server_software server_port server_protocol virtual_host remote_ident auth_type http use_named_parameters save_parameters restore_parameters param_fetch remote_user user_name header redirect import_names put Delete Delete_all url_param/], ':ssl' => [qw/https/], + ':imagemap' => [qw/Area Map/], ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/], ':html' => [qw/:html2 :html3 :netscape/], ':standard' => [qw/:html2 :html3 :form :cgi/], @@ -206,6 +213,7 @@ sub compile { sub expand_tags { my($tag) = @_; + return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/; my(@r); return ($tag) unless $EXPORT_TAGS{$tag}; foreach (@{$EXPORT_TAGS{$tag}}) { @@ -273,7 +281,7 @@ sub param { $name = $p[0]; } - return () unless defined($name) && $self->{$name}; + return unless defined($name) && $self->{$name}; return wantarray ? @{$self->{$name}} : $self->{$name}->[0]; } @@ -315,6 +323,7 @@ sub self_or_CGI { sub init { my($self,$initializer) = @_; my($query_string,$meth,$content_length,$fh,@lines) = ('','','',''); + local($/) = "\n"; # if we get called more than once, we want to initialize # ourselves from the original query (which may be gone @@ -341,7 +350,7 @@ sub init { && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data| && !defined($initializer) ) { - my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";]+)\"?/; + my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/; $self->read_multipart($boundary,$content_length); last METHOD; } @@ -496,7 +505,7 @@ sub save_request { sub parse_params { my($self,$tosplit) = @_; - my(@pairs) = split('&',$tosplit); + my(@pairs) = split(/[&;]/,$tosplit); my($param,$value); foreach (@pairs) { ($param,$value) = split('=',$_,2); @@ -526,11 +535,9 @@ sub binmode { } sub _make_tag_func { - my $tagname = shift; - return qq{ + my ($self,$tagname) = @_; + my $func = qq# sub $tagname { - # handle various cases in which we're called - # most of this bizarre stuff is to avoid -w errors shift if \$_[0] && (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) || (ref(\$_[0]) && @@ -542,12 +549,20 @@ sub _make_tag_func { my(\@attr) = make_attributes( '',shift() ); \$attr = " \@attr" if \@attr; } + #; + if ($tagname=~/start_(\w+)/i) { + $func .= qq! return "<\U$1\E\$attr>";} !; + } elsif ($tagname=~/end_(\w+)/i) { + $func .= qq! return "<\U/$1\E>"; } !; + } else { + $func .= qq# my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U\E"); return \$tag unless \@_; my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; return "\@result"; - } -} + }#; + } +return $func; } sub AUTOLOAD { @@ -619,12 +634,13 @@ sub _compile { $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY'); if (!$code) { + (my $base = $func_name) =~ s/^(start_|end_)//i; if ($EXPORT{':any'} || $EXPORT{'-any'} || - $EXPORT{$func_name} || + $EXPORT{$base} || (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html'))) - && $EXPORT_OK{$func_name}) { - $code = _make_tag_func($func_name); + && $EXPORT_OK{$base}) { + $code = $CGI::DefaultClass->_make_tag_func($func_name); } } die "Undefined subroutine $AUTOLOAD\n" unless $code; @@ -644,14 +660,15 @@ sub _setup_symbols { my $self = shift; my $compile = 0; foreach (@_) { - $NPH++, next if /^[:-]nph$/; - $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/; - $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; - $EXPORT{$_}++, next if /^[:-]any$/; - $compile++, next if /^[:-]compile$/; + $HEADERS_ONCE++, next if /^[:-]unique_headers$/; + $NPH++, next if /^[:-]nph$/; + $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/; + $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/; + $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; + $EXPORT{$_}++, next if /^[:-]any$/; + $compile++, next if /^[:-]compile$/; - # This is probably extremely evil code -- to be deleted - # some day. + # This is probably extremely evil code -- to be deleted some day. if (/^[-]autoload$/) { my($pkg) = caller(1); *{"${pkg}::AUTOLOAD"} = sub { @@ -978,7 +995,7 @@ sub url_param { unless (exists($self->{'.url_param'})) { $self->{'.url_param'}={}; # empty hash if ($ENV{QUERY_STRING} =~ /=/) { - my(@pairs) = split('&',$ENV{QUERY_STRING}); + my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING}); my($param,$value); foreach (@pairs) { ($param,$value) = split('=',$_,2); @@ -1043,6 +1060,7 @@ sub save { $filehandle = to_filehandle($filehandle); my($param); local($,) = ''; # set print field separator back to a sane value + local($\) = ''; # set output line separator to a sane value foreach $param ($self->param) { my($escaped_param) = escape($param); my($value); @@ -1141,18 +1159,21 @@ sub header { my($self,@p) = self_or_default(@_); my(@header); + return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE; + my($type,$status,$cookie,$target,$expires,$nph,@other) = - $self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p); + $self->rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], + STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p); $nph ||= $NPH; # rearrange() was designed for the HTML portion, so we # need to fix it up a little. foreach (@other) { - next unless my($header,$value) = /([^\s=]+)=\"?([^\"]+)\"?/; + next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/; ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e; } - $type = $type || 'text/html'; + $type ||= 'text/html' unless defined($type); # Maybe future compatibility. Maybe not. my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; @@ -1164,7 +1185,8 @@ sub header { if ($cookie) { my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie; foreach (@cookie) { - push(@header,"Set-Cookie: " . (UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_)); + my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_; + push(@header,"Set-Cookie: $cs") if $cs ne ''; } } # if the user indicates an expiration time, then we need @@ -1175,7 +1197,7 @@ sub header { push(@header,"Date: " . expires(0,'http')) if $expires || $cookie; push(@header,"Pragma: no-cache") if $self->cache(); push(@header,@other); - push(@header,"Content-Type: $type"); + push(@header,"Content-Type: $type") if $type ne ''; my $header = join($CRLF,@header)."${CRLF}${CRLF}"; if ($MOD_PERL and not $nph) { @@ -1221,6 +1243,7 @@ sub redirect { '-nph'=>$nph); unshift(@o,'-Target'=>$target) if $target; unshift(@o,'-Cookie'=>$cookie) if $cookie; + unshift(@o,'-Type'=>''); return $self->header(@o); } END_OF_FUNC @@ -1407,6 +1430,11 @@ sub start_form { } END_OF_FUNC +'end_multipart_form' => <<'END_OF_FUNC', +sub end_multipart_form { + &endform; +} +END_OF_FUNC #### Method: start_multipart_form # synonym for startform @@ -1459,8 +1487,11 @@ sub _textfield { $name = defined($name) ? $self->escapeHTML($name) : ''; my($s) = defined($size) ? qq/ SIZE=$size/ : ''; my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : ''; - my($other) = @other ? " @other" : ''; - return qq//; + my($other) = @other ? " @other" : ''; + # this entered at cristy's request to fix problems with file upload fields + # and WebTV -- not sure it won't break stuff + my($value) = $current ne '' ? qq(VALUE="$current") : ''; + return qq//; } END_OF_FUNC @@ -1787,12 +1818,17 @@ END_OF_FUNC sub unescapeHTML { my $string = ref($_[0]) ? $_[1] : $_[0]; return undef unless defined($string); - $string=~s/&/&/ig; - $string=~s/"/\"/ig; - $string=~s/>/>/ig; - $string=~s/</" : + /^lt$/i ? "<" : + /^#(\d+)$/ ? chr($1) : + /^#x([0-9a-f]+)$/i ? chr(hex($1)) : + $_ + }gex; return $string; } END_OF_FUNC @@ -1867,14 +1903,13 @@ sub radio_group { } else { $checked = $default; } - # If no check array is specified, check the first by default - $checked = $values->[0] unless defined($checked) && $checked ne ''; - $name=$self->escapeHTML($name); - my(@elements,@values); - @values = $self->_set_values_and_labels($values,\$labels,$name); + # If no check array is specified, check the first by default + $checked = $values[0] unless defined($checked) && $checked ne ''; + $name=$self->escapeHTML($name); + my($other) = @other ? " @other" : ''; foreach (@values) { my($checkit) = $checked eq $_ ? ' CHECKED' : ''; @@ -2321,7 +2356,7 @@ sub query_string { push(@pairs,"$eparam=$value"); } } - return join("&",@pairs); + return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs); } END_OF_FUNC @@ -2337,8 +2372,8 @@ END_OF_FUNC # declares a quantitative score for it. # This handles MIME type globs correctly. #### -'accept' => <<'END_OF_FUNC', -sub accept { +'Accept' => <<'END_OF_FUNC', +sub Accept { my($self,$search) = self_or_CGI(@_); my(%prefs,$type,$pref,$pat); @@ -2758,6 +2793,7 @@ sub read_multipart { chmod 0600,$tmp; # only the owner can tamper with it my ($data); + local($\) = ''; while (defined($data = $buffer->read)) { print $filehandle $data; } @@ -2841,10 +2877,18 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; 'asString' => <<'END_OF_FUNC', sub asString { my $self = shift; - my $i = $$self; - $i=~ s/^\*(\w+::)+//; # get rid of package name + # get rid of package name + (my $i = $$self) =~ s/^\*(\w+::)+//; $i =~ s/\\(.)/$1/g; return $i; +# BEGIN DEAD CODE +# This was an extremely clever patch that allowed "use strict refs". +# Unfortunately it relied on another bug that caused leaky file descriptors. +# The underlying bug has been fixed, so this no longer works. However +# "strict refs" still works for some reason. +# my $self = shift; +# return ${*{$self}{SCALAR}}; +# END DEAD CODE } END_OF_FUNC @@ -2861,11 +2905,12 @@ sub new { my($pack,$name,$file,$delete) = @_; require Fcntl unless defined &Fcntl::O_RDWR; ++$FH; - *{$FH} = quotemeta($name); - sysopen($FH,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL()) + my $ref = \*{'Fh::' . quotemeta($name)}; + sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL()) || die "CGI open of $file: $!\n"; unlink($file) if $delete; - return bless \*{$FH},$pack; + delete $Fh::{$FH}; + return bless $ref,$pack; } END_OF_FUNC @@ -2883,10 +2928,10 @@ END_OF_AUTOLOAD package MultipartBuffer; # how many bytes to read at a time. We use -# a 5K buffer by default. -$INITIAL_FILLUNIT = 1024 * 5; -$TIMEOUT = 10*60; # 10 minute timeout -$SPIN_LOOP_MAX = 1000; # bug fix for some Netscape servers +# a 4K buffer by default. +$INITIAL_FILLUNIT = 1024 * 4; +$TIMEOUT = 240*60; # 4 hour timeout for big files +$SPIN_LOOP_MAX = 2000; # bug fix for some Netscape servers $CRLF=$CGI::CRLF; #reuse the autoload function @@ -2930,8 +2975,8 @@ sub new { # characters "--" PLUS the Boundary string # BUG: IE 3.01 on the Macintosh uses just the boundary -- not - # the two extra spaces. We do a special case here on the user-agent!!!! - $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; Mac'); + # the two extra hyphens. We do a special case here on the user-agent!!!! + $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; ?Mac'); } else { # otherwise we find it ourselves my($old); @@ -3088,6 +3133,7 @@ sub fillBuffer { \$self->{BUFFER}, $bytesToRead, $bufferLength); + $self->{BUFFER} = '' unless defined $self->{BUFFER}; # An apparent bug in the Apache server causes the read() # to return zero bytes repeatedly without blocking if the @@ -3129,7 +3175,7 @@ $MAC = $CGI::OS eq 'MACINTOSH'; my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : ""; unless ($TMPDIRECTORY) { @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", - "${SL}tmp","${SL}temp","${vol}${SL}Temporary Items", + "C:${SL}temp","${SL}tmp","${SL}temp","${vol}${SL}Temporary Items", "${SL}WWW_ROOT"); foreach (@TEMP) { do {$TMPDIRECTORY = $_; last} if -d $_ && -w _; @@ -3273,10 +3319,10 @@ the CGI script, and because each object's parameter list is independent of the others, this allows you to save the state of the script and restore it later. -For example, using the object oriented style, here is now you create +For example, using the object oriented style, here is how you create a simple "Hello World" HTML page: - #!/usr/local/bin/pelr + #!/usr/local/bin/perl use CGI; # load CGI routines $q = new CGI; # create new CGI object print $q->header, # create the HTTP header @@ -3294,7 +3340,7 @@ The main differences are that we now need to import a set of functions into our name space (usually the "standard" functions), and we don't need to create the CGI object. - #!/usr/local/bin/pelr + #!/usr/local/bin/perl use CGI qw/:standard/; # load standard CGI routines print header, # create the HTTP header start_html('hello world'), # start the HTML @@ -3319,7 +3365,7 @@ acceptable. In fact, only the first argument needs to begin with a dash. If a dash is present in the first argument, CGI.pm assumes dashes for the subsequent ones. -You don't have to use the hyphen at allif you don't want to. After +You don't have to use the hyphen at all if you don't want to. After creating a CGI object, call the B method with a nonzero value. This will tell CGI.pm that you intend to use named parameters exclusively: @@ -3667,7 +3713,7 @@ methods, and then use them directly: $zipcode = param('zipcode'); More frequently, you'll import common sets of functions by referring -to the gropus by name. All function sets are preceded with a ":" +to the groups by name. All function sets are preceded with a ":" character as in ":html3" (for tags defined in the HTML 3 standard). Here is a list of the function sets you can import: @@ -3719,7 +3765,7 @@ provide for the rapidly-evolving HTML "standard." For example, say Microsoft comes out with a new tag called (which causes the user's desktop to be flooded with a rotating gradient fill until his machine reboots). You don't need to wait for a new version of CGI.pm -to start using it immeidately: +to start using it immediately: use CGI qw/:standard :html3 gradient/; print gradient({-start=>'red',-end=>'blue'}); @@ -3799,7 +3845,7 @@ This causes the indicated autoloaded methods to be compiled up front, rather than deferred to later. This is useful for scripts that run for an extended period of time under FastCGI or mod_perl, and for those destined to be crunched by Malcom Beattie's Perl compiler. Use -it in conjunction with the methods or method familes you plan to use. +it in conjunction with the methods or method families you plan to use. use CGI qw(-compile :standard :html3); @@ -3819,6 +3865,17 @@ parsed header) script. You may need to do other things as well to tell the server that the script is NPH. See the discussion of NPH scripts below. +=item -newstyle_urls + +Separate the name=value pairs in CGI parameter query strings with +semicolons rather than ampersands. For example: + + ?name=fred;age=24;favorite_color=3 + +Semicolon-delimited query strings are always accepted, but will not be +emitted by self_url() and query_string() unless the -newstyle_urls +pragma is specified. + =item -autoload This overrides the autoloader so that any function in your program @@ -3859,7 +3916,51 @@ upload, even if it is confidential information. On Unix systems, the -private_tempfiles pragma will cause the temporary file to be unlinked as soon as it is opened and before any data is written into it, eliminating the risk of eavesdropping. -n + +=back + +=head2 SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS + +Many of the methods generate HTML tags. As described below, tag +functions automatically generate both the opening and closing tags. +For example: + + print h1('Level 1 Header'); + +produces + +

    Level 1 Header

    + +There will be some times when you want to produce the start and end +tags yourself. In this case, you can use the form start_I +and end_I, as in: + + print start_h1,'Level 1 Header',end_h1; + +With a few exceptions (described below), start_I and +end_I functions are not generated automatically when you +I. However, you can specify the tags you want to generate +I functions for by putting an asterisk in front of their +name, or, alternatively, requesting either "start_I" or +"end_I" in the import list. + +Example: + + use CGI qw/:standard *table start_ul/; + +In this example, the following functions are generated in addition to +the standard ones: + +=over 4 + +=item 1. start_table() (generates a tag) + +=item 2. end_table() (generates a
    tag) + +=item 3. start_ul() (generates a
      tag) + +=item 4. end_ul() (generates a
    tag) + =back =head1 GENERATING DYNAMIC DOCUMENTS @@ -4247,6 +4348,25 @@ as a synonym. =back +=head2 MIXING POST AND URL PARAMETERS + + $color = $query->url_param('color'); + +It is possible for a script to receive CGI parameters in the URL as +well as in the fill-out form by creating a form that POSTs to a URL +containing a query string (a "?" mark followed by arguments). The +B method will always return the contents of the POSTed +fill-out form, ignoring the URL's query string. To retrieve URL +parameters, call the B method. Use it in the same way as +B. The main difference is that it allows you to read the +parameters, but not set them. + + +Under no circumstances will the contents of the URL query string +interfere with similarly-named CGI parameters in POSTed forms. If you +try to mix a URL query string with a form submitted with the GET +method, the results will not be what you expect. + =head1 CREATING STANDARD HTML ELEMENTS: CGI.pm defines general HTML shortcut methods for most, if not all of @@ -4325,7 +4445,7 @@ that points to an undef string: Prior to CGI.pm version 2.41, providing an empty ('') string as an attribute argument was the same as providing undef. However, this has -changed in order to accomodate those who want to create tags of the form +changed in order to accommodate those who want to create tags of the form . The difference is shown in these two pieces of code: CODE RESULT @@ -4410,11 +4530,21 @@ begin with initial caps: Tr Link Delete + Accept + Sub In addition, start_html(), end_html(), start_form(), end_form(), start_multipart_form() and all the fill-out form tags are special. See their respective sections. +=head2 PRETTY-PRINTING HTML + +By default, all the HTML produced by these functions comes out as one +long line without carriage returns or indentation. This is yuck, but +it does reduce the size of the documents by 10-20%. To get +pretty-printed output, please use L, a subclass +contributed by Brian Paulsen. + =head1 CREATING FILL-OUT FORMS: I The various form-creating methods all return strings @@ -4469,7 +4599,7 @@ default is to process the query with the current script. print $query->startform(-method=>$method, -action=>$action, - -encoding=>$encoding); + -enctype=>$encoding); <... various form stuff ...> print $query->endform; @@ -4484,11 +4614,11 @@ action and form encoding that you specify. The defaults are: method: POST action: this script - encoding: application/x-www-form-urlencoded + enctype: application/x-www-form-urlencoded endform() returns the closing tag. -Startform()'s encoding method tells the browser how to package the various +Startform()'s enctype argument tells the browser how to package the various fields of the form before sending the form to the server. Two values are possible: @@ -4671,12 +4801,11 @@ The first parameter is the required name for the field (-name). The optional second parameter is the starting value for the field contents to be used as the default file name (-default). -The beta2 version of Netscape 2.0 currently doesn't pay any attention -to this field, and so the starting value will always be blank. Worse, -the field loses its "sticky" behavior and forgets its previous -contents. The starting value field is called for in the HTML -specification, however, and possibly later versions of Netscape will -honor it. +For security reasons, browsers don't pay any attention to this field, +and so the starting value will always be blank. Worse, the field +loses its "sticky" behavior and forgets its previous contents. The +starting value field is called for in the HTML specification, however, +and possibly some browser will eventually provide support for it. =item 3. @@ -5093,7 +5222,7 @@ To include row and column headings in the returned table, you can use the B<-rowheader> and B<-colheader> parameters. Both of these accept a pointer to an array of headings to use. The headings are just decorative. They don't reorganize the -interpetation of the radio buttons -- they're still a single named +interpretation of the radio buttons -- they're still a single named unit. =back @@ -5157,6 +5286,9 @@ reset() creates the "reset" button. Note that it restores the form to its value from the last time the script was called, NOT necessarily to the defaults. +Note that this conflicts with the Perl reset() built-in. Use +CORE::reset() to get the original reset function. + =head2 CREATING A DEFAULT BUTTON print $query->defaults('button_label') @@ -5263,11 +5395,12 @@ pointed to by the B<-onClick> parameter will be executed. On non-Netscape browsers this form element will probably not even display. -=head1 NETSCAPE COOKIES +=head1 HTTP COOKIES -Netscape browsers versions 1.1 and higher support a so-called -"cookie" designed to help maintain state within a browser session. -CGI.pm has several methods that support cookies. +Netscape browsers versions 1.1 and higher, and all versions of +Internet Explorer, support a so-called "cookie" designed to help +maintain state within a browser session. CGI.pm has several methods +that support cookies. A cookie is a name=value pair much like the named parameters in a CGI query string. CGI scripts create one or more cookies and send @@ -5285,15 +5418,15 @@ optional attributes: This is a time/date string (in a special GMT format) that indicates when a cookie expires. The cookie will be saved and returned to your script until this expiration date is reached if the user exits -Netscape and restarts it. If an expiration date isn't specified, the cookie -will remain active until the user quits Netscape. +the browser and restarts it. If an expiration date isn't specified, the cookie +will remain active until the user quits the browser. =item 2. a domain This is a partial or complete domain name for which the cookie is valid. The browser will return the cookie to any host that matches the partial domain name. For example, if you specify a domain name -of ".capricorn.com", then Netscape will return the cookie to +of ".capricorn.com", then the browser will return the cookie to Web servers running on any of the machines "www.capricorn.com", "www2.capricorn.com", "feckless.capricorn.com", etc. Domain names must contain at least two periods to prevent attempts to match @@ -5318,7 +5451,7 @@ script if the CGI request is occurring on a secure channel, such as SSL. =back -The interface to Netscape cookies is the B method: +The interface to HTTP cookies is the B method: $cookie = $query->cookie(-name=>'sessionID', -value=>'xyzzy', @@ -5335,7 +5468,7 @@ B creates a new cookie. Its parameters include: =item B<-name> The name of the cookie (required). This can be any string at all. -Although Netscape limits its cookie names to non-whitespace +Although browsers limit their cookie names to non-whitespace alphanumeric characters, CGI.pm removes this restriction by escaping and unescaping cookies behind the scenes. @@ -5406,19 +5539,11 @@ simple to turn a CGI parameter into a cookie, and vice-versa: See the B example script for some ideas on how to use cookies effectively. -B There appear to be some (undocumented) restrictions on -Netscape cookies. In Netscape 2.01, at least, I haven't been able to -set more than three cookies at a time. There may also be limits on -the length of cookies. If you need to store a lot of information, -it's probably better to create a unique session ID, store it in a -cookie, and use the session ID to locate an external file/database -saved on the server's side of the connection. - -=head1 WORKING WITH NETSCAPE FRAMES +=head1 WORKING WITH FRAMES -It's possible for CGI.pm scripts to write into several browser -panels and windows using Netscape's frame mechanism. -There are three techniques for defining new frames programmatically: +It's possible for CGI.pm scripts to write into several browser panels +and windows using the HTML 4 frame mechanism. There are three +techniques for defining new frames programmatically: =over 4 @@ -5441,12 +5566,12 @@ You may provide a B<-target> parameter to the header() method: print $q->header(-target=>'ResultsWindow'); -This will tell Netscape to load the output of your script into the -frame named "ResultsWindow". If a frame of that name doesn't -already exist, Netscape will pop up a new window and load your -script's document into that. There are a number of magic names -that you can use for targets. See the frame documents on Netscape's -home pages for details. +This will tell the browser to load the output of your script into the +frame named "ResultsWindow". If a frame of that name doesn't already +exist, the browser will pop up a new window and load your script's +document into that. There are a number of magic names that you can +use for targets. See the frame documents on Netscape's home pages for +details. =item 3. Specify the destination for the document in the
    tag @@ -5591,13 +5716,8 @@ Produces something that looks like: -You can pass a value of 'true' to dump() in order to get it to -print the results out as plain text, suitable for incorporating -into a
     section.
    -
    -As a shortcut, as of version 1.56 you can interpolate the entire CGI
    -object into a string and it will be replaced with the a nice HTML dump
    -shown above:
    +As a shortcut, you can interpolate the entire CGI object into a string
    +and it will be replaced with the a nice HTML dump shown above:
     
         $query=new CGI;
         print "

    Current Values

    $query\n"; @@ -5609,24 +5729,25 @@ through this interface. The methods are as follows: =over 4 -=item B +=item B + +Return a list of MIME types that the remote browser accepts. If you +give this method a single argument corresponding to a MIME type, as in +$query->Accept('text/html'), it will return a floating point value +corresponding to the browser's preference for this type from 0.0 +(don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept +list are handled correctly. -Return a list of MIME types that the remote browser -accepts. If you give this method a single argument -corresponding to a MIME type, as in -$query->accept('text/html'), it will return a -floating point value corresponding to the browser's -preference for this type from 0.0 (don't want) to 1.0. -Glob types (e.g. text/*) in the browser's accept list -are handled correctly. +Note that the capitalization changed between version 2.43 and 2.44 in +order to avoid conflict with Perl's accept() function. =item B Returns the HTTP_COOKIE variable, an HTTP extension implemented by -Netscape browsers version 1.1 and higher. Cookies have a special -format, and this method call just returns the raw form (?cookie -dough). See cookie() for ways of setting and retrieving cooked -cookies. +Netscape browsers version 1.1 and higher, and all versions of Internet +Explorer. Cookies have a special format, and this method call just +returns the raw form (?cookie dough). See cookie() for ways of +setting and retrieving cooked cookies. Called with no parameters, raw_cookie() returns the packed cookie structure. You can separate it into individual cookies by splitting @@ -5708,10 +5829,9 @@ verification, if this script is protected. =item B -Attempt to obtain the remote user's name, using a variety -of different techniques. This only works with older browsers -such as Mosaic. Netscape does not reliably report the user -name! +Attempt to obtain the remote user's name, using a variety of different +techniques. This only works with older browsers such as Mosaic. +Newer browsers do not report the user name for privacy reasons! =item B @@ -5935,14 +6055,17 @@ of CGI.pm without rewriting your old scripts from scratch. =head1 AUTHOR INFORMATION -Copyright 1995-1997, Lincoln D. Stein. All rights reserved. It may -be used and modified freely, but I do request that this copyright -notice remain attached to the file. You may modify this module as you -wish, but if you redistribute a modified version, please attach a note -listing the modifications you have made. +Copyright 1995-1998, Lincoln D. Stein. All rights reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. -Address bug reports and comments to: -lstein@genome.wi.mit.edu +Address bug reports and comments to: lstein@cshl.org. When sending +bug reports, please provide the version of CGI.pm, the version of +Perl, the name and version of your Web server, and the name and +version of the operating system you are using. If the problem is even +remotely browser dependent, please provide information about the +affected browers as well. =head1 CREDITS @@ -5962,7 +6085,7 @@ Thanks very much to: =item Joergen Haegg (jh@axis.se) -=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu) +=item Laurent Delfosse (delfosse@delfosse.com) =item Richard Resnick (applepi1@aol.com) @@ -6054,7 +6177,7 @@ for suggestions and bug fixes. -rows=>10, -columns=>50); - print "

    ",$query->reset; + print "

    ",$query->Reset; print $query->submit('Action','Shout'); print $query->submit('Action','Scream'); print $query->endform; @@ -6095,8 +6218,8 @@ warnings when programs are run with the B<-w> switch. =head1 SEE ALSO L, L, L, L, -L, L, L, L, -L, L +L, L, L, L, +L =cut diff --git a/contrib/perl5/lib/CGI/Apache.pm b/contrib/perl5/lib/CGI/Apache.pm index eed3e55..82a3669 100644 --- a/contrib/perl5/lib/CGI/Apache.pm +++ b/contrib/perl5/lib/CGI/Apache.pm @@ -78,7 +78,7 @@ CGI::Apache - Make things work with CGI.pm against Perl-Apache API =head1 DESCRIPTION When using the Perl-Apache API, your applications are faster, but the -enviroment is different than CGI. +environment is different than CGI. This module attempts to set-up that environment as best it can. =head1 NOTE 1 diff --git a/contrib/perl5/lib/CGI/Carp.pm b/contrib/perl5/lib/CGI/Carp.pm index e20f754..dfae1a6 100644 --- a/contrib/perl5/lib/CGI/Carp.pm +++ b/contrib/perl5/lib/CGI/Carp.pm @@ -14,6 +14,12 @@ B - CGI routines for writing to the HTTPD (or other) error log warn "I'm confused"; die "I'm dying.\n"; + use CGI::Carp qw(cluck); + cluck "I wouldn't do that if I were you"; + + use CGI::Carp qw(fatalsToBrowser); + die "Fatal error messages are now sent to browser"; + =head1 DESCRIPTION CGI scripts have a nasty habit of leaving warning messages in the error @@ -155,11 +161,21 @@ set_message() from within a BEGIN{} block. 1.10 Patch from Chris Dean (ctdean@cogit.com) to allow module to run correctly under mod_perl. +1.11 Changed order of > and < escapes. + +1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning. + +1.13 Added cluck() to make the module orthogonal with Carp. + More mod_perl related fixes. + =head1 AUTHORS -Lincoln D. Stein . Feel free to redistribute -this under the Perl Artistic License. +Copyright 1995-1998, Lincoln D. Stein. All rights reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. +Address bug reports and comments to: lstein@cshl.org =head1 SEE ALSO @@ -174,11 +190,11 @@ use Carp; @ISA = qw(Exporter); @EXPORT = qw(confess croak carp); -@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message); +@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck); $main::SIG{__WARN__}=\&CGI::Carp::warn; $main::SIG{__DIE__}=\&CGI::Carp::die; -$CGI::Carp::VERSION = '1.101'; +$CGI::Carp::VERSION = '1.13'; $CGI::Carp::CUSTOM_MSG = undef; # fancy import routine detects and handles 'errorWrap' specially. @@ -194,7 +210,6 @@ sub import { } # These are the originals -# XXX Why not just use CORE::die etc., instead of these two? GSAR sub realwarn { CORE::warn(@_); } sub realdie { CORE::die(@_); } @@ -230,8 +245,7 @@ sub warn { # eval. These evals don't count when looking at the stack backtrace. sub _longmess { my $message = Carp::longmess(); - my $mod_perl = ($ENV{'GATEWAY_INTERFACE'} - && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//); + my $mod_perl = exists $ENV{MOD_PERL}; $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl; return( $message ); } @@ -240,7 +254,7 @@ sub die { my $message = shift; my $time = scalar(localtime); my($file,$line,$id) = id(1); - $message .= " at $file line $line.\n" unless $message=~/\n$/; + $message .= " at $file line $line." unless $message=~/\n$/; &fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m; my $stamp = stamp; $message=~s/^/$stamp/gm; @@ -258,8 +272,9 @@ sub set_message { local $^W=0; eval <&STDERR"); open(STDERR, ">&$no") or @@ -279,9 +294,9 @@ sub carpout { # headers sub fatalsToBrowser { my($msg) = @_; + $msg=~s/&/&/g; $msg=~s/>/>/g; $msg=~s/$ENV{SERVER_ADMIN})] : @@ -291,7 +306,9 @@ For help, please send mail to $wm, giving this error message and the time and date of the error. END ; - print STDOUT "Content-type: text/html\n\n"; + my $mod_perl = exists $ENV{MOD_PERL}; + print STDOUT "Content-type: text/html\n\n" + unless $mod_perl; if ($CUSTOM_MSG) { if (ref($CUSTOM_MSG) eq 'CODE') { @@ -302,13 +319,30 @@ END } } - print STDOUT <Software error: $msg

    -$outer_message; +$outer_message END ; + + if ($mod_perl) { + my $r = Apache->request; + # If bytes have already been sent, then + # we print the message out directly. + # Otherwise we make a custom error + # handler to produce the doc for us. + if ($r->bytes_sent) { + $r->print($mess); + $r->exit; + } else { + $r->status(500); + $r->custom_response(500,$mess); + } + } else { + print STDOUT $mess; + } } # Cut and paste from CGI.pm so that we don't have the overhead of diff --git a/contrib/perl5/lib/CGI/Cookie.pm b/contrib/perl5/lib/CGI/Cookie.pm index c32891a..204d67b 100644 --- a/contrib/perl5/lib/CGI/Cookie.pm +++ b/contrib/perl5/lib/CGI/Cookie.pm @@ -69,7 +69,9 @@ sub parse { my($key,$value) = split("="); my(@values) = map CGI::unescape($_),split('&',$value); $key = CGI::unescape($key); - $results{$key} = $self->new(-name=>$key,-value=>\@values); + # A bug in Netscape can cause several cookies with same name to + # appear. The FIRST one in HTTP_COOKIE is the most recent version. + $results{$key} ||= $self->new(-name=>$key,-value=>\@values); } return \%results unless wantarray; return %results; @@ -399,13 +401,12 @@ Get or set the cookie's expiration time. =head1 AUTHOR INFORMATION -be used and modified freely, but I do request that this copyright -notice remain attached to the file. You may modify this module as you -wish, but if you redistribute a modified version, please attach a note -listing the modifications you have made. +Copyright 1997-1998, Lincoln D. Stein. All rights reserved. -Address bug reports and comments to: -lstein@genome.wi.mit.edu +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +Address bug reports and comments to: lstein@cshl.org =head1 BUGS diff --git a/contrib/perl5/lib/CGI/Fast.pm b/contrib/perl5/lib/CGI/Fast.pm index 03b5407..a39fe05 100644 --- a/contrib/perl5/lib/CGI/Fast.pm +++ b/contrib/perl5/lib/CGI/Fast.pm @@ -16,7 +16,7 @@ package CGI::Fast; # The most recent version and complete docs are available at: # http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ -$CGI::Fast::VERSION='1.00a'; +$CGI::Fast::VERSION='1.01'; use CGI; use FCGI; @@ -34,9 +34,11 @@ sub save_request { # New is slightly different in that it calls FCGI's # accept() method. sub new { - return undef unless FCGI::accept() >= 0; - my($self,@param) = @_; - return $CGI::Q = $self->SUPER::new(@param); + my ($self, $initializer, @param) = @_; + unless (defined $initializer) { + return undef unless FCGI::accept() >= 0; + } + return $CGI::Q = $self->SUPER::new($initializer, @param); } 1; @@ -154,13 +156,12 @@ I haven't tested this very much. =head1 AUTHOR INFORMATION -be used and modified freely, but I do request that this copyright -notice remain attached to the file. You may modify this module as you -wish, but if you redistribute a modified version, please attach a note -listing the modifications you have made. +Copyright 1996-1998, Lincoln D. Stein. All rights reserved. -Address bug reports and comments to: -lstein@genome.wi.mit.edu +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +Address bug reports and comments to: lstein@cshl.org =head1 BUGS diff --git a/contrib/perl5/lib/CGI/Push.pm b/contrib/perl5/lib/CGI/Push.pm index eeec3f8..e4a66ae 100644 --- a/contrib/perl5/lib/CGI/Push.pm +++ b/contrib/perl5/lib/CGI/Push.pm @@ -14,8 +14,7 @@ package CGI::Push; # listing the modifications you have made. # The most recent version and complete docs are available at: -# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html -# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ +# http://stein.cshl.org/WWW/software/CGI/ $CGI::Push::VERSION='1.01'; use CGI; @@ -287,19 +286,14 @@ Recognition of NPH scripts happens automatically with WebSTAR and Microsoft IIS. Users of other servers should see their documentation for help. -=head1 CAVEATS - -This is a new module. It hasn't been extensively tested. - =head1 AUTHOR INFORMATION -be used and modified freely, but I do request that this copyright -notice remain attached to the file. You may modify this module as you -wish, but if you redistribute a modified version, please attach a note -listing the modifications you have made. +Copyright 1995-1998, Lincoln D. Stein. All rights reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. -Address bug reports and comments to: -lstein@genome.wi.mit.edu +Address bug reports and comments to: lstein@cshl.org =head1 BUGS diff --git a/contrib/perl5/lib/CPAN.pm b/contrib/perl5/lib/CPAN.pm index b510ea2..2276943 100644 --- a/contrib/perl5/lib/CPAN.pm +++ b/contrib/perl5/lib/CPAN.pm @@ -1,24 +1,25 @@ package CPAN; -use vars qw{$Try_autoload $Revision +use vars qw{$Try_autoload + $Revision $META $Signal $Cwd $End $Suppress_readline %Dontload $Frontend $Defaultsite - }; + }; #}; -$VERSION = '1.3901'; +$VERSION = '1.48'; -# $Id: CPAN.pm,v 1.226 1998/07/08 22:29:29 k Exp k $ +# $Id: CPAN.pm,v 1.260 1999/03/06 19:31:02 k Exp $ # only used during development: $Revision = ""; -# $Revision = "[".substr(q$Revision: 1.226 $, 10)."]"; +# $Revision = "[".substr(q$Revision: 1.260 $, 10)."]"; use Carp (); use Config (); use Cwd (); use DirHandle; use Exporter (); -use ExtUtils::MakeMaker (); +use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1; use File::Basename (); use File::Copy (); use File::Find; @@ -27,10 +28,11 @@ use FileHandle (); use Safe (); use Text::ParseWords (); use Text::Wrap; +use File::Spec; END { $End++; &cleanup; } -%CPAN::DEBUG = qw( +%CPAN::DEBUG = qw[ CPAN 1 Index 2 InfoObj 4 @@ -45,7 +47,7 @@ END { $End++; &cleanup; } Eval 2048 Config 4096 Tarzip 8192 - ); +]; $CPAN::DEBUG ||= 0; $CPAN::Signal ||= 0; @@ -56,13 +58,7 @@ package CPAN; use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term); use strict qw(vars); -@CPAN::ISA = qw(CPAN::Debug Exporter MM); # MM will go away - # soonish. Already version - # 1.29 doesn't rely on - # catfile and catdir being - # available via - # inheritance. Anything else - # in danger? +@CPAN::ISA = qw(CPAN::Debug Exporter); @EXPORT = qw( autobundle bundle expand force get @@ -75,6 +71,7 @@ sub AUTOLOAD { $l =~ s/.*:://; my(%EXPORT); @EXPORT{@EXPORT} = ''; + CPAN::Config->load unless $CPAN::Config_loaded++; if (exists $EXPORT{$l}){ CPAN::Shell->$l(@_); } else { @@ -92,7 +89,9 @@ sub AUTOLOAD { #-> sub CPAN::shell ; sub shell { + my($self) = @_; $Suppress_readline ||= ! -t STDIN; + CPAN::Config->load unless $CPAN::Config_loaded++; my $prompt = "cpan> "; local($^W) = 1; @@ -100,8 +99,20 @@ sub shell { require Term::ReadLine; # import Term::ReadLine; $term = Term::ReadLine->new('CPAN Monitor'); - $readline::rl_completion_function = - $readline::rl_completion_function = 'CPAN::Complete::cpl'; + if ($term->ReadLine eq "Term::ReadLine::Gnu") { + my $attribs = $term->Attribs; +# $attribs->{completion_entry_function} = +# $attribs->{'list_completion_function'}; + $attribs->{attempted_completion_function} = sub { + &CPAN::Complete::gnu_cpl; + } +# $attribs->{completion_word} = +# [qw(help me somebody to find out how +# to use completion with GNU)]; + } else { + $readline::rl_completion_function = + $readline::rl_completion_function = 'CPAN::Complete::cpl'; + } } no strict; @@ -109,6 +120,7 @@ sub shell { my $getcwd; $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; my $cwd = CPAN->$getcwd(); + my $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub"; my $rl_avail = $Suppress_readline ? "suppressed" : ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" : "available (try ``install Bundle::CPAN'')"; @@ -131,7 +143,7 @@ ReadLine support $rl_avail $_ = "$continuation$_" if $continuation; s/^\s+//; next if /^$/; - $_ = 'h' if $_ eq '?'; + $_ = 'h' if /^\s*\?/; if (/^(?:q(?:uit)?|bye|exit)$/i) { last; } elsif (s/\\$//s) { @@ -168,6 +180,20 @@ ReadLine support $rl_avail } } continue { $Signal=0; + CPAN::Queue->nullify_queue; + if ($try_detect_readline) { + if ($CPAN::META->has_inst("Term::ReadLine::Gnu") + || + $CPAN::META->has_inst("Term::ReadLine::Perl") + ) { + delete $INC{"Term/ReadLine.pm"}; + my $redef; + local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef); + require Term::ReadLine; + $CPAN::Frontend->myprint("\n$redef subroutines in Term::ReadLine redefined\n"); + goto &shell; + } + } } } @@ -230,7 +256,7 @@ sub AUTOLOAD { $CPAN::Frontend->mywarn(qq{ Commands starting with "w" require CPAN::WAIT to be installed. Please consider installing CPAN::WAIT to use the fulltext index. -For this you just need to type +For this you just need to type install CPAN::WAIT }); } @@ -260,7 +286,7 @@ sub try_dot_al { if (defined($name=$INC{"$pkg.pm"})) { $name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|; - $name = undef unless (-r $name); + $name = undef unless (-r $name); } unless (defined $name) { @@ -275,7 +301,7 @@ sub try_dot_al { *$autoload = sub {}; $ok = 1; } else { - if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ + if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){ eval {local $SIG{__DIE__};require $name}; } if ($@){ @@ -286,7 +312,9 @@ sub try_dot_al { } } } else { - $ok = 1; + + $ok = 1; + } $@ = $save; # my $lm = Carp::longmess(); @@ -303,7 +331,7 @@ sub try_dot_al { # $Try_autoload = 1; if ($CPAN::Try_autoload) { - my $p; + my $p; for $p (qw( CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP @@ -318,21 +346,127 @@ use vars qw($AUTOLOAD @ISA); @CPAN::Tarzip::ISA = qw(CPAN::Debug); package CPAN::Queue; -# currently only used to determine if we should or shouldn't announce -# the availability of a new CPAN module + +# One use of the queue is to determine if we should or shouldn't +# announce the availability of a new CPAN module + +# Now we try to use it for dependency tracking. For that to happen +# we need to draw a dependency tree and do the leaves first. This can +# easily be reached by running CPAN.pm recursively, but we don't want +# to waste memory and run into deep recursion. So what we can do is +# this: + +# CPAN::Queue is the package where the queue is maintained. Dependencies +# often have high priority and must be brought to the head of the queue, +# possibly by jumping the queue if they are already there. My first code +# attempt tried to be extremely correct. Whenever a module needed +# immediate treatment, I either unshifted it to the front of the queue, +# or, if it was already in the queue, I spliced and let it bypass the +# others. This became a too correct model that made it impossible to put +# an item more than once into the queue. Why would you need that? Well, +# you need temporary duplicates as the manager of the queue is a loop +# that +# +# (1) looks at the first item in the queue without shifting it off +# +# (2) cares for the item +# +# (3) removes the item from the queue, *even if its agenda failed and +# even if the item isn't the first in the queue anymore* (that way +# protecting against never ending queues) +# +# So if an item has prerequisites, the installation fails now, but we +# want to retry later. That's easy if we have it twice in the queue. +# +# I also expect insane dependency situations where an item gets more +# than two lives in the queue. Simplest example is triggered by 'install +# Foo Foo Foo'. People make this kind of mistakes and I don't want to +# get in the way. I wanted the queue manager to be a dumb servant, not +# one that knows everything. +# +# Who would I tell in this model that the user wants to be asked before +# processing? I can't attach that information to the module object, +# because not modules are installed but distributions. So I'd have to +# tell the distribution object that it should ask the user before +# processing. Where would the question be triggered then? Most probably +# in CPAN::Distribution::rematein. +# Hope that makes sense, my head is a bit off:-) -- AK + +use vars qw{ @All }; + sub new { my($class,$mod) = @_; - # warn "Queue object for mod[$mod]"; - bless {mod => $mod}, $class; + my $self = bless {mod => $mod}, $class; + push @All, $self; + # my @all = map { $_->{mod} } @All; + # warn "Adding Queue object for mod[$mod] all[@all]"; + return $self; } -package CPAN; +sub first { + my $obj = $All[0]; + $obj->{mod}; +} + +sub delete_first { + my($class,$what) = @_; + my $i; + for my $i (0..$#All) { + if ( $All[$i]->{mod} eq $what ) { + splice @All, $i, 1; + return; + } + } +} + +sub jumpqueue { + my $class = shift; + my @what = @_; + my $obj; + WHAT: for my $what (reverse @what) { + my $jumped = 0; + for (my $i=0; $i<$#All;$i++) { #prevent deep recursion + if ($All[$i]->{mod} eq $what){ + $jumped++; + if ($jumped > 100) { # one's OK if e.g. just processing now; + # more are OK if user typed it several + # times + $CPAN::Frontend->mywarn( +qq{Object [$what] queued more than 100 times, ignoring} + ); + next WHAT; + } + } + } + my $obj = bless { mod => $what }, $class; + unshift @All, $obj; + } +} + +sub exists { + my($self,$what) = @_; + my @all = map { $_->{mod} } @All; + my $exists = grep { $_->{mod} eq $what } @All; + # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]"; + $exists; +} + +sub delete { + my($self,$mod) = @_; + @All = grep { $_->{mod} ne $mod } @All; + # my @all = map { $_->{mod} } @All; + # warn "Deleting Queue object for mod[$mod] all[@all]"; +} -$META ||= CPAN->new; # In case we reeval ourselves we - # need a || +sub nullify_queue { + @All = (); +} + + + +package CPAN; -# Do this after you have set up the whole inheritance -CPAN::Config->load unless defined $CPAN::No_Config_is_ok; +$META ||= CPAN->new; # In case we re-eval ourselves we need the || 1; @@ -356,12 +490,14 @@ sub clean; sub test; #-> sub CPAN::all ; -sub all { +sub all_objects { my($mgr,$class) = @_; + CPAN::Config->load unless $CPAN::Config_loaded++; CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG; CPAN::Index->reload; values %{ $META->{$class} }; } +*all = \&all_objects; # Called by shell, not in batch mode. Not clean XXX #-> sub CPAN::checklock ; @@ -434,8 +570,8 @@ or $self->{LOCK} = $lockfile; $fh->close; $SIG{'TERM'} = sub { - &cleanup; - $CPAN::Frontend->mydie("Got SIGTERM, leaving"); + &cleanup; + $CPAN::Frontend->mydie("Got SIGTERM, leaving"); }; $SIG{'INT'} = sub { # no blocks!!! @@ -491,13 +627,18 @@ sub has_inst { $file =~ s|/|\\|g if $^O eq 'MSWin32'; $file .= ".pm"; if ($INC{$file}) { -# warn "$file in %INC"; #debug + # checking %INC is wrong, because $INC{LWP} may be true + # although $INC{"URI/URL.pm"} may have failed. But as + # I really want to say "bla loaded OK", I have to somehow + # cache results. + ### warn "$file in %INC"; #debug return 1; } elsif (eval { require $file }) { # eval is good: if we haven't yet read the database it's # perfect and if we have installed the module in the meantime, # it tries again. The second require is only a NOOP returning # 1 if we had success, otherwise it's retrying + $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n"); if ($mod eq "CPAN::WAIT") { push @CPAN::Shell::ISA, CPAN::WAIT; @@ -518,6 +659,8 @@ sub has_inst { }); sleep 2; + } else { + delete $INC{$file}; # if it inc'd LWP but failed during, say, URI } return 0; } @@ -537,16 +680,30 @@ sub new { #-> sub CPAN::cleanup ; sub cleanup { - local $SIG{__DIE__} = ''; - my $i = 0; my $ineval = 0; my $sub; - while ((undef,undef,undef,$sub) = caller(++$i)) { - $ineval = 1, last if $sub eq '(eval)'; + # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]"; + local $SIG{__DIE__} = ''; + my($message) = @_; + my $i = 0; + my $ineval = 0; + if ( + 0 && # disabled, try reload cpan with it + $] > 5.004_60 # thereabouts + ) { + $ineval = $^S; + } else { + my($subroutine); + while ((undef,undef,undef,$subroutine) = caller(++$i)) { + $ineval = 1, last if + $subroutine eq '(eval)'; } - return if $ineval && !$End; - return unless defined $META->{'LOCK'}; - return unless -f $META->{'LOCK'}; - unlink $META->{'LOCK'}; - $CPAN::Frontend->mywarn("Lockfile removed.\n"); + } + return if $ineval && !$End; + return unless defined $META->{'LOCK'}; + return unless -f $META->{'LOCK'}; + unlink $META->{'LOCK'}; + # require Carp; + # Carp::cluck("DEBUGGING"); + $CPAN::Frontend->mywarn("Lockfile removed.\n"); } package CPAN::CacheMgr; @@ -597,7 +754,8 @@ sub entries { $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; my($cwd) = CPAN->$getcwd(); chdir $dir or Carp::croak("Can't chdir to $dir: $!"); - my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!"); + my $dh = DirHandle->new(File::Spec->curdir) + or Carp::croak("Couldn't opendir $dir: $!"); my(@entries); for ($dh->read) { next if $_ eq "." || $_ eq ".."; @@ -621,9 +779,15 @@ sub disk_usage { my($Du) = 0; find( sub { - $File::Find::prune++ if $CPAN::Signal; - return if -l $_; - $Du += -s _; + $File::Find::prune++ if $CPAN::Signal; + return if -l $_; + if ($^O eq 'MacOS') { + require Mac::Files; + my $cat = Mac::Files::FSpGetCatInfo($_); + $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen(); + } else { + $Du += (-s _); + } }, $dir ); @@ -655,26 +819,36 @@ sub new { my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, + SCAN => $CPAN::Config->{'scan_cache'} || 'atstart', DU => 0 }; File::Path::mkpath($self->{ID}); my $dh = DirHandle->new($self->{ID}); bless $self, $class; - my $e; + $self->scan_cache; + $t2 = time; + $debug .= "timing of CacheMgr->new: ".($t2 - $time); + $time = $t2; + CPAN->debug($debug) if $CPAN::DEBUG; + $self; +} + +#-> sub CPAN::CacheMgr::scan_cache ; +sub scan_cache { + my $self = shift; + return if $self->{SCAN} eq 'never'; + $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}") + unless $self->{SCAN} eq 'atstart'; $CPAN::Frontend->myprint( sprintf("Scanning cache %s for sizes\n", $self->{ID})); + my $e; for $e ($self->entries($self->{ID})) { next if $e eq ".." || $e eq "."; $self->disk_usage($e); return if $CPAN::Signal; } $self->tidyup; - $t2 = time; - $debug .= "timing of CacheMgr->new: ".($t2 - $time); - $time = $t2; - CPAN->debug($debug) if $CPAN::DEBUG; - $self; } package CPAN::Debug; @@ -755,7 +929,7 @@ sub commit { unless (defined $configpm){ $configpm ||= $INC{"CPAN/MyConfig.pm"}; $configpm ||= $INC{"CPAN/Config.pm"}; - $configpm || Carp::confess(qq{ + $configpm || Carp::confess(q{ CPAN::Config::commit called without an argument. Please specify a filename where to save the configuration or try "o conf init" to have an interactive course through configing. @@ -779,6 +953,7 @@ Please specify a filename where to save the configuration or try EOF $msg ||= "\n"; my($fh) = FileHandle->new; + rename $configpm, "$configpm~" if -f $configpm; open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!"; $fh->print(qq[$msg\$CPAN::Config = \{\n]); foreach (sort keys %$CPAN::Config) { @@ -823,6 +998,7 @@ sub init { sub load { my($self) = shift; my(@miss); + use Carp; eval {require CPAN::Config;}; # We eval because of some # MakeMaker problems unless ($dot_cpan++){ @@ -887,11 +1063,11 @@ sub load { } } local($") = ", "; - $CPAN::Frontend->myprint(qq{ + $CPAN::Frontend->myprint(<myprint(qq{ $configpm initialized. }); @@ -903,9 +1079,10 @@ $configpm initialized. sub not_loaded { my(@miss); for (qw( - cpan_home keep_source_where build_dir build_cache index_expire - gzip tar unzip make pager makepl_arg make_arg make_install_arg - urllist inhibit_startup_message ftp_proxy http_proxy no_proxy + cpan_home keep_source_where build_dir build_cache scan_cache + index_expire gzip tar unzip make pager makepl_arg make_arg + make_install_arg urllist inhibit_startup_message + ftp_proxy http_proxy no_proxy prerequisites_policy )) { push @miss, $_ unless defined $CPAN::Config->{$_}; } @@ -918,10 +1095,9 @@ sub unload { delete $INC{'CPAN/Config.pm'}; } -*h = \&help; #-> sub CPAN::Config::help ; sub help { - $CPAN::Frontend->myprint(qq{ + $CPAN::Frontend->myprint(q[ Known options: defaults reload default config values from disk commit commit session changes to disk @@ -937,7 +1113,7 @@ You may edit key values in the follow fashion: o conf urllist unshift ftp://ftp.foo.bar/ -}); +]); undef; #don't reprint CPAN::Config } @@ -1024,7 +1200,9 @@ sub b { #-> sub CPAN::Shell::d ; sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));} #-> sub CPAN::Shell::m ; -sub m { $CPAN::Frontend->myprint(shift->format_result('Module',@_));} +sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here + $CPAN::Frontend->myprint(shift->format_result('Module',@_)); +} #-> sub CPAN::Shell::i ; sub i { @@ -1139,6 +1317,21 @@ Known options: } } +sub dotdot_onreload { + my($ref) = shift; + sub { + if ( $_[0] =~ /Subroutine (\w+) redefined/ ) { + my($subr) = $1; + ++$$ref; + local($|) = 1; + # $CPAN::Frontend->myprint(".($subr)"); + $CPAN::Frontend->myprint("."); + return; + } + warn @_; + }; +} + #-> sub CPAN::Shell::reload ; sub reload { my($self,$command,@arg) = @_; @@ -1148,27 +1341,16 @@ sub reload { CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG; my $fh = FileHandle->new($INC{'CPAN.pm'}); local($/); - undef $/; $redef = 0; - local($SIG{__WARN__}) - = sub { - if ( $_[0] =~ /Subroutine \w+ redefined/ ) { - ++$redef; - local($|) = 1; - $CPAN::Frontend->myprint("."); - return; - } - warn @_; - }; + local($SIG{__WARN__}) = dotdot_onreload(\$redef); eval <$fh>; warn $@ if $@; $CPAN::Frontend->myprint("\n$redef subroutines redefined\n"); } elsif ($command =~ /index/) { - CPAN::Index->force_reload; + CPAN::Index->force_reload; } else { - $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file -index re-reads the index files -}); + $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file +index re-reads the index files\n}); } } @@ -1323,6 +1505,7 @@ sub u { #-> sub CPAN::Shell::autobundle ; sub autobundle { my($self) = shift; + CPAN::Config->load unless $CPAN::Config_loaded++; my(@bundle) = $self->_u_r_common("a",@_); my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle"); File::Path::mkpath($todir); @@ -1379,7 +1562,7 @@ sub expand { my $class = "CPAN::$type"; my $obj; if (defined $regex) { - for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) { + for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all_objects($class)) { push @m, $obj if $obj->id =~ /$regex/i @@ -1500,22 +1683,23 @@ sub rematein { CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG; my($s,@s); foreach $s (@some) { + CPAN::Queue->new($s); + } + while ($s = CPAN::Queue->first) { my $obj; if (ref $s) { $obj = $s; } elsif ($s =~ m|/|) { # looks like a file $obj = $CPAN::META->instance('CPAN::Distribution',$s); } elsif ($s =~ m|^Bundle::|) { - $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s); $obj = $CPAN::META->instance('CPAN::Bundle',$s); } else { - $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s); $obj = $CPAN::META->instance('CPAN::Module',$s) if $CPAN::META->exists('CPAN::Module',$s); } if (ref $obj) { CPAN->debug( - qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}. + qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}. $obj->as_string. qq{\]} ) if $CPAN::DEBUG; @@ -1530,7 +1714,9 @@ sub rematein { if ($]>=5.00303 && $obj->can('called_for')) { $obj->called_for($s); } - $obj->$meth(); + CPAN::Queue->delete($s) if $obj->$meth(); # if it is more + # than once in + # the queue } elsif ($CPAN::META->exists('CPAN::Author',$s)) { $obj = $CPAN::META->instance('CPAN::Author',$s); $CPAN::Frontend->myprint( @@ -1540,7 +1726,9 @@ sub rematein { " ;-)\n" ); } else { - $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is. + $CPAN::Frontend + ->myprint(qq{Warning: Cannot $meth $s, }. + qq{don\'t know what it is. Try the command i /$s/ @@ -1548,6 +1736,7 @@ Try the command to find objects with similar identifiers. }); } + CPAN::Queue->delete_first($s); } } @@ -1572,35 +1761,35 @@ package CPAN::FTP; #-> sub CPAN::FTP::ftp_get ; sub ftp_get { - my($class,$host,$dir,$file,$target) = @_; - $class->debug( - qq[Going to fetch file [$file] from dir [$dir] + my($class,$host,$dir,$file,$target) = @_; + $class->debug( + qq[Going to fetch file [$file] from dir [$dir] on host [$host] as local [$target]\n] ) if $CPAN::DEBUG; - my $ftp = Net::FTP->new($host); - return 0 unless defined $ftp; - $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; - $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]); - unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){ - warn "Couldn't login on $host"; - return; - } - unless ( $ftp->cwd($dir) ){ - warn "Couldn't cwd $dir"; - return; - } - $ftp->binary; - $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG; - unless ( $ftp->get($file,$target) ){ - warn "Couldn't fetch $file from $host\n"; - return; - } - $ftp->quit; # it's ok if this fails - return 1; + my $ftp = Net::FTP->new($host); + return 0 unless defined $ftp; + $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; + $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]); + unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){ + warn "Couldn't login on $host"; + return; + } + unless ( $ftp->cwd($dir) ){ + warn "Couldn't cwd $dir"; + return; + } + $ftp->binary; + $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG; + unless ( $ftp->get($file,$target) ){ + warn "Couldn't fetch $file from $host\n"; + return; + } + $ftp->quit; # it's ok if this fails + return 1; } # If more accuracy is wanted/needed, Chris Leach sent me this patch... - + # leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997 # leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997 # leach,> *************** @@ -1664,6 +1853,20 @@ sub localize { $self->debug("file[$file] aslocal[$aslocal] force[$force]") if $CPAN::DEBUG; + if ($^O eq 'MacOS') { + my($name, $path) = File::Basename::fileparse($aslocal, ''); + if (length($name) > 31) { + $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//; + my $suf = $1; + my $size = 31 - length($suf); + while (length($name) > $size) { + chop $name; + } + $name .= $suf; + $aslocal = File::Spec->catfile($path, $name); + } + } + return $aslocal if -f $aslocal && -r _ && !($force & 1); my($restore) = 0; if (-f $aslocal){ @@ -1679,7 +1882,7 @@ sub localize { 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')) { + if ($CPAN::META->has_inst('LWP::UserAgent')) { require LWP::UserAgent; unless ($Ua) { $Ua = LWP::UserAgent->new; @@ -1704,7 +1907,7 @@ sub localize { @reordered = sort { (substr($CPAN::Config->{urllist}[$b],0,4) eq "file") - <=> + <=> (substr($CPAN::Config->{urllist}[$a],0,4) eq "file") or defined($Thesite) @@ -1713,11 +1916,6 @@ sub localize { <=> ($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) { @@ -1725,6 +1923,7 @@ sub localize { } else { @levels = qw/easy hard hardest/; } + @levels = qw/easy/ if $^O eq 'MacOS'; for $level (@levels) { my $method = "host$level"; my @host_seq = $level eq "easy" ? @@ -1732,9 +1931,11 @@ sub localize { @host_seq = (0) unless @host_seq; my $ret = $self->$method(\@host_seq,$file,$aslocal); if ($ret) { - $Themethod = $level; - $self->debug("level[$level]") if $CPAN::DEBUG; - return $ret; + $Themethod = $level; + $self->debug("level[$level]") if $CPAN::DEBUG; + return $ret; + } else { + unlink $aslocal; } } my(@mess); @@ -1780,8 +1981,11 @@ sub hosteasy { # fileurl = "file://" [ host | "localhost" ] "/" fpath # Thanks to "Mark D. Baushke" for # the code - ($l = $url) =~ s,^file://[^/]+,,; # discard the host part - $l =~ s/^file://; # assume they meant file://localhost + ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part + $l =~ s|^file:||; # assume they + # meant + # file://localhost + $l =~ s|^/|| unless -f $l; # e.g. /P: } if ( -f $l && -r _) { $Thesite = $i; @@ -1797,10 +2001,14 @@ sub hosteasy { } } } - if ($CPAN::META->has_inst('LWP')) { + if ($CPAN::META->has_inst('LWP')) { $CPAN::Frontend->myprint("Fetching with LWP: $url "); + unless ($Ua) { + require LWP::UserAgent; + $Ua = LWP::UserAgent->new; + } my $res = $Ua->mirror($url, $aslocal); if ($res->is_success) { $Thesite = $i; @@ -1847,7 +2055,7 @@ sub hosteasy { $CPAN::Frontend->myprint("Fetching with Net::FTP $url.gz "); - if (CPAN::FTP->ftp_get($host, + if (CPAN::FTP->ftp_get($host, $dir, "$getfile.gz", $gz) && @@ -1864,15 +2072,17 @@ sub hosteasy { } sub hosthard { - my($self,$host_seq,$file,$aslocal) = @_; + my($self,$host_seq,$file,$aslocal) = @_; - # Came back if Net::FTP couldn't establish connection (or - # failed otherwise) Maybe they are behind a firewall, but they - # gave us a socksified (or other) ftp program... + # 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); + my($i); + my($devnull) = $CPAN::Config->{devnull} || ""; + # < /dev/null "; + my($aslocal_dir) = File::Basename::dirname($aslocal); + File::Path::mkpath($aslocal_dir); HOSTHARD: for $i (@$host_seq) { my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite; unless ($self->is_reachable($url)) { @@ -1894,7 +2104,7 @@ sub hosthard { } $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG; my($f,$funkyftp); - for $f ('lynx','ncftp') { + for $f ('lynx','ncftpget','ncftp') { next unless exists $CPAN::Config->{$f}; $funkyftp = $CPAN::Config->{$f}; next unless defined $funkyftp; @@ -1903,14 +2113,14 @@ sub hosthard { my $aslocal_uncompressed; ($aslocal_uncompressed = $aslocal) =~ s/\.gz//; my($source_switch) = ""; - $source_switch = "-source" if $funkyftp =~ /\blynx$/; - $source_switch = "-c" if $funkyftp =~ /\bncftp$/; + $source_switch = " -source" if $funkyftp =~ /\blynx$/; + $source_switch = " -c" if $funkyftp =~ /\bncftp$/; $CPAN::Frontend->myprint( - qq{ -Trying with "$funkyftp $source_switch" to get + qq[ +Trying with "$funkyftp$source_switch" to get $url -}); - my($system) = "$funkyftp $source_switch '$url' > ". +]); + my($system) = "$funkyftp$source_switch '$url' $devnull > ". "$aslocal_uncompressed"; $self->debug("system[$system]") if $CPAN::DEBUG; my($wstatus); @@ -1929,36 +2139,40 @@ Trying with "$funkyftp $source_switch" to get CPAN::Tarzip->gzip($aslocal_uncompressed, "$aslocal_uncompressed.gz"); } - $Thesite = $i; - return $aslocal; } + $Thesite = $i; + return $aslocal; } elsif ($url !~ /\.gz$/) { - my $gz = "$aslocal.gz"; - my $gzurl = "$url.gz"; - $CPAN::Frontend->myprint( - qq{ -Trying with "$funkyftp $source_switch" to get + unlink $aslocal_uncompressed if + -f $aslocal_uncompressed && -s _ == 0; + my $gz = "$aslocal.gz"; + my $gzurl = "$url.gz"; + $CPAN::Frontend->myprint( + qq[ +Trying with "$funkyftp$source_switch" to get $url.gz -}); - my($system) = "$funkyftp $source_switch '$url.gz' > ". - "$aslocal_uncompressed.gz"; - $self->debug("system[$system]") if $CPAN::DEBUG; - my($wstatus); - if (($wstatus = system($system)) == 0 - && - -s "$aslocal_uncompressed.gz" - ) { - # test gzip integrity - if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) { - CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz", - $aslocal); - } else { - rename $aslocal_uncompressed, $aslocal; - } -#line 1739 - $Thesite = $i; - return $aslocal; +]); + my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ". + "$aslocal_uncompressed.gz"; + $self->debug("system[$system]") if $CPAN::DEBUG; + my($wstatus); + if (($wstatus = system($system)) == 0 + && + -s "$aslocal_uncompressed.gz" + ) { + # test gzip integrity + if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) { + CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz", + $aslocal); + } else { + rename $aslocal_uncompressed, $aslocal; } + $Thesite = $i; + return $aslocal; + } else { + unlink "$aslocal_uncompressed.gz" if + -f "$aslocal_uncompressed.gz"; + } } else { my $estatus = $wstatus >> 8; my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : ""; @@ -2047,7 +2261,7 @@ sub hosthardest { $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host nor does it have a default entry\n"); } - + # OK, they don't have a valid ~/.netrc. Use 'ftp -n' # then and login manually to host, using e-mail as # password. @@ -2085,7 +2299,6 @@ sub talk_ftp { Subprocess "|$command" returned status $estatus (wstat $wstatus) }) if $wstatus; - } # find2perl needs modularization, too, all the following is stolen @@ -2212,6 +2425,27 @@ sub contains { package CPAN::Complete; +sub gnu_cpl { + my($text, $line, $start, $end) = @_; + my(@perlret) = cpl($text, $line, $start); + # find longest common match. Can anybody show me how to peruse + # T::R::Gnu to have this done automatically? Seems expensive. + return () unless @perlret; + my($newtext) = $text; + for (my $i = length($text)+1;;$i++) { + last unless length($perlret[0]) && length($perlret[0]) >= $i; + my $try = substr($perlret[0],0,$i); + my @tries = grep {substr($_,0,$i) eq $try} @perlret; + # warn "try[$try]tries[@tries]"; + if (@tries == @perlret) { + $newtext = $try; + } else { + last; + } + } + ($newtext,@perlret); +} + #-> sub CPAN::Complete::cpl ; sub cpl { my($word,$line,$pos) = @_; @@ -2257,7 +2491,7 @@ sub cpl { #-> sub CPAN::Complete::cplx ; sub cplx { my($class, $word) = @_; - grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class); + grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class); } #-> sub CPAN::Complete::cpl_any ; @@ -2327,26 +2561,35 @@ sub reload { my $needshort = $^O eq "dos"; - $cl->rd_authindex($cl->reload_x( - "authors/01mailrc.txt.gz", - $needshort ? "01mailrc.gz" : "", - $force)); + $cl->rd_authindex($cl + ->reload_x( + "authors/01mailrc.txt.gz", + $needshort ? + File::Spec->catfile('authors', '01mailrc.gz') : + File::Spec->catfile('authors', '01mailrc.txt.gz'), + $force)); $t2 = time; $debug = "timing reading 01[".($t2 - $time)."]"; $time = $t2; return if $CPAN::Signal; # this is sometimes lengthy - $cl->rd_modpacks($cl->reload_x( - "modules/02packages.details.txt.gz", - $needshort ? "02packag.gz" : "", - $force)); + $cl->rd_modpacks($cl + ->reload_x( + "modules/02packages.details.txt.gz", + $needshort ? + File::Spec->catfile('modules', '02packag.gz') : + File::Spec->catfile('modules', '02packages.details.txt.gz'), + $force)); $t2 = time; $debug .= "02[".($t2 - $time)."]"; $time = $t2; return if $CPAN::Signal; # this is sometimes lengthy - $cl->rd_modlist($cl->reload_x( - "modules/03modlist.data.gz", - $needshort ? "03mlist.gz" : "", - $force)); + $cl->rd_modlist($cl + ->reload_x( + "modules/03modlist.data.gz", + $needshort ? + File::Spec->catfile('modules', '03mlist.gz') : + File::Spec->catfile('modules', '03modlist.data.gz'), + $force)); $t2 = time; $debug .= "03[".($t2 - $time)."]"; $time = $t2; @@ -2379,7 +2622,8 @@ sub reload_x { #-> sub CPAN::Index::rd_authindex ; sub rd_authindex { - my($cl,$index_target) = @_; + my($cl, $index_target) = @_; + my @lines; return unless defined $index_target; $CPAN::Frontend->myprint("Going to read $index_target\n"); # my $fh = CPAN::Tarzip->TIEHANDLE($index_target); @@ -2388,10 +2632,10 @@ sub rd_authindex { local(*FH); tie *FH, CPAN::Tarzip, $index_target; local($/) = "\n"; - while () { - chomp; + push @lines, split /\012/ while ; + foreach (@lines) { my($userid,$fullname,$email) = - /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/; + m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/; next unless $userid && $fullname && $email; # instantiate an author object @@ -2410,26 +2654,34 @@ sub userid { #-> sub CPAN::Index::rd_modpacks ; sub rd_modpacks { - my($cl,$index_target) = @_; + my($cl, $index_target) = @_; + my @lines; return unless defined $index_target; $CPAN::Frontend->myprint("Going to read $index_target\n"); my $fh = CPAN::Tarzip->TIEHANDLE($index_target); local($/) = "\n"; while ($_ = $fh->READLINE) { - last if /^\s*$/; + s/\012/\n/g; + my @ls = map {"$_\n"} split /\n/, $_; + unshift @ls, "\n" x length($1) if /^(\n+)/; + push @lines, @ls; } - while ($_ = $fh->READLINE) { + while (@lines) { + my $shift = shift(@lines); + last if $shift =~ /^\s*$/; + } + foreach (@lines) { chomp; my($mod,$version,$dist) = split; ### $version =~ s/^\+//; # if it is a bundle, instatiate a bundle object my($bundle,$id,$userid); - + if ($mod eq 'CPAN' && ! ( - $CPAN::META->exists('CPAN::Queue','Bundle::CPAN') || - $CPAN::META->exists('CPAN::Queue','CPAN') + CPAN::Queue->exists('Bundle::CPAN') || + CPAN::Queue->exists('CPAN') ) ) { local($^W)= 0; @@ -2452,9 +2704,11 @@ sub rd_modpacks { if ($bundle){ $id = $CPAN::META->instance('CPAN::Bundle',$mod); + # warn "made mod[$mod]a bundle"; # Let's make it a module too, because bundles have so much # in common with modules $CPAN::META->instance('CPAN::Module',$mod); + # warn "made mod[$mod]a module"; # This "next" makes us faster but if the job is running long, we ignore # rereads which is bad. So we have to be a bit slower again. @@ -2499,13 +2753,19 @@ sub rd_modlist { my @eval; local($/) = "\n"; while ($_ = $fh->READLINE) { - if (/^Date:\s+(.*)/){ + s/\012/\n/g; + my @ls = map {"$_\n"} split /\n/, $_; + unshift @ls, "\n" x length($1) if /^(\n+)/; + push @eval, @ls; + } + while (@eval) { + my $shift = shift(@eval); + if ($shift =~ /^Date:\s+(.*)/){ return if $date_of_03 eq $1; ($date_of_03) = $1; } - last if /^\s*$/; + last if $shift =~ /^\s*$/; } - push @eval, $_ while $_ = $fh->READLINE; undef $fh; push @eval, q{CPAN::Modulelist->data;}; local($^W) = 0; @@ -2604,6 +2864,7 @@ sub as_glimpse { #-> sub CPAN::Author::fullname ; sub fullname { shift->{'FULLNAME'} } *name = \&fullname; + #-> sub CPAN::Author::email ; sub email { shift->{'EMAIL'} } @@ -2667,11 +2928,12 @@ sub get { } else { $self->{archived} = "NO"; } - chdir ".."; + chdir File::Spec->updir; if ($self->{archived} ne 'NO') { - chdir "tmp"; + chdir File::Spec->catdir(File::Spec->curdir, "tmp"); # Let's check if the package has its own directory. - my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!"); + my $dh = DirHandle->new(File::Spec->curdir) + or Carp::croak("Couldn't opendir .: $!"); my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC?? $dh->close; my ($distdir,$packagedir); @@ -2694,7 +2956,7 @@ sub get { } } $self->{'build_dir'} = $packagedir; - chdir ".."; + chdir File::Spec->updir; $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") if $CPAN::DEBUG; @@ -2783,6 +3045,12 @@ sub new { #-> sub CPAN::Distribution::look ; sub look { my($self) = @_; + + if ($^O eq 'MacOS') { + $self->ExtUtils::MM_MacOS::look; + return; + } + if ( $CPAN::Config->{'shell'} ) { $CPAN::Frontend->myprint(qq{ Trying to open a subshell in the build directory... @@ -2825,6 +3093,12 @@ sub readme { $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted) or $CPAN::Frontend->mydie(qq{No $sans.readme found});; + + if ($^O eq 'MacOS') { + ExtUtils::MM_MacOS::launch_file($local_file); + return; + } + my $fh_pager = FileHandle->new; local($SIG{PIPE}) = "IGNORE"; $fh_pager->open("|$CPAN::Config->{'pager'}") @@ -2891,6 +3165,7 @@ sub MD5_check_file { if (open $fh, $chk_file){ local($/); my $eval = <$fh>; + $eval =~ s/\015?\012/\n/g; close $fh; my($comp) = Safe->new(); $cksum = $comp->reval($eval); @@ -2978,16 +3253,14 @@ sub eq_MD5 { #-> sub CPAN::Distribution::force ; sub force { - my($self) = @_; - $self->{'force_update'}++; - delete $self->{'MD5_STATUS'}; - delete $self->{'archived'}; - delete $self->{'build_dir'}; - delete $self->{'localfile'}; - delete $self->{'make'}; - delete $self->{'install'}; - delete $self->{'unwrapped'}; - delete $self->{'writemakefile'}; + my($self) = @_; + $self->{'force_update'}++; + for my $att (qw( + MD5_STATUS archived build_dir localfile make install unwrapped + writemakefile have_sponsored + )) { + delete $self->{$att}; + } } sub isa_perl { @@ -3078,6 +3351,11 @@ or chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!"); $self->debug("Changed directory to $builddir") if $CPAN::DEBUG; + if ($^O eq 'MacOS') { + ExtUtils::MM_MacOS::make($self); + return; + } + my $system; if ($self->{'configure'}) { $system = $self->{'configure'}; @@ -3097,10 +3375,11 @@ or if ($CPAN::Config->{inactivity_timeout}) { eval { alarm $CPAN::Config->{inactivity_timeout}; - local $SIG{CHLD} = sub { wait }; + local $SIG{CHLD}; # = sub { wait }; if (defined($pid = fork)) { if ($pid) { #parent - wait; + # wait; + waitpid $pid, 0; } else { #child # note, this exec isn't necessary if # inactivity_timeout is 0. On the Mac I'd @@ -3122,37 +3401,41 @@ or return; } } else { - if (0) { - warn "Trying to intercept the output of 'perl Makefile.PL'"; - require IO::File; - # my $fh = FileHandle->new("$system 2>&1 |") or - my $fh = IO::File->new("$system 2>&1 |") or - die "Couldn't run '$system': $!"; - local($|) = 1; - while (length($_ = getc($fh))) { - print $_; # we want to parse that some day! - # unfortunately we have Makefile.PLs that want to talk - # and we can't emulate that reliably. I think, we have - # to parse Makefile.PL directly - } - $ret = $fh->close; - unless ($ret) { - warn $! ? "Error during 'perl Makefile.PL' subprocess: $!" : - "Exit status of 'perl Makefile.PL': $?"; - $self->{writemakefile} = "NO"; - return; - } - } else { - $ret = system($system); - if ($ret != 0) { - $self->{writemakefile} = "NO"; - return; - } + $ret = system($system); + if ($ret != 0) { + $self->{writemakefile} = "NO"; + return; } } $self->{writemakefile} = "YES"; } return if $CPAN::Signal; + if (my @prereq = $self->needs_prereq){ + my $id = $self->id; + $CPAN::Frontend->myprint("---- Dependencies detected ". + "during [$id] -----\n"); + + for my $p (@prereq) { + $CPAN::Frontend->myprint(" $p\n"); + } + my $follow = 0; + if ($CPAN::Config->{prerequisites_policy} eq "follow") { + $follow = 1; + } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") { + require ExtUtils::MakeMaker; + my $answer = ExtUtils::MakeMaker::prompt( +"Shall I follow them and prepend them to the queue +of modules we are processing right now?", "yes"); + $follow = $answer =~ /^\s*y/i; + } else { + local($") = ", "; + $CPAN::Frontend->myprint(" Ignoring dependencies on modules @prereq\n"); + } + if ($follow) { + CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself + return; + } + } $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg}; if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -3164,6 +3447,44 @@ or } } +#-> sub CPAN::Distribution::needs_prereq ; +sub needs_prereq { + my($self) = @_; + return unless -f "Makefile"; # we cannot say much + my $fh = FileHandle->new("mydie("Couldn't open Makefile: $!"); + local($/) = "\n"; + + my(@p,@need); + while (<$fh>) { + last if /MakeMaker post_initialize section/; + my($p) = m{^[\#] + \s+PREREQ_PM\s+=>\s+(.+) + }x; + next unless $p; + # warn "Found prereq expr[$p]"; + + while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){ + push @p, $1; + } + last; + } + for my $p (@p) { + my $mo = $CPAN::META->instance("CPAN::Module",$p); + next if $mo->uptodate; + # it's not needed, so don't push it. We cannot omit this step, because + # if 'force' is in effect, nobody else will check. + if ($self->{'have_sponsored'}{$p}++){ + # We have already sponsored it and for some reason it's still + # not available. So we do nothing. Or what should we do? + # if we push it again, we have a potential infinite loop + next; + } + push @need, $p; + } + return @need; +} + #-> sub CPAN::Distribution::test ; sub test { my($self) = @_; @@ -3186,6 +3507,12 @@ sub test { Carp::croak("Couldn't chdir to $self->{'build_dir'}"); $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + ExtUtils::MM_MacOS::make_test($self); + return; + } + my $system = join " ", $CPAN::Config->{'make'}, "test"; if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -3208,6 +3535,12 @@ sub clean { chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}"); $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + ExtUtils::MM_MacOS::make_clean($self); + return; + } + my $system = join " ", $CPAN::Config->{'make'}, "clean"; if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -3250,9 +3583,16 @@ sub install { Carp::croak("Couldn't chdir to $self->{'build_dir'}"); $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG; + + if ($^O eq 'MacOS') { + ExtUtils::MM_MacOS::make_install($self); + return; + } + my $system = join(" ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg}); - my($pipe) = FileHandle->new("$system 2>&1 |"); + my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 "; + my($pipe) = FileHandle->new("$system $stderr |"); my($makeout) = ""; while (<$pipe>){ $CPAN::Frontend->myprint($_); @@ -3261,7 +3601,7 @@ sub install { $pipe->close; if ($?==0) { $CPAN::Frontend->myprint(" $system -- OK\n"); - $self->{'install'} = "YES"; + return $self->{'install'} = "YES"; } else { $self->{'install'} = "NO"; $CPAN::Frontend->myprint(" $system -- NOT OK\n"); @@ -3289,58 +3629,67 @@ sub as_string { #-> sub CPAN::Bundle::contains ; sub contains { - my($self) = @_; - my($parsefile) = $self->inst_file; - my($id) = $self->id; - $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG; - unless ($parsefile) { - # Try to get at it in the cpan directory - $self->debug("no parsefile") if $CPAN::DEBUG; - Carp::confess "I don't know a $id" unless $self->{CPAN_FILE}; - my $dist = $CPAN::META->instance('CPAN::Distribution', - $self->{CPAN_FILE}); - $dist->get; - $self->debug($dist->as_string) if $CPAN::DEBUG; - my($todir) = $CPAN::Config->{'cpan_home'}; - my(@me,$from,$to,$me); - @me = split /::/, $self->id; - $me[-1] .= ".pm"; - $me = MM->catfile(@me); - $from = $self->find_bundle_file($dist->{'build_dir'},$me); - $to = MM->catfile($todir,$me); - File::Path::mkpath(File::Basename::dirname($to)); - File::Copy::copy($from, $to) - or Carp::confess("Couldn't copy $from to $to: $!"); - $parsefile = $to; - } - my @result; - my $fh = FileHandle->new; - local $/ = "\n"; - open($fh,$parsefile) or die "Could not open '$parsefile': $!"; - my $inpod = 0; - $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG; - while (<$fh>) { - $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : - /^=head1\s+CONTENTS/ ? 1 : $inpod; - next unless $inpod; - next if /^=/; - next if /^\s+$/; - chomp; - push @result, (split " ", $_, 2)[0]; - } - close $fh; - delete $self->{STATUS}; - $self->{CONTAINS} = join ", ", @result; - $self->debug("CONTAINS[@result]") if $CPAN::DEBUG; - @result; + my($self) = @_; + my($parsefile) = $self->inst_file; + my($id) = $self->id; + $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG; + unless ($parsefile) { + # Try to get at it in the cpan directory + $self->debug("no parsefile") if $CPAN::DEBUG; + Carp::confess "I don't know a $id" unless $self->{CPAN_FILE}; + my $dist = $CPAN::META->instance('CPAN::Distribution', + $self->{CPAN_FILE}); + $dist->get; + $self->debug($dist->as_string) if $CPAN::DEBUG; + my($todir) = $CPAN::Config->{'cpan_home'}; + my(@me,$from,$to,$me); + @me = split /::/, $self->id; + $me[-1] .= ".pm"; + $me = MM->catfile(@me); + $from = $self->find_bundle_file($dist->{'build_dir'},$me); + $to = MM->catfile($todir,$me); + File::Path::mkpath(File::Basename::dirname($to)); + File::Copy::copy($from, $to) + or Carp::confess("Couldn't copy $from to $to: $!"); + $parsefile = $to; + } + my @result; + my $fh = FileHandle->new; + local $/ = "\n"; + open($fh,$parsefile) or die "Could not open '$parsefile': $!"; + my $inpod = 0; + $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG; + while (<$fh>) { + $inpod = m/^=(?!head1\s+CONTENTS)/ ? 0 : + m/^=head1\s+CONTENTS/ ? 1 : $inpod; + next unless $inpod; + next if /^=/; + next if /^\s+$/; + chomp; + push @result, (split " ", $_, 2)[0]; + } + close $fh; + delete $self->{STATUS}; + $self->{CONTAINS} = join ", ", @result; + $self->debug("CONTAINS[@result]") if $CPAN::DEBUG; + unless (@result) { + $CPAN::Frontend->mywarn(qq{ +The bundle file "$parsefile" may be a broken +bundlefile. It seems not to contain any bundle definition. +Please check the file and if it is bogus, please delete it. +Sorry for the inconvenience. +}); + } + @result; } #-> sub CPAN::Bundle::find_bundle_file sub find_bundle_file { my($self,$where,$what) = @_; $self->debug("where[$where]what[$what]") if $CPAN::DEBUG; - my $bu = MM->catfile($where,$what); - return $bu if -f $bu; +### The following two lines let CPAN.pm become Bundle/CPAN.pm :-( +### my $bu = MM->catfile($where,$what); +### return $bu if -f $bu; my $manifest = MM->catfile($where,"MANIFEST"); unless (-f $manifest) { require ExtUtils::Manifest; @@ -3353,20 +3702,30 @@ sub find_bundle_file { my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!"); local($/) = "\n"; + my $what2 = $what; + if ($^O eq 'MacOS') { + $what =~ s/^://; + $what2 =~ tr|:|/|; + $what2 =~ s/:Bundle://; + $what2 =~ tr|:|/|; + } else { + $what2 =~ s|Bundle/||; + } + my $bu; while (<$fh>) { next if /^\s*\#/; my($file) = /(\S+)/; if ($file =~ m|\Q$what\E$|) { $bu = $file; - return MM->catfile($where,$bu); - } elsif ($what =~ s|Bundle/||) { # retry if she managed to - # have no Bundle directory - if ($file =~ m|\Q$what\E$|) { - $bu = $file; - return MM->catfile($where,$bu); - } + # return MM->catfile($where,$bu); # bad + last; } + # retry if she managed to + # have no Bundle directory + $bu = $file if $file =~ m|\Q$what2\E$|; } + $bu =~ tr|/|:| if $^O eq 'MacOS'; + return MM->catfile($where, $bu) if $bu; Carp::croak("Couldn't find a Bundle file in $where"); } @@ -3395,7 +3754,7 @@ sub rematein { my($id) = $self->id; Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n" unless $self->inst_file || $self->{CPAN_FILE}; - my($s); + my($s,%fail); for $s ($self->contains) { my($type) = $s =~ m|/| ? 'CPAN::Distribution' : $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module'; @@ -3406,7 +3765,26 @@ explicitly a file $s. }); sleep 3; } - $CPAN::META->instance($type,$s)->$meth(); + # possibly noisy action: + my $obj = $CPAN::META->instance($type,$s); + $obj->$meth(); + my $success = $obj->can("uptodate") ? $obj->uptodate : 0; + $success ||= $obj->{'install'} && $obj->{'install'} eq "YES"; + $fail{$s} = 1 unless $success; + } + # recap with less noise + if ( $meth eq "install") { + if (%fail) { + $CPAN::Frontend->myprint(qq{\nBundle summary: }. + qq{The following items seem to }. + qq{have had installation problems:\n}); + for $s ($self->contains) { + $CPAN::Frontend->myprint( "$s " ) if $fail{$s}; + } + $CPAN::Frontend->myprint(qq{\n}); + } else { + $self->{'install'} = 'YES'; + } } } @@ -3429,7 +3807,6 @@ sub test { shift->rematein('test',@_); } sub install { my $self = shift; $self->rematein('install',@_); - $CPAN::META->delete('CPAN::Queue',$self->id); } #-> sub CPAN::Bundle::clean ; sub clean { shift->rematein('clean',@_); } @@ -3496,9 +3873,9 @@ sub as_string { 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,; + @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,; + @stati{qw,? f r O h,} = qw,unknown functions + references+ties object-oriented hybrid,; $statd{' '} = 'unknown'; $stats{' '} = 'unknown'; $statl{' '} = 'unknown'; @@ -3544,8 +3921,8 @@ sub manpage_headline { my $inpod = 0; local $/ = "\n"; while (<$fh>) { - $inpod = /^=(?!head1\s+NAME)/ ? 0 : - /^=head1\s+NAME/ ? 1 : $inpod; + $inpod = m/^=(?!head1\s+NAME)/ ? 0 : + m/^=head1\s+NAME/ ? 1 : $inpod; next unless $inpod; next if /^=/; next if /^\s+$/; @@ -3586,7 +3963,7 @@ sub cpan_file { #-> sub CPAN::Module::cpan_version ; sub cpan_version { my $self = shift; - $self->{'CPAN_VERSION'} = 'undef' + $self->{'CPAN_VERSION'} = 'undef' unless defined $self->{'CPAN_VERSION'}; # I believe this is # always a bug in the # index and should be @@ -3640,10 +4017,9 @@ sub get { shift->rematein('get',@_); } sub make { shift->rematein('make') } #-> sub CPAN::Module::test ; sub test { shift->rematein('test') } -#-> sub CPAN::Module::install ; -sub install { +#-> sub CPAN::Module::uptodate ; +sub uptodate { my($self) = @_; - my($doit) = 0; my($latest) = $self->cpan_version; $latest ||= 0; my($inst_file) = $self->inst_file; @@ -3651,22 +4027,28 @@ sub install { if (defined $inst_file) { $have = $self->inst_version; } - if (1){ # A block for scoping $^W, the if is just for the visual - # appeal - local($^W)=0; - if ($inst_file - && - $have >= $latest - && - not exists $self->{'force_update'} - ) { - $CPAN::Frontend->myprint( $self->id. " is up to date.\n"); - } else { - $doit = 1; - } + local($^W)=0; + if ($inst_file + && + $have >= $latest + ) { + return 1; + } + return; +} +#-> sub CPAN::Module::install ; +sub install { + my($self) = @_; + my($doit) = 0; + if ($self->uptodate + && + not exists $self->{'force_update'} + ) { + $CPAN::Frontend->myprint( $self->id. " is up to date.\n"); + } else { + $doit = 1; } $self->rematein('install') if $doit; - $CPAN::META->delete('CPAN::Queue',$self->id); } #-> sub CPAN::Module::clean ; sub clean { shift->rematein('clean') } @@ -3707,6 +4089,7 @@ sub inst_version { my($self) = @_; my $parsefile = $self->inst_file or return; local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38; + # warn "HERE"; my $have = MM->parse_version($parsefile) || "undef"; $have =~ s/\s+//g; $have; @@ -3728,7 +4111,7 @@ sub gzip { $fhw->close; return 1; } else { - system("$CPAN::Config->{'gzip'} -c $read > $write")==0; + system("$CPAN::Config->{'gzip'} -c $read > $write")==0; } } @@ -3830,15 +4213,40 @@ sub untar { if (MM->maybe_command($CPAN::Config->{'gzip'}) && MM->maybe_command($CPAN::Config->{'tar'})) { - my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " . - "$file | $CPAN::Config->{tar} xvf -"; - return system($system) == 0; + if ($^O =~ /win/i) { # irgggh + # people find the most curious tar binaries that cannot handle + # pipes + my $system = "$CPAN::Config->{'gzip'} --decompress $file"; + if (system($system)==0) { + $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n}); + } else { + $CPAN::Frontend->mydie( + qq{Couldn\'t uncompress $file\n} + ); + } + $file =~ s/\.gz$//; + $system = "$CPAN::Config->{tar} xvf $file"; + if (system($system)==0) { + $CPAN::Frontend->myprint(qq{Untarred $file successfully\n}); + } else { + $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n}); + } + return 1; + } else { + my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " . + "< $file | $CPAN::Config->{tar} xvf -"; + return system($system) == 0; + } } elsif ($CPAN::META->has_inst("Archive::Tar") && $CPAN::META->has_inst("Compress::Zlib") ) { my $tar = Archive::Tar->new($file,1); $tar->extract($tar->list_files); # I'm pretty sure we have nothing # that isn't compressed + + ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1) + if ($^O eq 'MacOS'); + return 1; } else { $CPAN::Frontend->mydie(qq{ @@ -3893,7 +4301,15 @@ session. The cache manager keeps track of the disk space occupied by the make processes and deletes excess space according to a simple FIFO mechanism. -All methods provided are accessible in a programmer style and in an +For extended searching capabilities there's a plugin for CPAN available, +L. C is a full-text search engine that indexes +all documents available in CPAN authors directories. If C +is installed on your system, the interactive shell of will +enable the C, C, C, C, and C commands which send +queries to the WAIT server that has been configured for your +installation. + +All other methods provided are accessible in a programmer style and in an interactive shell style. =head2 Interactive Mode @@ -3949,11 +4365,13 @@ each as object-Eas_glimpse. E.g. =item make, test, install, clean modules or distributions -These commands take any number of arguments and investigate what is +These commands take any number of arguments and investigates what is necessary to perform the action. If the argument is a distribution -file name (recognized by embedded slashes), it is processed. If it is a -module, CPAN determines the distribution file in which this module is -included and processes that. +file name (recognized by embedded slashes), it is processed. If it is +a module, CPAN determines the distribution file in which this module +is included and processes that, following any dependencies named in +the module's Makefile.PL (this behavior is controlled by +I.) Any C or C are run unconditionally. An @@ -3983,7 +4401,7 @@ Example: OpenGL-0.4/COPYRIGHT [...] -A C command results in a +A C command results in a make clean @@ -4133,7 +4551,7 @@ functionalities that are available in the shell. =back -=head2 Methods in the four +=head2 Methods in the four Classes =head2 Cache Manager @@ -4212,7 +4630,7 @@ the $VERSION variable. Currently all programs that are dealing with version use something like this perl -MExtUtils::MakeMaker -le \ - 'print MM->parse_version($ARGV[0])' filename + 'print MM->parse_version(shift)' filename If you are author of a package and wonder if your $VERSION can be parsed, please try the above method. @@ -4239,7 +4657,7 @@ have an idea which part of the package may have a bug, it's sometimes worth to give it a try and send me more specific output. You should know that "o debug" has built-in completion support. -=head2 Floppy, Zip, and all that Jazz +=head2 Floppy, Zip, Offline Mode CPAN.pm works nicely without network too. If you maintain machines that are not networked at all, you should consider working with file: @@ -4278,10 +4696,17 @@ defined: make_install_arg same as make_arg for 'make install' makepl_arg arguments passed to 'perl Makefile.PL' pager location of external program more (or any pager) + prerequisites_policy + what to do if you are missing module prerequisites + ('follow' automatically, 'ask' me, or 'ignore') + scan_cache controls scanning of cache ('atstart' or 'never') tar location of external program tar unzip location of external program unzip urllist arrayref to nearby CPAN sites (or equivalent locations) wait_list arrayref to a wait server to try (See CPAN::WAIT) + ftp_proxy, } the three usual variables for configuring + http_proxy, } proxy requests. Both as CPAN::Config variables + no_proxy } and as environment variables configurable. You can set and query each of these options interactively in the cpan shell with the command set defined within the C command: @@ -4311,7 +4736,7 @@ works like the corresponding perl commands. =back -=head2 CD-ROM support +=head2 urllist parameter has CD-ROM support The C parameter of the configuration table contains a list of URLs that are to be used for downloading. If the list contains any @@ -4326,6 +4751,14 @@ 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. +Another peculiarity of urllist is that the site that we could +successfully fetch the last file from automatically gets a preference +token and is tried as the first site for the next request. So if you +add a new site at runtime it may happen that the previously preferred +site will be tried another time. This means that if you want to disallow +a site for the next transfer, it must be explicitly removed from +urllist. + =head1 SECURITY There's no strong security layer in CPAN.pm. CPAN.pm helps you to @@ -4333,7 +4766,7 @@ install foreign, unmasked, unsigned code on your machine. We compare to a checksum that comes from the net just as the distribution file itself. If somebody has managed to tamper with the distribution file, they may have as well tampered with the CHECKSUMS file. Future -development will go towards strong authentification. +development will go towards strong authentication. =head1 EXPORT @@ -4341,6 +4774,90 @@ Most functions in package CPAN are exported per default. The reason for this is that the primary use is intended for the cpan shell or for oneliners. +=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES + +To populate a freshly installed perl with my favorite modules is pretty +easiest by maintaining a private bundle definition file. To get a useful +blueprint of a bundle definition file, the command autobundle can be used +on the CPAN shell command line. This command writes a bundle definition +file for all modules that re installed for the currently running perl +interpreter. It's recommended to run this command only once and from then +on maintain the file manually under a private name, say +Bundle/my_bundle.pm. With a clever bundle file you can then simply say + + cpan> install Bundle::my_bundle + +then answer a few questions and then go out. + +Maintaining a bundle definition file means to keep track of two things: +dependencies and interactivity. CPAN.pm (currently) does not take into +account dependencies between distributions, so a bundle definition file +should specify distributions that depend on others B the others. +On the other hand, it's a bit annoying that many distributions need some +interactive configuring. So what I try to accomplish in my private bundle +file is to have the packages that need to be configured early in the file +and the gentle ones later, so I can go out after a few minutes and leave +CPAN.pm unattained. + +=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS + +Thanks to Graham Barr for contributing the firewall following howto. + +Firewalls can be categorized into three basic types. + +=over + +=item http firewall + +This is where the firewall machine runs a web server and to access the +outside world you must do it via the web server. If you set environment +variables like http_proxy or ftp_proxy to a values beginning with http:// +or in your web browser you have to set proxy information then you know +you are running a http firewall. + +To access servers outside these types of firewalls with perl (even for +ftp) you will need to use LWP. + +=item ftp firewall + +This where the firewall machine runs a ftp server. This kind of firewall will +only let you access ftp serves outside the firewall. This is usually done by +connecting to the firewall with ftp, then entering a username like +"user@outside.host.com" + +To access servers outside these type of firewalls with perl you +will need to use Net::FTP. + +=item One way visibility + +I say one way visibility as these firewalls try to make themselve look +invisible to the users inside the firewall. An FTP data connection is +normally created by sending the remote server your IP address and then +listening for the connection. But the remote server will not be able to +connect to you because of the firewall. So for these types of firewall +FTP connections need to be done in a passive mode. + +There are two that I can think off. + +=over + +=item SOCKS + +If you are using a SOCKS firewall you will need to compile perl and link +it with the SOCKS library, this is what is normally called a ``socksified'' +perl. With this executable you will be able to connect to servers outside +the firewall as if it is not there. + +=item IP Masquerade + +This is the firewall implemented in the Linux kernel, it allows you to +hide a complete network behind one IP address. With this firewall no +special compiling is need as you can access hosts directly. + +=back + +=back + =head1 BUGS We should give coverage for _all_ of the CPAN and not just the PAUSE @@ -4358,7 +4875,7 @@ traditional method of building a Perl module package from a shell. =head1 AUTHOR -Andreas König Ea.koenig@mind.deE +Andreas König Ea.koenig@kulturbox.deE =head1 SEE ALSO diff --git a/contrib/perl5/lib/CPAN/FirstTime.pm b/contrib/perl5/lib/CPAN/FirstTime.pm index aa7a55d..df95812 100644 --- a/contrib/perl5/lib/CPAN/FirstTime.pm +++ b/contrib/perl5/lib/CPAN/FirstTime.pm @@ -16,7 +16,7 @@ use FileHandle (); use File::Basename (); use File::Path (); use vars qw($VERSION); -$VERSION = substr q$Revision: 1.29 $, 10; +$VERSION = substr q$Revision: 1.36 $, 10; =head1 NAME @@ -37,7 +37,9 @@ file. Nothing special. sub init { my($configpm) = @_; use Config; - require CPAN::Nox; + unless ($CPAN::VERSION) { + require CPAN::Nox; + } eval {require CPAN::Config;}; $CPAN::Config ||= {}; local($/) = "\n"; @@ -45,12 +47,12 @@ sub init { local($|) = 1; my($ans,$default,$local,$cont,$url,$expected_size); - + # # Files, directories # - print qq{ + print qq[ CPAN is the world-wide archive of perl resources. It consists of about 100 sites that all replicate the same contents all around the globe. @@ -62,7 +64,7 @@ If you do not want to enter a dialog now, you can answer 'no' to this question and I\'ll try to autoconfigure. (Note: you can revisit this dialog anytime later by typing 'o conf init' at the cpan prompt.) -}; +]; my $manual_conf = ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?", @@ -111,16 +113,21 @@ First of all, I\'d like to create this directory. Where? $default = $cpan_home; while ($ans = prompt("CPAN build and cache directory?",$default)) { - File::Path::mkpath($ans); # dies if it can't - if (-d $ans && -w _) { - last; - } else { - warn "Couldn't find directory $ans + eval { File::Path::mkpath($ans); }; # dies if it can't + if ($@) { + warn "Couldn't create directory $ans. +Please retry.\n"; + next; + } + if (-d $ans && -w _) { + last; + } else { + warn "Couldn't find directory $ans or directory is not writable. Please retry.\n"; - } + } } $CPAN::Config->{cpan_home} = $ans; - + print qq{ If you want, I can keep the source files after a build in the cpan @@ -151,6 +158,42 @@ with all the intermediate files? # XXX This the time when we refetch the index files (in days) $CPAN::Config->{'index_expire'} = 1; + print qq{ + +By default, each time the CPAN module is started, cache scanning +is performed to keep the cache size in sync. To prevent from this, +disable the cache scanning with 'never'. + +}; + + $default = $CPAN::Config->{scan_cache} || 'atstart'; + do { + $ans = prompt("Perform cache scanning (atstart or never)?", $default); + } while ($ans ne 'atstart' && $ans ne 'never'); + $CPAN::Config->{scan_cache} = $ans; + + # + # prerequisites_policy + # Do we follow PREREQ_PM? + # + print qq{ + +The CPAN module can detect when a module that which you are trying to +build depends on prerequisites. If this happens, it can build the +prerequisites for you automatically ('follow'), ask you for +confirmation ('ask'), or just ignore them ('ignore'). Please set your +policy to one of the three values. + +}; + + $default = $CPAN::Config->{prerequisites_policy} || 'follow'; + do { + $ans = + prompt("Policy on building prerequisites (follow, ask or ignore)?", + $default); + } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore'); + $CPAN::Config->{prerequisites_policy} = $ans; + # # External programs # @@ -164,36 +207,46 @@ those. }; + my $old_warn = $^W; + local $^W if $^O eq 'MacOS'; my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'}; + local $^W = $old_warn; my $progname; - for $progname (qw/gzip tar unzip make lynx ncftp ftp/){ + for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){ + if ($^O eq 'MacOS') { + $CPAN::Config->{$progname} = 'not_here'; + next; + } my $progcall = $progname; - my $path = $CPAN::Config->{$progname} - || $Config::Config{$progname} - || ""; - if (MM->file_name_is_absolute($path)) { - # testing existence is not good enough, some have these exe - # extensions - - # warn "Warning: configured $path does not exist\n" unless -e $path; - # $path = ""; - } else { - $path = ''; - } - unless ($path) { - # e.g. make -> nmake - $progcall = $Config::Config{$progname} if $Config::Config{$progname}; - } + # we don't need ncftp if we have ncftpget + next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " "; + my $path = $CPAN::Config->{$progname} + || $Config::Config{$progname} + || ""; + if (MM->file_name_is_absolute($path)) { + # testing existence is not good enough, some have these exe + # extensions + + # warn "Warning: configured $path does not exist\n" unless -e $path; + # $path = ""; + } else { + $path = ''; + } + unless ($path) { + # e.g. make -> nmake + $progcall = $Config::Config{$progname} if $Config::Config{$progname}; + } - $path ||= find_exe($progcall,[@path]); - warn "Warning: $progcall not found in PATH\n" unless - $path; # not -e $path, because find_exe already checked that - $ans = prompt("Where is your $progname program?",$path) || $path; - $CPAN::Config->{$progname} = $ans; + $path ||= find_exe($progcall,[@path]); + warn "Warning: $progcall not found in PATH\n" unless + $path; # not -e $path, because find_exe already checked that + $ans = prompt("Where is your $progname program?",$path) || $path; + $CPAN::Config->{$progname} = $ans; } my $path = $CPAN::Config->{'pager'} || $ENV{PAGER} || find_exe("less",[@path]) || - find_exe("more",[@path]) || "more"; + find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 ) + || "more"; $ans = prompt("What is your favorite pager program?",$path); $CPAN::Config->{'pager'} = $ans; $path = $CPAN::Config->{'shell'}; @@ -202,9 +255,13 @@ those. $path = ""; } $path ||= $ENV{SHELL}; - $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only - $ans = prompt("What is your favorite shell?",$path); - $CPAN::Config->{'shell'} = $ans; + if ($^O eq 'MacOS') { + $CPAN::Config->{'shell'} = 'not_here'; + } else { + $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only + $ans = prompt("What is your favorite shell?",$path); + $CPAN::Config->{'shell'} = $ans; + } # # Arguments to make etc. @@ -327,11 +384,38 @@ sub find_exe { } } +sub picklist { + my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_; + $default ||= ''; + + my ($item, $i); + for $item (@$items) { + printf "(%d) %s\n", ++$i, $item; + } + + my @nums; + while (1) { + my $num = prompt($prompt,$default); + @nums = split (' ', $num); + (warn "invalid items entered, try again\n"), next + if grep (/\D/ || $_ < 1 || $_ > $i, @nums); + if ($require_nonempty) { + (warn "$empty_warning\n"), next + unless @nums; + } + last; + } + print "\n"; + for (@nums) { $_-- } + @{$items}[@nums]; +} + sub read_mirrored_by { my($local) = @_; my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location); my $fh = FileHandle->new; $fh->open($local) or die "Couldn't open $local: $!"; + local $/ = "\012"; while (<$fh>) { ($host) = /^([\w\.\-]+)/ unless defined $host; next unless defined $host; @@ -339,6 +423,7 @@ sub read_mirrored_by { /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and ($continent, $country) = @location[-1,-2]; $continent =~ s/\s\(.*//; + $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1; next unless $host && $dst && $continent && $country; $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst); @@ -347,93 +432,97 @@ sub read_mirrored_by { } $fh->close; $CPAN::Config->{urllist} ||= []; - if ($expected_size = @{$CPAN::Config->{urllist}}) { - for $url (@{$CPAN::Config->{urllist}}) { - # sanity check, scheme+colon, not "q" there: - next unless $url =~ /^\w+:\/./; - $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url); - } + my(@previous_urls); + if (@previous_urls = @{$CPAN::Config->{urllist}}) { $CPAN::Config->{urllist} = []; - } else { - $expected_size = 6; } - + print qq{ -Now we need to know, where your favorite CPAN sites are located. Push +Now we need to know where your favorite CPAN sites are located. Push a few sites onto the array (just in case the first on the array won\'t work). If you are mirroring CPAN to your local workstation, specify a file: URL. -You can enter the number in front of the URL on the next screen, a -file:, ftp: or http: URL, or "q" to finish selecting. +First, pick a nearby continent and country (you can pick several of +each, separated by spaces, or none if you just want to keep your +existing selections). Then, you will be presented with a list of URLs +of CPAN mirrors in the countries you selected, along with previously +selected URLs. Select some of those URLs, or just keep the old list. +Finally, you will be prompted for any extra URLs -- file:, ftp:, or +http: -- that host a CPAN mirror. }; - $ans = prompt("Press RETURN to continue"); - my $other; - $ans = $other = ""; - my(%seen); - - my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null"; - while () { - my(@valid,$previous_best); - my $fh = FileHandle->new; - $fh->open($pipe); - { - my($cont,$country,$url,$item); - my(@cont) = sort keys %all; - for $cont (@cont) { - $fh->print(" $cont\n"); - for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) { - for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) { - my $t = sprintf( - " %-16s (%2d) %s\n", - $country, - ++$item, - $url - ); - if ($cont =~ /^\[/) { - $previous_best ||= $item; - } - push @valid, $all{$cont}{$country}{$url}; - $fh->print($t); - } - } - } - } - $fh->close; - $previous_best ||= ""; - $default = - @{$CPAN::Config->{urllist}} >= - $expected_size ? "q" : $previous_best; - $ans = prompt( - "\nSelect an$other ftp or file URL or a number (q to finish)", - $default - ); - my $sel; - if ($ans =~ /^\d/) { - my $this = $valid[$ans-1]; - my($con,$cou,$url) = ($this->continent,$this->country,$this->url); - push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++; - delete $all{$con}{$cou}{$url}; - # print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n"; - } elsif ($ans =~ /^q/i) { - last; - } else { - $ans =~ s|/?$|/|; # has to end with one slash - $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: - if ($ans =~ /^\w+:\/./) { - push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++; - } else { - print qq{"$ans" doesn\'t look like an URL at first sight. -I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm -later and report a bug in my Makefile.PL to me (andreas koenig). -Thanks.\n}; - } - } - $other ||= "other"; + my (@cont, $cont, %cont, @countries, @urls, %seen); + my $no_previous_warn = + "Sorry! since you don't have any existing picks, you must make a\n" . + "geographic selection."; + @cont = picklist([sort keys %all], + "Select your continent (or several nearby continents)", + '', + ! @previous_urls, + $no_previous_warn); + + + foreach $cont (@cont) { + my @c = sort keys %{$all{$cont}}; + @cont{@c} = map ($cont, 0..$#c); + @c = map ("$_ ($cont)", @c) if @cont > 1; + push (@countries, @c); + } + + if (@countries) { + @countries = picklist (\@countries, + "Select your country (or several nearby countries)", + '', + ! @previous_urls, + $no_previous_warn); + %seen = map (($_ => 1), @previous_urls); + # hmmm, should take list of defaults from CPAN::Config->{'urllist'}... + foreach $country (@countries) { + (my $bare_country = $country) =~ s/ \(.*\)//; + my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}}; + @u = grep (! $seen{$_}, @u); + @u = map ("$_ ($bare_country)", @u) + if @countries > 1; + push (@urls, @u); + } } + push (@urls, map ("$_ (previous pick)", @previous_urls)); + my $prompt = "Select as many URLs as you like"; + if (@previous_urls) { + $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) .. + (scalar @urls)); + $prompt .= "\n(or just hit RETURN to keep your previous picks)"; + } + + @urls = picklist (\@urls, $prompt, $default); + foreach (@urls) { s/ \(.*\)//; } + %seen = map (($_ => 1), @urls); + + do { + $ans = prompt ("Enter another URL or RETURN to quit:", ""); + + if ($ans) { + $ans =~ s|/?$|/|; # has to end with one slash + $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: + if ($ans =~ /^\w+:\/./) { + push @urls, $ans + unless $seen{$ans}; + } + else { + print qq{"$ans" doesn\'t look like an URL at first sight. +I\'ll ignore it for now. You can add it to $INC{'CPAN/MyConfig.pm'} +later if you\'re sure it\'s right.\n}; + } + } + } while $ans; + + push @{$CPAN::Config->{urllist}}, @urls; + # xxx delete or comment these out when you're happy that it works + print "New set of picks:\n"; + map { print " $_\n" } @{$CPAN::Config->{urllist}}; } 1; diff --git a/contrib/perl5/lib/CPAN/Nox.pm b/contrib/perl5/lib/CPAN/Nox.pm index c4016a4..e9cb189 100644 --- a/contrib/perl5/lib/CPAN/Nox.pm +++ b/contrib/perl5/lib/CPAN/Nox.pm @@ -1,7 +1,10 @@ +package CPAN::Nox; + BEGIN{$CPAN::Suppress_readline=1 unless defined $CPAN::term;} use CPAN; +$VERSION = "1.00"; $CPAN::META->has_inst('MD5','no'); $CPAN::META->has_inst('LWP','no'); $CPAN::META->has_inst('Compress::Zlib','no'); diff --git a/contrib/perl5/lib/Carp.pm b/contrib/perl5/lib/Carp.pm index 6bac364..f8f750a 100644 --- a/contrib/perl5/lib/Carp.pm +++ b/contrib/perl5/lib/Carp.pm @@ -35,7 +35,7 @@ and a carp as a cluck across I modules. In other words, force a detailed stack trace to be given. This can be very helpful when trying to understand why, or from where, a warning or error is being generated. -This feature is enabled by 'importing' the non-existant symbol +This feature is enabled by 'importing' the non-existent symbol 'verbose'. You would typically enable it by saying perl -MCarp=verbose script.pl @@ -43,6 +43,12 @@ This feature is enabled by 'importing' the non-existant symbol or by including the string C in the L environment variable. +=head1 BUGS + +The Carp routines don't handle exception objects currently. +If called with a first argument that is a reference, they simply +call die() or warn(), as appropriate. + =cut # This package is heavily used. Be small. Be fast. Be good. @@ -88,6 +94,7 @@ sub export_fail { # each function call on the stack. sub longmess { + return @_ if ref $_[0]; my $error = join '', @_; my $mess = ""; my $i = 1 + $CarpLevel; @@ -190,6 +197,7 @@ sub longmess { sub shortmess { # Short-circuit &longmess if called via multiple packages goto &longmess if $Verbose; + return @_ if ref $_[0]; my $error = join '', @_; my ($prevpack) = caller(1); my $extra = $CarpLevel; diff --git a/contrib/perl5/lib/Cwd.pm b/contrib/perl5/lib/Cwd.pm index 7febb0d..5c10e8e 100644 --- a/contrib/perl5/lib/Cwd.pm +++ b/contrib/perl5/lib/Cwd.pm @@ -32,7 +32,7 @@ The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions in Perl. The abs_path() function takes a single argument and returns the -absolute pathname for that argument. It uses the same algoritm as +absolute pathname for that argument. It uses the same algorithm as getcwd(). (actually getcwd() is abs_path(".")) The fastcwd() function looks the same as getcwd(), but runs faster. @@ -269,7 +269,7 @@ sub fast_abs_path { # --- PORTING SECTION --- # VMS: $ENV{'DEFAULT'} points to default directory at all times -# 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu +# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu # Note: Use of Cwd::chdir() causes the logical name PWD to be defined # in the process logical name table as the default device and directory # seen by Perl. This may not be the same as the default device diff --git a/contrib/perl5/lib/Dumpvalue.pm b/contrib/perl5/lib/Dumpvalue.pm new file mode 100644 index 0000000..5bcd58f --- /dev/null +++ b/contrib/perl5/lib/Dumpvalue.pm @@ -0,0 +1,600 @@ +require 5.005; # For (defined ref) and $#$v +package Dumpvalue; +use strict; +use vars qw(%address *stab %subs); + +# translate control chars to ^X - Randal Schwartz +# Modifications to print types by Peter Gordon v1.0 + +# Ilya Zakharevich -- patches after 5.001 (and some before ;-) + +# Won't dump symbol tables and contents of debugged files by default + +# (IZ) changes for objectification: +# c) quote() renamed to method set_quote(); +# d) unctrlSet() renamed to method set_unctrl(); +# f) Compiles with `use strict', but in two places no strict refs is needed: +# maybe more problems are waiting... + +my %defaults = ( + globPrint => 0, + printUndef => 1, + tick => "auto", + unctrl => 'quote', + subdump => 1, + dumpReused => 0, + bareStringify => 1, + hashDepth => '', + arrayDepth => '', + dumpDBFiles => '', + dumpPackages => '', + quoteHighBit => '', + usageOnly => '', + compactDump => '', + veryCompact => '', + stopDbSignal => '', + ); + +sub new { + my $class = shift; + my %opt = (%defaults, @_); + bless \%opt, $class; +} + +sub set { + my $self = shift; + my %opt = @_; + @$self{keys %opt} = values %opt; +} + +sub get { + my $self = shift; + wantarray ? @$self{@_} : $$self{pop @_}; +} + +sub dumpValue { + my $self = shift; + die "usage: \$dumper->dumpValue(value)" unless @_ == 1; + local %address; + local $^W=0; + (print "undef\n"), return unless defined $_[0]; + (print $self->stringify($_[0]), "\n"), return unless ref $_[0]; + $self->unwrap($_[0],0); +} + +sub dumpValues { + my $self = shift; + local %address; + local $^W=0; + (print "undef\n"), return unless defined $_[0]; + $self->unwrap(\@_,0); +} + +# This one is good for variable names: + +sub unctrl { + local($_) = @_; + + return \$_ if ref \$_ eq "GLOB"; + s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg; + $_; +} + +sub stringify { + my $self = shift; + local $_ = shift; + my $noticks = shift; + my $tick = $self->{tick}; + + return 'undef' unless defined $_ or not $self->{printUndef}; + return $_ . "" if ref \$_ eq 'GLOB'; + { no strict 'refs'; + $_ = &{'overload::StrVal'}($_) + if $self->{bareStringify} and ref $_ + and defined %overload:: and defined &{'overload::StrVal'}; + } + + if ($tick eq 'auto') { + if (/[\000-\011\013-\037\177]/) { + $tick = '"'; + } else { + $tick = "'"; + } + } + if ($tick eq "'") { + s/([\'\\])/\\$1/g; + } elsif ($self->{unctrl} eq 'unctrl') { + s/([\"\\])/\\$1/g ; + s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg; + s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg + if $self->{quoteHighBit}; + } elsif ($self->{unctrl} eq 'quote') { + s/([\"\\\$\@])/\\$1/g if $tick eq '"'; + s/\033/\\e/g; + s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg; + } + s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $self->{quoteHighBit}; + ($noticks || /^\d+(\.\d*)?\Z/) + ? $_ + : $tick . $_ . $tick; +} + +sub DumpElem { + my ($self, $v) = (shift, shift); + my $short = $self->stringify($v, ref $v); + my $shortmore = ''; + if ($self->{veryCompact} && ref $v + && (ref $v eq 'ARRAY' and !grep(ref $_, @$v) )) { + my $depth = $#$v; + ($shortmore, $depth) = (' ...', $self->{arrayDepth} - 1) + if $self->{arrayDepth} and $depth >= $self->{arrayDepth}; + my @a = map $self->stringify($_), @$v[0..$depth]; + print "0..$#{$v} @a$shortmore\n"; + } elsif ($self->{veryCompact} && ref $v + && (ref $v eq 'HASH') and !grep(ref $_, values %$v)) { + my @a = sort keys %$v; + my $depth = $#a; + ($shortmore, $depth) = (' ...', $self->{hashDepth} - 1) + if $self->{hashDepth} and $depth >= $self->{hashDepth}; + my @b = map {$self->stringify($_) . " => " . $self->stringify($$v{$_})} + @a[0..$depth]; + local $" = ', '; + print "@b$shortmore\n"; + } else { + print "$short\n"; + $self->unwrap($v,shift); + } +} + +sub unwrap { + my $self = shift; + return if $DB::signal and $self->{stopDbSignal}; + my ($v) = shift ; + my ($s) = shift ; # extra no of spaces + my $sp; + my (%v,@v,$address,$short,$fileno); + + $sp = " " x $s ; + $s += 3 ; + + # Check for reused addresses + if (ref $v) { + my $val = $v; + { no strict 'refs'; + $val = &{'overload::StrVal'}($v) + if defined %overload:: and defined &{'overload::StrVal'}; + } + ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; + if (!$self->{dumpReused} && defined $address) { + $address{$address}++ ; + if ( $address{$address} > 1 ) { + print "${sp}-> REUSED_ADDRESS\n" ; + return ; + } + } + } elsif (ref \$v eq 'GLOB') { + $address = "$v" . ""; # To avoid a bug with globs + $address{$address}++ ; + if ( $address{$address} > 1 ) { + print "${sp}*DUMPED_GLOB*\n" ; + return ; + } + } + + if ( UNIVERSAL::isa($v, 'HASH') ) { + my @sortKeys = sort keys(%$v) ; + my $more; + my $tHashDepth = $#sortKeys ; + $tHashDepth = $#sortKeys < $self->{hashDepth}-1 ? $#sortKeys : $self->{hashDepth}-1 + unless $self->{hashDepth} eq '' ; + $more = "....\n" if $tHashDepth < $#sortKeys ; + my $shortmore = ""; + $shortmore = ", ..." if $tHashDepth < $#sortKeys ; + $#sortKeys = $tHashDepth ; + if ($self->{compactDump} && !grep(ref $_, values %{$v})) { + $short = $sp; + my @keys; + for (@sortKeys) { + push @keys, $self->stringify($_) . " => " . $self->stringify($v->{$_}); + } + $short .= join ', ', @keys; + $short .= $shortmore; + (print "$short\n"), return if length $short <= $self->{compactDump}; + } + for my $key (@sortKeys) { + return if $DB::signal and $self->{stopDbSignal}; + my $value = $ {$v}{$key} ; + print $sp, $self->stringify($key), " => "; + $self->DumpElem($value, $s); + } + print "$sp empty hash\n" unless @sortKeys; + print "$sp$more" if defined $more ; + } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) { + my $tArrayDepth = $#{$v} ; + my $more ; + $tArrayDepth = $#$v < $self->{arrayDepth}-1 ? $#$v : $self->{arrayDepth}-1 + unless $self->{arrayDepth} eq '' ; + $more = "....\n" if $tArrayDepth < $#{$v} ; + my $shortmore = ""; + $shortmore = " ..." if $tArrayDepth < $#{$v} ; + if ($self->{compactDump} && !grep(ref $_, @{$v})) { + if ($#$v >= 0) { + $short = $sp . "0..$#{$v} " . + join(" ", + map {$self->stringify($_)} @{$v}[0..$tArrayDepth]) + . "$shortmore"; + } else { + $short = $sp . "empty array"; + } + (print "$short\n"), return if length $short <= $self->{compactDump}; + } + for my $num ($[ .. $tArrayDepth) { + return if $DB::signal and $self->{stopDbSignal}; + print "$sp$num "; + $self->DumpElem($v->[$num], $s); + } + print "$sp empty array\n" unless @$v; + print "$sp$more" if defined $more ; + } elsif ( UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) { + print "$sp-> "; + $self->DumpElem($$v, $s); + } elsif ( UNIVERSAL::isa($v, 'CODE') ) { + print "$sp-> "; + $self->dumpsub(0, $v); + } elsif ( UNIVERSAL::isa($v, 'GLOB') ) { + print "$sp-> ",$self->stringify($$v,1),"\n"; + if ($self->{globPrint}) { + $s += 3; + $self->dumpglob('', $s, "{$$v}", $$v, 1); + } elsif (defined ($fileno = fileno($v))) { + print( (' ' x ($s+3)) . "FileHandle({$$v}) => fileno($fileno)\n" ); + } + } elsif (ref \$v eq 'GLOB') { + if ($self->{globPrint}) { + $self->dumpglob('', $s, "{$v}", $v, 1); + } elsif (defined ($fileno = fileno(\$v))) { + print( (' ' x $s) . "FileHandle({$v}) => fileno($fileno)\n" ); + } + } +} + +sub matchvar { + $_[0] eq $_[1] or + ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and + ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/}); +} + +sub compactDump { + my $self = shift; + $self->{compactDump} = shift if @_; + $self->{compactDump} = 6*80-1 + if $self->{compactDump} and $self->{compactDump} < 2; + $self->{compactDump}; +} + +sub veryCompact { + my $self = shift; + $self->{veryCompact} = shift if @_; + $self->compactDump(1) if !$self->{compactDump} and $self->{veryCompact}; + $self->{veryCompact}; +} + +sub set_unctrl { + my $self = shift; + if (@_) { + my $in = shift; + if ($in eq 'unctrl' or $in eq 'quote') { + $self->{unctrl} = $in; + } else { + print "Unknown value for `unctrl'.\n"; + } + } + $self->{unctrl}; +} + +sub set_quote { + my $self = shift; + if (@_ and $_[0] eq '"') { + $self->{tick} = '"'; + $self->{unctrl} = 'quote'; + } elsif (@_ and $_[0] eq 'auto') { + $self->{tick} = 'auto'; + $self->{unctrl} = 'quote'; + } elsif (@_) { # Need to set + $self->{tick} = "'"; + $self->{unctrl} = 'unctrl'; + } + $self->{tick}; +} + +sub dumpglob { + my $self = shift; + return if $DB::signal and $self->{stopDbSignal}; + my ($package, $off, $key, $val, $all) = @_; + local(*stab) = $val; + my $fileno; + if (($key !~ /^_{dumpDBFiles}) and defined $stab) { + print( (' ' x $off) . "\$", &unctrl($key), " = " ); + $self->DumpElem($stab, 3+$off); + } + if (($key !~ /^_{dumpDBFiles}) and defined @stab) { + print( (' ' x $off) . "\@$key = (\n" ); + $self->unwrap(\@stab,3+$off) ; + print( (' ' x $off) . ")\n" ); + } + if ($key ne "main::" && $key ne "DB::" && defined %stab + && ($self->{dumpPackages} or $key !~ /::$/) + && ($key !~ /^_{dumpDBFiles}) + && !($package eq "Dumpvalue" and $key eq "stab")) { + print( (' ' x $off) . "\%$key = (\n" ); + $self->unwrap(\%stab,3+$off) ; + print( (' ' x $off) . ")\n" ); + } + if (defined ($fileno = fileno(*stab))) { + print( (' ' x $off) . "FileHandle($key) => fileno($fileno)\n" ); + } + if ($all) { + if (defined &stab) { + $self->dumpsub($off, $key); + } + } +} + +sub dumpsub { + my $self = shift; + my ($off,$sub) = @_; + $sub = $1 if $sub =~ /^\{\*(.*)\}$/; + my $subref = \&$sub; + my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub}) + || ($self->{subdump} && ($sub = $self->findsubs("$subref")) + && $DB::sub{$sub}); + $place = '???' unless defined $place; + print( (' ' x $off) . "&$sub in $place\n" ); +} + +sub findsubs { + my $self = shift; + return undef unless defined %DB::sub; + my ($addr, $name, $loc); + while (($name, $loc) = each %DB::sub) { + $addr = \&$name; + $subs{"$addr"} = $name; + } + $self->{subdump} = 0; + $subs{ shift() }; +} + +sub dumpvars { + my $self = shift; + my ($package,@vars) = @_; + local(%address,$^W); + my ($key,$val); + $package .= "::" unless $package =~ /::$/; + *stab = *main::; + + while ($package =~ /(\w+?::)/g) { + *stab = $ {stab}{$1}; + } + $self->{TotalStrings} = 0; + $self->{Strings} = 0; + $self->{CompleteTotal} = 0; + while (($key,$val) = each(%stab)) { + return if $DB::signal and $self->{stopDbSignal}; + next if @vars && !grep( matchvar($key, $_), @vars ); + if ($self->{usageOnly}) { + $self->globUsage(\$val, $key) + unless $package eq 'Dumpvalue' and $key eq 'stab'; + } else { + $self->dumpglob($package, 0,$key, $val); + } + } + if ($self->{usageOnly}) { + print <{TotalStrings} bytes in $self->{Strings} strings. +EOP + $self->{CompleteTotal} += $self->{TotalStrings}; + print <{CompleteTotal} bytes (1 level deep) + overhead. +EOP + } +} + +sub scalarUsage { + my $self = shift; + my $size = length($_[0]); + $self->{TotalStrings} += $size; + $self->{Strings}++; + $size; +} + +sub arrayUsage { # array ref, name + my $self = shift; + my $size = 0; + map {$size += $self->scalarUsage($_)} @{$_[0]}; + my $len = @{$_[0]}; + print "\@$_[1] = $len item", ($len > 1 ? "s" : ""), " (data: $size bytes)\n" + if defined $_[1]; + $self->{CompleteTotal} += $size; + $size; +} + +sub hashUsage { # hash ref, name + my $self = shift; + my @keys = keys %{$_[0]}; + my @values = values %{$_[0]}; + my $keys = $self->arrayUsage(\@keys); + my $values = $self->arrayUsage(\@values); + my $len = @keys; + my $total = $keys + $values; + print "\%$_[1] = $len item", ($len > 1 ? "s" : ""), + " (keys: $keys; values: $values; total: $total bytes)\n" + if defined $_[1]; + $total; +} + +sub globUsage { # glob ref, name + my $self = shift; + local *stab = *{$_[0]}; + my $total = 0; + $total += $self->scalarUsage($stab) if defined $stab; + $total += $self->arrayUsage(\@stab, $_[1]) if defined @stab; + $total += $self->hashUsage(\%stab, $_[1]) + if defined %stab and $_[1] ne "main::" and $_[1] ne "DB::"; + #and !($package eq "Dumpvalue" and $key eq "stab")); + $total; +} + +1; + +=head1 NAME + +Dumpvalue - provides screen dump of Perl data. + +=head1 SYNOPSYS + + use Dumpvalue; + my $dumper = new Dumpvalue; + $dumper->set(globPrint => 1); + $dumper->dumpValue(\*::); + $dumper->dumpvars('main'); + +=head1 DESCRIPTION + +=head2 Creation + +A new dumper is created by a call + + $d = new Dumpvalue(option1 => value1, option2 => value2) + +Recognized options: + +=over + +=item C, C + +Print only first N elements of arrays and hashes. If false, prints all the +elements. + +=item C, C + +Change style of array and hash dump. If true, short array +may be printed on one line. + +=item C + +Whether to print contents of globs. + +=item C + +Dump arrays holding contents of debugged files. + +=item C + +Dump symbol tables of packages. + +=item C + +Dump contents of "reused" addresses. + +=item C, C, C + +Change style of string dump. Default value of C is C, one +can enable either double-quotish dump, or single-quotish by setting it +to C<"> or C<'>. By default, characters with high bit set are printed +I. + +=item C + +I rudimentally per-package memory usage dump. If set, +C calculates total size of strings in variables in the package. + +=item unctrl + +Changes the style of printout of strings. Possible values are +C and C. + +=item subdump + +Whether to try to find the subroutine name given the reference. + +=item bareStringify + +Whether to write the non-overloaded form of the stringify-overloaded objects. + +=item quoteHighBit + +Whether to print chars with high bit set in binary or "as is". + +=item stopDbSignal + +Whether to abort printing if debugger signal flag is raised. + +=back + +Later in the life of the object the methods may be queries with get() +method and set() method (which accept multiple arguments). + +=head2 Methods + +=over + +=item dumpValue + + $dumper->dumpValue($value); + $dumper->dumpValue([$value1, $value2]); + +=item dumpValues + + $dumper->dumpValues($value1, $value2); + +=item dumpvars + + $dumper->dumpvars('my_package'); + $dumper->dumpvars('my_package', 'foo', '~bar$', '!......'); + +The optional arguments are considered as literal strings unless they +start with C<~> or C, in which case they are interpreted as regular +expressions (possibly negated). + +The second example prints entries with names C, and also entries +with names which ends on C, or are shorter than 5 chars. + +=item set_quote + + $d->set_quote('"'); + +Sets C and C options to suitable values for printout with the +given quote char. Possible values are C, C<'> and C<">. + +=item set_unctrl + + $d->set_unctrl('"'); + +Sets C option with checking for an invalid argument. +Possible values are C and C. + +=item compactDump + + $d->compactDump(1); + +Sets C option. If the value is 1, sets to a reasonable +big number. + +=item veryCompact + + $d->veryCompact(1); + +Sets C and C options simultaneously. + +=item set + + $d->set(option1 => value1, option2 => value2); + +=item get + + @values = $d->get('option1', 'option2'); + +=back + +=cut + diff --git a/contrib/perl5/lib/English.pm b/contrib/perl5/lib/English.pm index bbb6bd7..9f29a48 100644 --- a/contrib/perl5/lib/English.pm +++ b/contrib/perl5/lib/English.pm @@ -15,6 +15,14 @@ English - use nice English (or awk) names for ugly punctuation variables =head1 DESCRIPTION +You should I use this module in programs intended to be portable +among Perl versions, programs that must perform regular expression +matching operations efficiently, or libraries intended for use with +such programs. In a sense, this module is deprecated. The reasons +for this have to do with implementation details of the Perl +interpreter which are too thorny to go into here. Perhaps someday +they will be fixed to make "C" more practical. + This module provides aliases for the built-in variables whose names no one seems to like to read. Variables with side-effects which get triggered just by accessing them (like $0) will still @@ -160,6 +168,7 @@ sub import { *PERL_VERSION = *] ; *ACCUMULATOR = *^A ; + *COMPILING = *^C ; *DEBUGGING = *^D ; *SYSTEM_FD_MAX = *^F ; *INPLACE_EDIT = *^I ; diff --git a/contrib/perl5/lib/ExtUtils/Command.pm b/contrib/perl5/lib/ExtUtils/Command.pm index 2f5f1e1..e900e51 100644 --- a/contrib/perl5/lib/ExtUtils/Command.pm +++ b/contrib/perl5/lib/ExtUtils/Command.pm @@ -31,8 +31,8 @@ ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. =head1 DESCRIPTION -The module is used in Win32 port to replace common UNIX commands. -Most commands are wrapers on generic modules File::Path and File::Basename. +The module is used in the Win32 port to replace common UNIX commands. +Most commands are wrappers on generic modules File::Path and File::Basename. =over 4 diff --git a/contrib/perl5/lib/ExtUtils/Embed.pm b/contrib/perl5/lib/ExtUtils/Embed.pm index e41ca40..4b56e88 100644 --- a/contrib/perl5/lib/ExtUtils/Embed.pm +++ b/contrib/perl5/lib/ExtUtils/Embed.pm @@ -416,7 +416,7 @@ This will print arguments for linking with B, B and extensions found in B<$Config{static_ext}>. This includes libraries found in B<$Config{libs}> and the first ModuleName.a library for each extension that is found by searching B<@INC> or the path -specifed by the B<-I> option. +specified by the B<-I> option. In addition, when ModuleName.a is found, additional linker arguments are picked up from the B file in the same directory. diff --git a/contrib/perl5/lib/ExtUtils/Install.pm b/contrib/perl5/lib/ExtUtils/Install.pm index 6a5c184..f75aa55 100644 --- a/contrib/perl5/lib/ExtUtils/Install.pm +++ b/contrib/perl5/lib/ExtUtils/Install.pm @@ -354,7 +354,7 @@ The argument is the value of MakeMaker's C key, like F. This function calls install() with the same arguments as the defaults the MakeMaker would use. -The argumement-less form is convenient for install scripts like +The argument-less form is convenient for install scripts like perl -MExtUtils::Install -e install_default Tk/Canvas diff --git a/contrib/perl5/lib/ExtUtils/Liblist.pm b/contrib/perl5/lib/ExtUtils/Liblist.pm index b072c12..dae3125 100644 --- a/contrib/perl5/lib/ExtUtils/Liblist.pm +++ b/contrib/perl5/lib/ExtUtils/Liblist.pm @@ -225,6 +225,9 @@ sub _win32_ext { my $search = 1; my($fullname, $thislib, $thispth); + # add "$Config{installarchlib}/CORE" to default search path + push @libpath, "$Config{installarchlib}/CORE"; + foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ $thislib = $_; @@ -240,8 +243,8 @@ sub _win32_ext { # if searching is disabled, do compiler-specific translations unless ($search) { - s/^-L/-libpath:/ if $VC; s/^-l(.+)$/$1.lib/ unless $GC; + s/^-L/-libpath:/ if $VC; push(@extralibs, $_); $found++; next; @@ -575,7 +578,7 @@ Unix-OS/2 version in several respects: =item * Input library and path specifications are accepted with or without the -C<-l> and C<-L> prefices used by Unix linkers. If neither prefix is +C<-l> and C<-L> prefixes used by Unix linkers. If neither prefix is present, a token is considered a directory to search if it is in fact a directory, and a library to search for otherwise. Authors who wish their extensions to be portable to Unix or OS/2 should use the Unix @@ -586,7 +589,7 @@ prefixes, since the Unix-OS/2 version of ext() requires them. Wherever possible, shareable images are preferred to object libraries, and object libraries to plain object files. In accordance with VMS naming conventions, ext() looks for files named Ishr and Irtl; -it also looks for Ilib and libI to accomodate Unix conventions +it also looks for Ilib and libI to accommodate Unix conventions used in some ported software. =item * @@ -625,14 +628,15 @@ Unix-OS/2 version in several respects: If C<$potential_libs> is empty, the return value will be empty. Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) will be appended to the list of C<$potential_libs>. The libraries -will be searched for in the directories specified in C<$potential_libs> -as well as in C<$Config{libpth}>. For each library that is found, a -space-separated list of fully qualified library pathnames is generated. +will be searched for in the directories specified in C<$potential_libs>, +C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. +For each library that is found, a space-separated list of fully qualified +library pathnames is generated. =item * Input library and path specifications are accepted with or without the -C<-l> and C<-L> prefices used by Unix linkers. +C<-l> and C<-L> prefixes used by Unix linkers. An entry of the form C<-La:\foo> specifies the C directory to look for the libraries that follow. @@ -651,7 +655,7 @@ library to search for otherwise. The C<$Config{lib_ext}> suffix will be appended to any entries that are not directories and don't already have the suffix. -Note that the C<-L> and <-l> prefixes are B, but authors +Note that the C<-L> and C<-l> prefixes are B, but authors who wish their extensions to be portable to Unix or OS/2 should use the prefixes, since the Unix-OS/2 version of ext() requires them. diff --git a/contrib/perl5/lib/ExtUtils/MM_OS2.pm b/contrib/perl5/lib/ExtUtils/MM_OS2.pm index 8bddb42..5d6034c 100644 --- a/contrib/perl5/lib/ExtUtils/MM_OS2.pm +++ b/contrib/perl5/lib/ExtUtils/MM_OS2.pm @@ -15,6 +15,7 @@ sub dlsyms { my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; my(@m); (my $boot = $self->{NAME}) =~ s/:/_/g; @@ -27,14 +28,46 @@ $self->{BASEEXT}.def: Makefile.PL Mksymlists("NAME" => "', $self->{NAME}, '", "DLBASE" => "',$self->{DLBASE}, '", "DL_FUNCS" => ',neatvalue($funcs), + ', "FUNCLIST" => ',neatvalue($funclist), ', "IMPORTS" => ',neatvalue($imports), ', "VERSION" => "',$self->{VERSION}, '", "DL_VARS" => ', neatvalue($vars), ');\' '); } + if (%{$self->{IMPORTS}}) { + # Make import files (needed for static build) + -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp"; + open IMP, '>tmpimp.imp' or die "Can't open tmpimp.imp"; + my ($name, $exp); + while (($name, $exp)= each %{$self->{IMPORTS}}) { + my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'"; + print IMP "$name $lib $id ?\n"; + } + close IMP or die "Can't close tmpimp.imp"; + # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n"; + system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp" + and die "Cannot make import library: $!, \$?=$?"; + unlink ; + system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}" + and die "Cannot extract import objects: $!, \$?=$?"; + } join('',@m); } +sub static_lib { + my($self) = @_; + my $old = $self->ExtUtils::MM_Unix::static_lib(); + return $old unless %{$self->{IMPORTS}}; + + my @chunks = split /\n{2,}/, $old; + shift @chunks unless length $chunks[0]; # Empty lines at the start + $chunks[0] .= <<'EOC'; + + $(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@ +EOC + return join "\n\n". '', @chunks; +} + sub replace_manpage_separator { my($self,$man) = @_; $man =~ s,/+,.,g; diff --git a/contrib/perl5/lib/ExtUtils/MM_Unix.pm b/contrib/perl5/lib/ExtUtils/MM_Unix.pm index 9a96504..38bb061 100644 --- a/contrib/perl5/lib/ExtUtils/MM_Unix.pm +++ b/contrib/perl5/lib/ExtUtils/MM_Unix.pm @@ -8,7 +8,7 @@ use strict; use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT $Verbose %pm %static $Xsubpp_Version); -$VERSION = substr q$Revision: 1.12601 $, 10; +$VERSION = substr q$Revision: 1.12602 $, 10; # $Id: MM_Unix.pm,v 1.126 1998/06/28 21:32:49 k Exp k $ Exporter::import('ExtUtils::MakeMaker', @@ -19,7 +19,7 @@ $Is_Mac = $^O eq 'MacOS'; $Is_Win32 = $^O eq 'MSWin32'; $Is_Dos = $^O eq 'dos'; -$Is_PERL_OBJECT = 1 if $Config{'ccflags'} =~ /-DPERL_OBJECT/; +$Is_PERL_OBJECT = $Config{'ccflags'} =~ /-DPERL_OBJECT/; if ($Is_VMS = $^O eq 'VMS') { require VMS::Filespec; @@ -84,10 +84,10 @@ sub canonpath { if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) { $node = $1; } - $path =~ s|/+|/|g ; # xx////xx -> xx/xx + $path =~ s|(?<=[^/])/+|/|g ; # xx////xx -> xx/xx $path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx - $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx + $path =~ s|(?<=[^/])/$|| ; # xx/ -> xx "$node$path"; } @@ -233,6 +233,7 @@ sub ExtUtils::MM_Unix::tools_other ; sub ExtUtils::MM_Unix::top_targets ; sub ExtUtils::MM_Unix::writedoc ; sub ExtUtils::MM_Unix::xs_c ; +sub ExtUtils::MM_Unix::xs_cpp ; sub ExtUtils::MM_Unix::xs_o ; sub ExtUtils::MM_Unix::xsubpp_version ; @@ -374,9 +375,9 @@ sub cflags { $self->{uc $_} ||= $cflags{$_} } - if ($self->{CAPI} && $Is_PERL_OBJECT == 1) { + if ($self->{CAPI} && $Is_PERL_OBJECT) { $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//; - $self->{CCFLAGS} .= '-DPERL_CAPI'; + $self->{CCFLAGS} .= ' -DPERL_CAPI '; if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) { # Turn off C++ mode of the MSC compiler $self->{CCFLAGS} =~ s/-TP(\s|$)//; @@ -818,7 +819,7 @@ ci : =item dist_core (o) -Defeines the targets dist, tardist, zipdist, uutardist, shdist +Defines the targets dist, tardist, zipdist, uutardist, shdist =cut @@ -915,6 +916,7 @@ sub dlsyms { my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; my(@m); push(@m," @@ -931,7 +933,8 @@ static :: $self->{BASEEXT}.exp $self->{BASEEXT}.exp: Makefile.PL ",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ', - neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\' + neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist), + ', "DL_VARS" => ', neatvalue($vars), ');\' '); join('',@m); @@ -2018,7 +2021,7 @@ uninstall_from_sitedirs :: =item installbin (o) -Defines targets to install EXE_FILES. +Defines targets to make and to install EXE_FILES. =cut @@ -2045,7 +2048,7 @@ EXE_FILES = @{$self->{EXE_FILES}} } : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \ -e "MY->fixin(shift)" }).qq{ -all :: @to +pure_all :: @to $self->{NOECHO}\$(NOOP) realclean :: @@ -2347,7 +2350,7 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c $tmp/perlmain.c: $makefilename}, q{ }.$self->{NOECHO}.q{echo Writing $@ }.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\ - -e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@ + -e "writemain(grep s#.*/auto/##, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@ }; push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain @@ -2746,10 +2749,13 @@ sub ppd { push(@m, "\t\@\$(PERL) -e \"print qq{{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}"); push(@m, ". qq{\\t$self->{DISTNAME}\\n}"); my $abstract = $self->{ABSTRACT}; + $abstract =~ s/\n/\\n/sg; $abstract =~ s//>/g; push(@m, ". qq{\\t$abstract\\n}"); my ($author) = $self->{AUTHOR}; + $author =~ s//>/g; $author =~ s/@/\\@/g; push(@m, ". qq{\\t$author\\n}"); push(@m, ". qq{\\t\\n}"); @@ -2757,9 +2763,11 @@ sub ppd { foreach $prereq (sort keys %{$self->{PREREQ_PM}}) { my $pre_req = $prereq; $pre_req =~ s/::/-/g; - push(@m, ". qq{\\t\\t\\n}"); + my ($dep_ver) = join ",", (split (/\./, $self->{PREREQ_PM}{$prereq}), (0) x 4) [0 .. 3]; + push(@m, ". qq{\\t\\t\\n}"); } push(@m, ". qq{\\t\\t\\n}"); + push(@m, ". qq{\\t\\t\\n}"); my ($bin_location) = $self->{BINARY_LOCATION}; $bin_location =~ s/\\/\\\\/g; if ($self->{PPM_INSTALL_SCRIPT}) { @@ -2783,7 +2791,7 @@ Returns the attribute C or the string C<644>. Used as the string that is passed to the C command to set the permissions for read/writeable files. MakeMaker chooses C<644> because it has turned out in the past that -relying on the umask provokes hard-to-track bugreports. +relying on the umask provokes hard-to-track bug reports. When the return value is used by the perl function C, it is interpreted as an octal value. @@ -2889,13 +2897,18 @@ sub processPL { return "" unless $self->{PL_FILES}; my(@m, $plfile); foreach $plfile (sort keys %{$self->{PL_FILES}}) { + my $list = ref($self->{PL_FILES}->{$plfile}) + ? $self->{PL_FILES}->{$plfile} + : [$self->{PL_FILES}->{$plfile}]; + foreach $target (@$list) { push @m, " -all :: $self->{PL_FILES}->{$plfile} +all :: $target $self->{NOECHO}\$(NOOP) -$self->{PL_FILES}->{$plfile} :: $plfile - \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile +$target :: $plfile + \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile $target "; + } } join "", @m; } @@ -2943,7 +2956,11 @@ form Foo/Bar and replaces the slash with C<::>. Returns the replacement. sub replace_manpage_separator { my($self,$man) = @_; - $man =~ s,/+,::,g; + if ($^O eq 'uwin') { + $man =~ s,/+,.,g; + } else { + $man =~ s,/+,::,g; + } $man; } @@ -3304,7 +3321,7 @@ sub tool_xsubpp { } } - $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp"; + my $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp"; return qq{ XSUBPPDIR = $xsdir @@ -3454,7 +3471,7 @@ Version_check: =item writedoc -Obsolete, depecated method. Not used since Version 5.21. +Obsolete, deprecated method. Not used since Version 5.21. =cut @@ -3478,7 +3495,22 @@ sub xs_c { return '' unless $self->needs_linking(); ' .xs.c: - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@ + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c +'; +} + +=item xs_cpp (o) + +Defines the suffix rules to compile XS files to C++. + +=cut + +sub xs_cpp { + my($self) = shift; + return '' unless $self->needs_linking(); + ' +.xs.cpp: + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.cpp '; } @@ -3509,6 +3541,7 @@ and Win32 do. sub perl_archive { + return '$(PERL_INC)' . "/$Config{libperl}" if $^O eq "beos"; return ""; } diff --git a/contrib/perl5/lib/ExtUtils/MM_VMS.pm b/contrib/perl5/lib/ExtUtils/MM_VMS.pm index d7e59c2..8f8ac17 100644 --- a/contrib/perl5/lib/ExtUtils/MM_VMS.pm +++ b/contrib/perl5/lib/ExtUtils/MM_VMS.pm @@ -3,7 +3,7 @@ # This package is inserted into @ISA of MakeMaker's MM before the # built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS. # -# Author: Charles Bailey bailey@genetics.upenn.edu +# Author: Charles Bailey bailey@newman.upenn.edu package ExtUtils::MM_VMS; @@ -14,7 +14,7 @@ use VMS::Filespec; use File::Basename; use vars qw($Revision); -$Revision = '5.42 (31-Mar-1997)'; +$Revision = '5.52 (12-Sep-1998)'; unshift @MM::ISA, 'ExtUtils::MM_VMS'; @@ -829,7 +829,7 @@ sub cflags { $quals =~ s/ -$type$def\s*//; $def =~ s/"/""/g; if ($type eq 'D') { $definestr .= qq["$def",]; } - elsif ($type eq 'I') { $flagincstr .= ',' . $self->fixpath($def,1); } + elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); } else { $undefstr .= qq["$def",]; } } } @@ -869,7 +869,7 @@ sub cflags { my(@includes) = split(/\s+/,$self->{INC}); foreach (@includes) { s/^-I//; - $incstr .= ', '.$self->fixpath($_,1); + $incstr .= ','.$self->fixpath($_,1); } } $quals .= "$incstr)"; @@ -1322,6 +1322,7 @@ sub dlsyms { my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; my(@m); unless ($self->{SKIPHASH}{'dynamic'}) { @@ -1343,7 +1344,8 @@ $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt $(BASEEXT).opt : Makefile.PL $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" - ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], - neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')" + neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars), + q[, 'FUNCLIST' => ],neatvalue($funclist),')" $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET) '); @@ -1389,7 +1391,7 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep push @m, ' $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) - $(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' + If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option '; @@ -1441,7 +1443,7 @@ $(INST_STATIC) : $(NOECHO) $(NOOP) ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); - my(@m); + my(@m,$lib); push @m,' # Rely on suffix rule for update action $(OBJECT) : $(INST_ARCHAUTODIR).exists @@ -1463,7 +1465,10 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } - push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n"); + foreach $lib (split $self->{EXTRALIBS}) { + $lib = '""' if $lib eq '"'; + push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n"); + } push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); } @@ -1530,15 +1535,20 @@ sub processPL { return "" unless $self->{PL_FILES}; my(@m, $plfile); foreach $plfile (sort keys %{$self->{PL_FILES}}) { - my $vmsplfile = vmsify($plfile); - my $vmsfile = vmsify($self->{PL_FILES}->{$plfile}); - push @m, " + my $list = ref($self->{PL_FILES}->{$plfile}) + ? $self->{PL_FILES}->{$plfile} + : [$self->{PL_FILES}->{$plfile}]; + foreach $target (@$list) { + my $vmsplfile = vmsify($plfile); + my $vmsfile = vmsify($target); + push @m, " all :: $vmsfile \$(NOECHO) \$(NOOP) $vmsfile :: $vmsplfile -",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile +",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile $vmsfile "; + } } join "", @m; } @@ -2188,7 +2198,8 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) } - my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir); + my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen); + local($_); # The front matter of the linkcommand... $linkcmd = join ' ', $Config{'ld'}, @@ -2251,28 +2262,46 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) # (e.g. Intuit::DWIM will precede Intuit, so unresolved # references from [.intuit.dwim]dwim.obj can be found # in [.intuit]intuit.olb). - for (sort keys %olbs) { + for (sort { length($a) <=> length($b) } keys %olbs) { next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/; my($dir) = $self->fixpath($_,1); my($extralibs) = $dir . "extralibs.ld"; my($extopt) = $dir . $olbs{$_}; $extopt =~ s/$self->{LIB_EXT}$/.opt/; + push @optlibs, "$dir$olbs{$_}"; + # Get external libraries this extension will need if (-f $extralibs ) { + my %seenthis; open LIST,$extralibs or warn $!,next; - push @$extra, ; + while () { + chomp; + # Include a library in the link only once, unless it's mentioned + # multiple times within a single extension's options file, in which + # case we assume the builder needed to search it again later in the + # link. + my $skip = exists($libseen{$_}) && !exists($seenthis{$_}); + $libseen{$_}++; $seenthis{$_}++; + next if $skip; + push @$extra,$_; + } close LIST; } + # Get full name of extension for ExtUtils::Miniperl if (-f $extopt) { open OPT,$extopt or die $!; while () { next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/; - # ExtUtils::Miniperl expects Unix paths - (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g; + my $pkg = $1; + $pkg =~ s#__*#::#g; push @staticpkgs,$pkg; } - push @staticopts, $extopt; } } + # Place all of the external libraries after all of the Perl extension + # libraries in the final link, in order to maximize the opportunity + # for XS code from multiple extensions to resolve symbols against the + # same external library while only including that library once. + push @optlibs, @$extra; $target = "Perl$Config{'exe_ext'}" unless $target; ($shrtarget,$targdir) = fileparse($target); @@ -2281,11 +2310,11 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) $target = "Perlshr.$Config{'dlext'}" unless $target; $tmp = "[]" unless $tmp; $tmp = $self->fixpath($tmp,1); - if (@$extra) { - $extralist = join(' ',@$extra); - $extralist =~ s/[,\s\n]+/, /g; - } - else { $extralist = ''; } + if (@optlibs) { $extralist = join(' ',@optlibs); } + else { $extralist = ''; } + # Let ExtUtils::Liblist find the necessary for us (but skip PerlShr; + # that's what we're building here). + push @optlibs, grep { !/PerlShr/i } split +($self->ext())[2]; if ($libperl) { unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) { print STDOUT "Warning: $libperl not found\n"; @@ -2309,19 +2338,22 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) MAP_TARGET = ',$self->fixpath($target,0),' MAP_SHRTARGET = ',$self->fixpath($shrtarget,0)," MAP_LINKCMD = $linkcmd -MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',' -# We use the linker options files created with each extension, rather than -#specifying the object files directly on the command line. -MAP_STATIC = ',@staticopts ? join(' ', @staticopts) : '',' -MAP_OPTS = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : ''," +MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : ''," MAP_EXTRA = $extralist MAP_LIBPERL = ",$self->fixpath($libperl,0),' '; - push @m,' -$(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",' - $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",' + push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n"; + foreach (@optlibs) { + push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n"; + } + push @m,"\n${tmp}PerlShr.Opt :\n\t"; + push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n"; + +push @m,' +$(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",' + $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",' $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",' $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say" @@ -2329,13 +2361,17 @@ $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt" $(NOECHO) $(SAY) "To remove the intermediate files, say $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean" '; - push @m,' -',"${tmp}perlmain.c",' : $(MAKEFILE) - $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET) -'; + push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n"; + push @m, "# More from the 255-char line length limit\n"; + foreach (@staticpkgs) { + push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n]; + } + push @m,' + $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET) + $(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n"; push @m, q[ -# More from the 255-char line length limit +# Still more from the 255-char line length limit doc_inst_perl : $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp @@ -2358,7 +2394,7 @@ clean :: map_clean map_clean : \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE) - \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET) + \$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET) "; join '', @m; diff --git a/contrib/perl5/lib/ExtUtils/MM_Win32.pm b/contrib/perl5/lib/ExtUtils/MM_Win32.pm index a1226b5..4070b2e 100644 --- a/contrib/perl5/lib/ExtUtils/MM_Win32.pm +++ b/contrib/perl5/lib/ExtUtils/MM_Win32.pm @@ -33,6 +33,7 @@ $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i; $GCC = 1 if $Config{'cc'} =~ /^gcc/i; $DMAKE = 1 if $Config{'make'} =~ /^dmake/i; $NMAKE = 1 if $Config{'make'} =~ /^nmake/i; +$PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i; $OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; sub dlsyms { @@ -40,6 +41,7 @@ sub dlsyms { my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; my(@m); (my $boot = $self->{NAME}) =~ s/:/_/g; @@ -52,6 +54,7 @@ $self->{BASEEXT}.def: Makefile.PL -e "Mksymlists('NAME' => '!, $self->{NAME}, q!', 'DLBASE' => '!,$self->{DLBASE}, q!', 'DL_FUNCS' => !,neatvalue($funcs), + q!, 'FUNCLIST' => !,neatvalue($funclist), q!, 'IMPORTS' => !,neatvalue($imports), q!, 'DL_VARS' => !, neatvalue($vars), q!);" !); @@ -445,11 +448,18 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp }); - } else { - push(@m, $BORLAND ? - q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,),$(RESFILES)} : - q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)} - ); + } elsif ($BORLAND) { + push(@m, + q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,} + .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) } + .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)} + : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) } + .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))}) + .q{,$(RESFILES)}); + } else { # VC + push(@m, + q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) } + .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}); } push @m, ' $(CHMOD) 755 $@ @@ -463,7 +473,7 @@ sub perl_archive { my ($self) = @_; if($OBJ) { - if ($self->{CAPI} eq 'TRUE') { + if ($self->{CAPI}) { return '$(PERL_INC)\perlCAPI$(LIB_EXT)'; } } @@ -524,10 +534,11 @@ sub pm_to_blib { pm_to_blib: $(TO_INST_PM) }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ - -e "pm_to_blib(qw[ }. - ($NMAKE ? '< 'TRUE' -# in their Makefile.pl -$CAPI_support = 1; - require ExtUtils::MM_Unix; if ($Is_VMS) { @@ -192,7 +186,7 @@ sub prompt ($;$) { } else { print "$def\n"; } - return $ans || $def; + return ($ans ne '') ? $ans : $def; } sub eval_in_subdirs { @@ -241,29 +235,23 @@ sub full_setup { @Attrib_help = qw/ - AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF CAPI - C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS - EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H - INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR + AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION + C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS + EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE FULLPERL FUNCLIST H IMPORTS + INC INCLUDE_EXT INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB - INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIB LIBS + INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIB LIBPERL_A LIBS LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB - NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC + NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX - PL_FILES PM PMLIBDIRS PREFIX + PL_FILES PM PMLIBDIRS PPM_INSTALL_EXEC PPM_INSTALL_SCRIPT PREFIX PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG XS_VERSION clean depend dist dynamic_lib linkext macro realclean - tool_autosplit PPM_INSTALL_SCRIPT PPM_INSTALL_EXEC - - IMPORTS - - installpm + tool_autosplit /; - # IMPORTS is used under OS/2 - - # ^^^ installpm is deprecated, will go about Summer 96 + # IMPORTS is used under OS/2 and Win32 # @Overridable is close to @MM_Sections but not identical. The # order is important. Many subroutines declare macros. These @@ -428,6 +416,7 @@ sub ExtUtils::MakeMaker::new { } my $newclass = ++$PACKNAME; + local @Parent = @Parent; # Protect against non-local exits { # no strict; print "Blessing Object into class [$newclass]\n" if $Verbose>=2; @@ -450,9 +439,17 @@ sub ExtUtils::MakeMaker::new { unless $self->file_name_is_absolute($self->{$key}) || ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/)); } - $self->{PARENT}->{CHILDREN}->{$newclass} = $self if $self->{PARENT}; + if ($self->{PARENT}) { + $self->{PARENT}->{CHILDREN}->{$newclass} = $self; + if (exists $self->{PARENT}->{CAPI} + and not exists $self->{CAPI}) + { + # inherit, but only if already unspecified + $self->{CAPI} = $self->{PARENT}->{CAPI}; + } + } } else { - parse_args($self,@ARGV); + parse_args($self,split(' ', $ENV{PERL_MM_OPT} || ''),@ARGV); } $self->{NAME} ||= $self->guess_name; @@ -487,6 +484,9 @@ END $self->init_dirscan(); $self->init_others(); + my($argv) = neatvalue(\@ARGV); + $argv =~ s/^\[/(/; + $argv =~ s/\]$/)/; push @{$self->{RESULT}}, <{NAME} extension to perl. @@ -497,6 +497,8 @@ END # # ANY CHANGES MADE HERE WILL BE LOST! # +# MakeMaker ARGV: $argv +# # MakeMaker Parameters: END @@ -541,7 +543,6 @@ END } push @{$self->{RESULT}}, "\n# End."; - pop @Parent; $self; } @@ -1026,7 +1027,7 @@ This will replace the string specified by $Config{prefix} in all $Config{install*} values. Note, that in both cases the tilde expansion is done by MakeMaker, not -by perl by default, nor by make. Conflicts between parmeters LIB, +by perl by default, nor by make. Conflicts between parameters LIB, PREFIX and the various INSTALL* arguments are resolved so that XXX @@ -1176,12 +1177,33 @@ recommends it (or you know what you're doing). The following attributes can be specified as arguments to WriteMakefile() or as NAME=VALUE pairs on the command line: -=cut +=over 2 -# The following "=item C" is used by the attrib_help routine -# likewise the "=back" below. So be careful when changing it! +=item AUTHOR -=over 2 +String containing name (and email address) of package author(s). Is used +in PPD (Perl Package Description) files for PPM (Perl Package Manager). + +=item ABSTRACT + +One line description of the module. Will be included in PPD file. + +=item ABSTRACT_FROM + +Name of the file that contains the package description. MakeMaker looks +for a line in the POD matching /^($package\s-\s)(.*)/. This is typically +the first line in the "=head1 NAME" section. $2 becomes the abstract. + +=item BINARY_LOCATION + +Used when creating PPD files for binary packages. It can be set to a +full or relative path or URL to the binary archive for a particular +architecture. For example: + + perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz + +builds a PPD package that references a binary of the C package, +located in the C directory relative to the PPD itself. =item C @@ -1189,6 +1211,14 @@ Ref to array of *.c file names. Initialised from a directory scan and the values portion of the XS attribute hash. This is not currently used by MakeMaker but may be handy in Makefile.PLs. +=item CAPI + +Switch to force usage of the Perl C API even when compiling for PERL_OBJECT. + +Note that this attribute is passed through to any recursive build, +but if and only if the submodule's Makefile.PL itself makes no mention +of the 'CAPI' attribute. + =item CCFLAGS String that will be included in the compiler call command line between @@ -1237,12 +1267,12 @@ NAME above. =item DL_FUNCS -Hashref of symbol names for routines to be made available as -universal symbols. Each key/value pair consists of the package name -and an array of routine names in that package. Used only under AIX -(export lists) and VMS (linker options) at present. The routine -names supplied will be expanded in the same way as XSUB names are -expanded by the XS() macro. Defaults to +Hashref of symbol names for routines to be made available as universal +symbols. Each key/value pair consists of the package name and an +array of routine names in that package. Used only under AIX, OS/2, +VMS and Win32 at present. The routine names supplied will be expanded +in the same way as XSUB names are expanded by the XS() macro. +Defaults to {"$(NAME)" => ["boot_$(NAME)" ] } @@ -1251,12 +1281,14 @@ e.g. {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )], "NetconfigPtr" => [ 'DESTROY'] } +Please see the L documentation for more information +about the DL_FUNCS, DL_VARS and FUNCLIST attributes. + =item DL_VARS -Array of symbol names for variables to be made available as -universal symbols. Used only under AIX (export lists) and VMS -(linker options) at present. Defaults to []. (e.g. [ qw( -Foo_version Foo_numstreams Foo_tree ) ]) +Array of symbol names for variables to be made available as universal symbols. +Used only under AIX, OS/2, VMS and Win32 at present. Defaults to []. +(e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ]) =item EXCLUDE_EXT @@ -1265,7 +1297,7 @@ is ignored if INCLUDE_EXT is present. Consult INCLUDE_EXT for more details. (e.g. [ qw( Socket POSIX ) ] ) This attribute may be most useful when specified as a string on the -commandline: perl Makefile.PL EXCLUDE_EXT='Socket Safe' +command line: perl Makefile.PL EXCLUDE_EXT='Socket Safe' =item EXE_FILES @@ -1273,13 +1305,6 @@ Ref to array of executable files. The files will be copied to the INST_SCRIPT directory. Make realclean will delete them from there again. -=item NO_VC - -In general any generated Makefile checks for the current version of -MakeMaker and the version the Makefile was built under. If NO_VC is -set, the version check is neglected. Do not write this into your -Makefile.PL, use it interactively instead. - =item FIRST_MAKEFILE The name of the Makefile to be produced. Defaults to the contents of @@ -1290,13 +1315,21 @@ that will be produced for the MAP_TARGET. Perl binary able to run this extension. +=item FUNCLIST + +This provides an alternate means to specify function names to be +exported from the extension. Its value is a reference to an +array of function names to be exported by the extension. These +names are passed through unaltered to the linker options file. + =item H Ref to array of *.h file names. Similar to C. =item IMPORTS -IMPORTS is only used on OS/2. +This attribute is used to specify names to be imported into the +extension. It is only used on OS/2 and Win32. =item INC @@ -1315,7 +1348,7 @@ filling in INCLUDE_EXT. If the INCLUDE_EXT is mentioned but is empty then only DynaLoader and the current extension will be included in the build. This attribute may be most useful when specified as a string on the -commandline: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek' +command line: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek' =item INSTALLARCHLIB @@ -1353,14 +1386,14 @@ directory if INSTALLDIRS is set to perl. Used by 'make install' which copies files from INST_SCRIPT to this directory. -=item INSTALLSITELIB +=item INSTALLSITEARCH -Used by 'make install', which copies files from INST_LIB to this +Used by 'make install', which copies files from INST_ARCHLIB to this directory if INSTALLDIRS is set to site (default). -=item INSTALLSITEARCH +=item INSTALLSITELIB -Used by 'make install', which copies files from INST_ARCHLIB to this +Used by 'make install', which copies files from INST_LIB to this directory if INSTALLDIRS is set to site (default). =item INST_ARCHLIB @@ -1403,16 +1436,16 @@ defaults to "$(OBJECT)" and is used in the ld command to specify what files to link/load from (also see dynamic_lib below for how to specify ld flags) -=item LIBPERL_A - -The filename of the perllibrary that will be used together with this -extension. Defaults to libperl.a. - =item LIB LIB can only be set at C time. It has the effect of setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any +=item LIBPERL_A + +The filename of the perllibrary that will be used together with this +extension. Defaults to libperl.a. + =item LIBS An anonymous array of alternative library @@ -1497,6 +1530,13 @@ itself. Boolean. Attribute to inhibit descending into subdirectories. +=item NO_VC + +In general any generated Makefile checks for the current version of +MakeMaker and the version the Makefile was built under. If NO_VC is +set, the version check is neglected. Do not write this into your +Makefile.PL, use it interactively instead. + =item OBJECT List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long @@ -1532,7 +1572,7 @@ avoided, it may be undefined) =item PERM_RW -Desired Permission for read/writable files. Defaults to C<644>. +Desired permission for read/writable files. Defaults to C<644>. See also L. =item PERM_RWX @@ -1549,7 +1589,11 @@ and the basename of the file being the value. E.g. {'foobar.PL' => 'foobar'} The *.PL files are expected to produce output to the target files -themselves. +themselves. If multiple files can be generated from the same *.PL +file then the value in the hash can be a reference to an array of +target file names. E.g. + + {'foobar.PL' => ['foobar1','foobar2']} =item PM @@ -1569,6 +1613,15 @@ they contain will be installed in the corresponding location in the library. A libscan() method can be used to alter the behaviour. Defining PM in the Makefile.PL will override PMLIBDIRS. +=item PPM_INSTALL_EXEC + +Name of the executable used to run C below. (e.g. perl) + +=item PPM_INSTALL_SCRIPT + +Name of the script that gets executed by the Perl Package Manager after +the installation of a package. + =item PREFIX Can be used to set the three INSTALL* attributes in one go (except for @@ -1703,10 +1756,6 @@ links the rest. Default is 'best'. {ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'} -=item installpm - -Deprecated as of MakeMaker 5.23. See L. - =item linkext {LINKTYPE => 'static', 'dynamic' or ''} @@ -1733,12 +1782,6 @@ be linked. =back -=cut - -# bug in pod2html, so leave the =back - -# Don't delete this cut, MM depends on it! - =head2 Overriding MakeMaker Methods If you cannot achieve the desired Makefile behaviour by specifying @@ -1916,6 +1959,18 @@ in a subdirectory of some other distribution, or is listed as a dependency in a CPAN::Bundle, but the functionality is supported by different means on the current architecture). +=head1 ENVIRONMENT + +=over 8 + +=item PERL_MM_OPT + +Command line options used by Cnew()>, and thus by +C. The string is split on whitespace, and the result +is processed before any actual command line arguments are processed. + +=back + =head1 SEE ALSO ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib, @@ -1925,7 +1980,7 @@ ExtUtils::Install, ExtUtils::Embed Andy Dougherty >, Andreas KEnig >, Tim Bunce >. -VMS support by Charles Bailey >. OS/2 +VMS support by Charles Bailey >. OS/2 support by Ilya Zakharevich >. Contact the makemaker mailing list C, if you have any questions. diff --git a/contrib/perl5/lib/ExtUtils/Manifest.pm b/contrib/perl5/lib/ExtUtils/Manifest.pm index 5557089..1a6dde7 100644 --- a/contrib/perl5/lib/ExtUtils/Manifest.pm +++ b/contrib/perl5/lib/ExtUtils/Manifest.pm @@ -298,7 +298,7 @@ but in doing so checks each line in an existing C file and includes any comments that are found in the existing C file in the new one. Anything between white space and an end of line within a C file is considered to be a comment. Filenames and -comments are seperated by one or more TAB characters in the +comments are separated by one or more TAB characters in the output. All files that match any regular expression in a file C (if such a file exists) are ignored. @@ -317,7 +317,7 @@ Fullcheck() does both a manicheck() and a filecheck(). Skipcheck() lists all the files that are skipped due to your C file. -Manifind() retruns a hash reference. The keys of the hash are the +Manifind() returns a hash reference. The keys of the hash are the files found below the current directory. Maniread($file) reads a named C file (defaults to diff --git a/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm b/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm index 35d5236..25c374c 100644 --- a/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm +++ b/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm @@ -1,6 +1,6 @@ package ExtUtils::Mkbootstrap; -$VERSION = substr q$Revision: 1.13 $, 10; +$VERSION = substr q$Revision: 1.14 $, 10; # $Date: 1996/09/03 17:04:43 $ use Config; @@ -49,7 +49,7 @@ sub Mkbootstrap { print BS "# $baseext DynaLoader bootstrap file for $^O architecture.\n"; print BS "# Do not edit this file, changes will be lost.\n"; print BS "# This file was automatically generated by the\n"; - print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$Version).\n"; + print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n"; print BS "\@DynaLoader::dl_resolve_using = "; # If @all contains names in the form -lxxx or -Lxxx then it's asking for # runtime library location so we automatically add a call to dl_findfile() diff --git a/contrib/perl5/lib/ExtUtils/Mksymlists.pm b/contrib/perl5/lib/ExtUtils/Mksymlists.pm index 0b92ca0..76535d9 100644 --- a/contrib/perl5/lib/ExtUtils/Mksymlists.pm +++ b/contrib/perl5/lib/ExtUtils/Mksymlists.pm @@ -19,10 +19,10 @@ sub Mksymlists { $spec{DL_VARS} = [] unless $spec{DL_VARS}; ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE}; + $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; $spec{DL_FUNCS} = { $spec{NAME} => [] } unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or - $spec{FUNCLIST}); - $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; + @{$spec{FUNCLIST}}); if (defined $spec{DL_FUNCS}) { my($package); foreach $package (keys %{$spec{DL_FUNCS}}) { @@ -89,10 +89,10 @@ sub _write_os2 { print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; if (%{$data->{IMPORTS}}) { print DEF "IMPORTS\n"; -my ($name, $exp); -while (($name, $exp)= each %{$data->{IMPORTS}}) { - print DEF " $name=$exp\n"; -} + my ($name, $exp); + while (($name, $exp)= each %{$data->{IMPORTS}}) { + print DEF " $name=$exp\n"; + } } close DEF; } @@ -207,10 +207,13 @@ keys are recognized: =over -=item NAME +=item DLBASE -This gives the name of the extension (I Tk::Canvas) for which -the linker option file will be produced. +This item specifies the name by which the linker knows the +extension, which may be different from the name of the +extension itself (for instance, some linkers add an '_' to the +name of the extension). If it is not specified, it is derived +from the NAME attribute. It is presently used only by OS2 and Win32. =item DL_FUNCS @@ -219,7 +222,7 @@ from which it is usually taken. Its value is a reference to an associative array, in which each key is the name of a package, and each value is an a reference to an array of function names which should be exported by the extension. For instance, one might say -C { Homer::Iliad =E [ qw(trojans greeks) ], +C { Homer::Iliad =E [ qw(trojans greeks) ], Homer::Odyssey =E [ qw(travellers family suitors) ] }>. The function names should be identical to those in the XSUB code; C will alter the names written to the linker option @@ -243,7 +246,7 @@ be exported by the extension. This key can be used to specify the name of the linker option file (minus the OS-specific extension), if for some reason you do not want to use the default value, which is the last word of the NAME -attribute (I for Tk::Canvas, FILE defaults to 'Canvas'). +attribute (I for C, FILE defaults to C). =item FUNCLIST @@ -251,14 +254,25 @@ This provides an alternate means to specify function names to be exported from the extension. Its value is a reference to an array of function names to be exported by the extension. These names are passed through unaltered to the linker options file. +Specifying a value for the FUNCLIST attribute suppresses automatic +generation of the bootstrap function for the package. To still create +the bootstrap name you have to specify the package name in the +DL_FUNCS hash: -=item DLBASE + Mksymlists({ NAME => $name , + FUNCLIST => [ $func1, $func2 ], + DL_FUNCS => { $pkg => [] } }); -This item specifies the name by which the linker knows the -extension, which may be different from the name of the -extension itself (for instance, some linkers add an '_' to the -name of the extension). If it is not specified, it is derived -from the NAME attribute. It is presently used only by OS2. + +=item IMPORTS + +This attribute is used to specify names to be imported into the +extension. It is currently only used by OS/2 and Win32. + +=item NAME + +This gives the name of the extension (I C) for which +the linker option file will be produced. =back @@ -269,7 +283,7 @@ can be used to provide additional information to the linker. =head1 AUTHOR -Charles Bailey Ibailey@genetics.upenn.eduE> +Charles Bailey Ibailey@newman.upenn.eduE> =head1 REVISION diff --git a/contrib/perl5/lib/ExtUtils/typemap b/contrib/perl5/lib/ExtUtils/typemap index 28fd99c..b1ec063 100644 --- a/contrib/perl5/lib/ExtUtils/typemap +++ b/contrib/perl5/lib/ExtUtils/typemap @@ -1,12 +1,12 @@ # $Header$ # basic C types int T_IV -unsigned T_IV -unsigned int T_IV +unsigned T_UV +unsigned int T_UV long T_IV -unsigned long T_IV +unsigned long T_UV short T_IV -unsigned short T_IV +unsigned short T_UV char T_CHAR unsigned char T_U_CHAR char * T_PV @@ -34,7 +34,7 @@ I16 T_IV I8 T_IV U32 T_U_LONG U16 T_U_SHORT -U8 T_IV +U8 T_UV Result T_U_CHAR Boolean T_IV double T_DOUBLE @@ -73,6 +73,8 @@ T_CVREF croak(\"$var is not of type ${ntype}\") T_SYSRET $var NOT IMPLEMENTED +T_UV + $var = ($type)SvUV($arg) T_IV $var = ($type)SvIV($arg) T_INT @@ -82,19 +84,19 @@ T_ENUM T_BOOL $var = (int)SvIV($arg) T_U_INT - $var = (unsigned int)SvIV($arg) + $var = (unsigned int)SvUV($arg) T_SHORT $var = (short)SvIV($arg) T_U_SHORT - $var = (unsigned short)SvIV($arg) + $var = (unsigned short)SvUV($arg) T_LONG $var = (long)SvIV($arg) T_U_LONG - $var = (unsigned long)SvIV($arg) + $var = (unsigned long)SvUV($arg) T_CHAR $var = (char)*SvPV($arg,PL_na) T_U_CHAR - $var = (unsigned char)SvIV($arg) + $var = (unsigned char)SvUV($arg) T_FLOAT $var = (float)SvNV($arg) T_NV @@ -191,6 +193,8 @@ T_CVREF $arg = newRV((SV*)$var); T_IV sv_setiv($arg, (IV)$var); +T_UV + sv_setuv($arg, (UV)$var); T_INT sv_setiv($arg, (IV)$var); T_SYSRET @@ -205,19 +209,19 @@ T_ENUM T_BOOL $arg = boolSV($var); T_U_INT - sv_setiv($arg, (IV)$var); + sv_setuv($arg, (UV)$var); T_SHORT sv_setiv($arg, (IV)$var); T_U_SHORT - sv_setiv($arg, (IV)$var); + sv_setuv($arg, (UV)$var); T_LONG sv_setiv($arg, (IV)$var); T_U_LONG - sv_setiv($arg, (IV)$var); + sv_setuv($arg, (UV)$var); T_CHAR sv_setpvn($arg, (char *)&$var, 1); T_U_CHAR - sv_setiv($arg, (IV)$var); + sv_setuv($arg, (UV)$var); T_FLOAT sv_setnv($arg, (double)$var); T_NV diff --git a/contrib/perl5/lib/ExtUtils/xsubpp b/contrib/perl5/lib/ExtUtils/xsubpp index 523dabc..1ee7b29 100755 --- a/contrib/perl5/lib/ExtUtils/xsubpp +++ b/contrib/perl5/lib/ExtUtils/xsubpp @@ -776,7 +776,7 @@ while (<$FH>) { /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; if ($OBJ) { - s/#if(?:def|\s+defined)\s+(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/; + s/#if(?:def\s|\s+defined)\s*(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/; } print $_; } @@ -1254,30 +1254,37 @@ EOF } # print initialization routine -if ($WantCAPI) { + print Q<<"EOF"; -# ##ifdef __cplusplus #extern "C" ##endif +EOF + +if ($WantCAPI) { +print Q<<"EOF"; +##ifdef PERL_CAPI #XS(boot__CAPI_entry) -#[[ -# dXSARGS; -# char* file = __FILE__; -# +##else EOF -} else { +} + print Q<<"EOF"; -##ifdef __cplusplus -#extern "C" -##endif #XS(boot_$Module_cname) +EOF + +if ($WantCAPI) { +print Q<<"EOF"; +##endif /* PERL_CAPI */ +EOF +} + +print Q<<"EOF"; #[[ # dXSARGS; # char* file = __FILE__; # EOF -} print Q<<"EOF" if $WantVersionChk ; # XS_VERSION_BOOTCHECK ; @@ -1312,7 +1319,7 @@ EOF if ($WantCAPI) { print Q<<"EOF"; -# +##ifdef PERL_CAPI ##define XSCAPI(name) void name(CV* cv, void* pPerl) # ##ifdef __cplusplus @@ -1323,7 +1330,7 @@ print Q<<"EOF"; # SetCPerlObj(pPerl); # boot__CAPI_entry(cv); #]] -# +##endif /* PERL_CAPI */ EOF } diff --git a/contrib/perl5/lib/Fatal.pm b/contrib/perl5/lib/Fatal.pm index a1e5cff..d1d95af 100644 --- a/contrib/perl5/lib/Fatal.pm +++ b/contrib/perl5/lib/Fatal.pm @@ -111,11 +111,13 @@ EOS $code .= write_invocation($core, $call, $name, @protos); $code .= "}\n"; print $code if $Debug; - $code = eval($code); - die if $@; - local($^W) = 0; # to avoid: Subroutine foo redefined ... - no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ... - *{$sub} = $code; + { + no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ... + $code = eval("package $pkg; use Carp; $code"); + die if $@; + local($^W) = 0; # to avoid: Subroutine foo redefined ... + *{$sub} = $code; + } } 1; diff --git a/contrib/perl5/lib/File/Copy.pm b/contrib/perl5/lib/File/Copy.pm index d0b3c89..e1da6b6 100644 --- a/contrib/perl5/lib/File/Copy.pm +++ b/contrib/perl5/lib/File/Copy.pm @@ -235,7 +235,7 @@ B Files are opened in binary mode where -applicable. To get a consistent behavour when copying from a +applicable. To get a consistent behaviour when copying from a filehandle to a file, use C on the filehandle. An optional third parameter can be used to specify the buffer @@ -274,7 +274,7 @@ C routine. For VMS systems, this calls the C routine (see below). For OS/2 systems, this calls the C XSUB directly. -=head2 Special behavior if C is defined (VMS and OS/2) +=head2 Special behaviour if C is defined (VMS and OS/2) If both arguments to C are not file handles, then C will perform a "system copy" of @@ -336,7 +336,7 @@ $! will be set if an error was encountered. =head1 AUTHOR File::Copy was written by Aaron Sherman Iajs@ajs.comE> in 1995, -and updated by Charles Bailey Ibailey@genetics.upenn.eduE> in 1996. +and updated by Charles Bailey Ibailey@newman.upenn.eduE> in 1996. =cut diff --git a/contrib/perl5/lib/File/Find.pm b/contrib/perl5/lib/File/Find.pm index 1305d21..7e67003 100644 --- a/contrib/perl5/lib/File/Find.pm +++ b/contrib/perl5/lib/File/Find.pm @@ -22,10 +22,10 @@ finddepth - traverse a directory structure depth-first =head1 DESCRIPTION The first argument to find() is either a hash reference describing the -operations to be performed for each file, or a code reference. If it -is a hash reference, then the value for the key C should be a -code reference. This code reference is called I below. +operations to be performed for each file, a code reference, or a string +that contains a subroutine name. If it is a hash reference, then the +value for the key C should be a code reference. This code +reference is called I below. Currently the only other supported key for the above hash is C, in presense of which the walk over directories is @@ -177,6 +177,8 @@ sub finddir { --$subcount; next if $prune; + # Untaint $_, so that we can do a chdir + $_ = $1 if /^(.*)/; if (chdir $_) { $name =~ s/\.dir$// if $Is_VMS; &finddir($wanted,$name,$nlink, $bydepth); @@ -194,7 +196,7 @@ sub finddir { sub wrap_wanted { my $wanted = shift; - defined &$wanted ? {wanted => $wanted} : $wanted; + ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted }; } sub find { diff --git a/contrib/perl5/lib/File/Path.pm b/contrib/perl5/lib/File/Path.pm index 39f1ba1..225ecab 100644 --- a/contrib/perl5/lib/File/Path.pm +++ b/contrib/perl5/lib/File/Path.pm @@ -88,7 +88,7 @@ in situations where security is an issue. =head1 AUTHORS Tim Bunce > and -Charles Bailey > +Charles Bailey > =head1 REVISION @@ -135,8 +135,9 @@ sub mkpath { } print "mkdir $path\n" if $verbose; unless (mkdir($path,$mode)) { - # allow for another process to have created it meanwhile - croak "mkdir $path: $!" unless -d $path; + my $e = $!; + # allow for another process to have created it meanwhile + croak "mkdir $path: $e" unless -d $path; } push(@created, $path); } diff --git a/contrib/perl5/lib/File/Spec.pm b/contrib/perl5/lib/File/Spec.pm index 5f3dbf5..616dcbc 100644 --- a/contrib/perl5/lib/File/Spec.pm +++ b/contrib/perl5/lib/File/Spec.pm @@ -91,7 +91,7 @@ but rather as class methods: File::Spec->catfile('a','b'); -For a reference of available functions, pleaes consult L, +For a reference of available functions, please consult L, which contains the entire set, and inherited by the modules for other platforms. For further information, please see L, L, L, or L. @@ -106,7 +106,7 @@ File::Spec::VMS, ExtUtils::MakeMaker Kenneth Albanowski >, Andy Dougherty >, Andreas KEnig >, Tim Bunce >. VMS -support by Charles Bailey >. OS/2 support by +support by Charles Bailey >. OS/2 support by Ilya Zakharevich >. Mac support by Paul Schinder >. diff --git a/contrib/perl5/lib/File/Spec/Mac.pm b/contrib/perl5/lib/File/Spec/Mac.pm index 4968e24..63a9e12 100644 --- a/contrib/perl5/lib/File/Spec/Mac.pm +++ b/contrib/perl5/lib/File/Spec/Mac.pm @@ -52,7 +52,7 @@ The fundamental requirement of this routine is that File::Spec->catdir(split(":",$path)) eq $path But because of the nature of Macintosh paths, some additional -possibilities are allowed to make using this routine give resonable results +possibilities are allowed to make using this routine give reasonable results for some common situations. Here are the rules that are used. Each argument has its trailing ":" removed. Each argument, except the first, has its leading ":" removed. They are then joined together by a ":". @@ -78,7 +78,7 @@ Under MacPerl, there is an additional ambiguity. Does the user intend that File::Spec->catfile("LWP","Protocol","http.pm") be relative or absolute? There's no way of telling except by checking for the -existance of LWP: or :LWP, and even there he may mean a dismounted volume or +existence of LWP: or :LWP, and even there he may mean a dismounted volume or a relative path in a different directory (like in @INC). So those checks aren't done here. This routine will treat this as absolute. diff --git a/contrib/perl5/lib/FindBin.pm b/contrib/perl5/lib/FindBin.pm index d6bd7b7..9e1c0a0 100644 --- a/contrib/perl5/lib/FindBin.pm +++ b/contrib/perl5/lib/FindBin.pm @@ -55,7 +55,10 @@ Workaround is to invoke perl as =head1 AUTHORS -Graham Barr EFE +FindBin is supported as part of the core perl distribution. Please send bug +reports to EFE using the perlbug program included with perl. + +Graham Barr EFE Nick Ing-Simmons EFE =head1 COPYRIGHT @@ -64,10 +67,6 @@ Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=head1 REVISION - -$Revision: 1.4 $ - =cut package FindBin; @@ -77,31 +76,13 @@ require Exporter; use Cwd qw(getcwd abs_path); use Config; use File::Basename; +use File::Spec; @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); @ISA = qw(Exporter); -$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.41 $ =~ /(\d+)\.(\d+)/); - -sub is_abs_path -{ - local $_ = shift if (@_); - if ($^O eq 'MSWin32' || $^O eq 'dos') - { - return m#^[a-z]:[\\/]#i; - } - elsif ($^O eq 'VMS') - { - # If it's a logical name, expand it. - $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_}; - return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/; - } - else - { - return m#^/#; - } -} +$VERSION = $VERSION = "1.42"; BEGIN { @@ -131,13 +112,12 @@ BEGIN && -f $script) { my $dir; - my $pathvar = 'PATH'; - - foreach $dir (split(/$Config{'path_sep'}/,$ENV{$pathvar})) + foreach $dir (File::Spec->path) { - if(-r "$dir/$script" && (!$IsWin32 || -x _)) + my $scr = File::Spec->catfile($dir, $script); + if(-r $scr && (!$IsWin32 || -x _)) { - $script = "$dir/$script"; + $script = $scr; if (-f $0) { @@ -160,7 +140,8 @@ BEGIN # Ensure $script contains the complete path incase we C - $script = getcwd() . "/" . $script unless is_abs_path($script); + $script = File::Spec->catfile(getcwd(), $script) + unless File::Spec->file_name_is_absolute($script); ($Script,$Bin) = fileparse($script); @@ -172,9 +153,9 @@ BEGIN ($RealScript,$RealBin) = fileparse($script); last unless defined $linktext; - $script = (is_abs_path($linktext)) + $script = (File::Spec->file_name_is_absolute($linktext)) ? $linktext - : $RealBin . "/" . $linktext; + : File::Spec->catfile($RealBin, $linktext); } # Get absolute paths to directories diff --git a/contrib/perl5/lib/Getopt/Long.pm b/contrib/perl5/lib/Getopt/Long.pm index 1966ef3..c125ccf 100644 --- a/contrib/perl5/lib/Getopt/Long.pm +++ b/contrib/perl5/lib/Getopt/Long.pm @@ -6,13 +6,13 @@ package Getopt::Long; # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Sun Jun 14 13:17:22 1998 -# Update Count : 705 +# Last Modified On: Fri Jan 8 14:48:43 1999 +# Update Count : 707 # Status : Released ################ Copyright ################ -# This program is Copyright 1990,1998 by Johan Vromans. +# This program is Copyright 1990,1999 by Johan Vromans. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 @@ -35,7 +35,7 @@ BEGIN { require 5.004; use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - $VERSION = "2.17"; + $VERSION = "2.19"; @ISA = qw(Exporter); @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); @@ -547,6 +547,7 @@ sub FindOption ($$$$$$$) { # If bundling == 2, long options can override bundles. if ( $bundling == 2 and + defined ($rest) and defined ($type = $opctl->{$tryopt.$rest}) ) { print STDERR ("=> $starter$tryopt rebundled to ", "$starter$tryopt$rest\n") if $debug; @@ -1363,7 +1364,7 @@ Johan Vromans Ejvromans@squirrel.nlE =head1 COPYRIGHT AND DISCLAIMER -This program is Copyright 1990,1998 by Johan Vromans. +This program is Copyright 1990,1999 by Johan Vromans. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 diff --git a/contrib/perl5/lib/Getopt/Std.pm b/contrib/perl5/lib/Getopt/Std.pm index c2cd123..390bf14 100644 --- a/contrib/perl5/lib/Getopt/Std.pm +++ b/contrib/perl5/lib/Getopt/Std.pm @@ -42,8 +42,7 @@ the argument or 1 if no argument is specified. @ISA = qw(Exporter); @EXPORT = qw(getopt getopts); - -# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $ +$VERSION = $VERSION = '1.01'; # Process single-character switches with switch clustering. Pass one argument # which is a string containing all switches that take an argument. For each @@ -145,7 +144,7 @@ sub getopts ($;$) { } } else { - print STDERR "Unknown option: $first\n"; + warn "Unknown option: $first\n"; ++$errs; if($rest ne '') { $ARGV[0] = "-$rest"; diff --git a/contrib/perl5/lib/IPC/Open3.pm b/contrib/perl5/lib/IPC/Open3.pm index f1415e3..d079041 100644 --- a/contrib/perl5/lib/IPC/Open3.pm +++ b/contrib/perl5/lib/IPC/Open3.pm @@ -2,15 +2,15 @@ package IPC::Open3; use strict; no strict 'refs'; # because users pass me bareword filehandles -use vars qw($VERSION @ISA @EXPORT $Fh $Me); +use vars qw($VERSION @ISA @EXPORT $Me); require 5.001; require Exporter; use Carp; -use Symbol 'qualify'; +use Symbol qw(gensym qualify); -$VERSION = 1.0102; +$VERSION = 1.0103; @ISA = qw(Exporter); @EXPORT = qw(open3); @@ -94,7 +94,6 @@ C and continually read and write a line from it. # rdr or wtr are null # a system call fails -$Fh = 'FHOPEN000'; # package static in case called more than once $Me = 'open3 (bug)'; # you should never see this, it's always localized # Fatal.pm needs to be fixed WRT prototypes. @@ -140,9 +139,9 @@ sub _open3 { $dad_rdr = qualify $dad_rdr, $package; $dad_err = qualify $dad_err, $package; - my $kid_rdr = ++$Fh; - my $kid_wtr = ++$Fh; - my $kid_err = ++$Fh; + my $kid_rdr = gensym; + my $kid_wtr = gensym; + my $kid_err = gensym; xpipe $kid_rdr, $dad_wtr if !$dup_wtr; xpipe $dad_rdr, $kid_wtr if !$dup_rdr; @@ -154,7 +153,7 @@ sub _open3 { # save a copy of her stdout before I put something else there. if ($dad_rdr ne $dad_err && $dup_err && fileno($dad_err) == fileno(STDOUT)) { - my $tmp = ++$Fh; + my $tmp = gensym; xopen($tmp, ">&$dad_err"); $dad_err = $tmp; } @@ -163,24 +162,24 @@ sub _open3 { xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr); } else { xclose $dad_wtr; - xopen \*STDIN, "<&$kid_rdr"; - xclose $kid_rdr; + xopen \*STDIN, "<&=" . fileno $kid_rdr; } if ($dup_rdr) { xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr); } else { xclose $dad_rdr; - xopen \*STDOUT, ">&$kid_wtr"; - xclose $kid_wtr; + xopen \*STDOUT, ">&=" . fileno $kid_wtr; } if ($dad_rdr ne $dad_err) { if ($dup_err) { - xopen \*STDERR, ">&$dad_err" + # I have to use a fileno here because in this one case + # I'm doing a dup but the filehandle might be a reference + # (from the special case above). + xopen \*STDERR, ">&" . fileno $dad_err if fileno(STDERR) != fileno($dad_err); } else { xclose $dad_err; - xopen \*STDERR, ">&$kid_err"; - xclose $kid_err; + xopen \*STDERR, ">&=" . fileno $kid_err; } } else { xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); @@ -194,23 +193,23 @@ sub _open3 { my @close; if ($dup_wtr) { - $kid_rdr = $dad_wtr; - push @close, \*{$kid_rdr}; + $kid_rdr = \*{$dad_wtr}; + push @close, $kid_rdr; } else { - push @close, \*{$dad_wtr}, \*{$kid_rdr}; + push @close, \*{$dad_wtr}, $kid_rdr; } if ($dup_rdr) { - $kid_wtr = $dad_rdr; - push @close, \*{$kid_wtr}; + $kid_wtr = \*{$dad_rdr}; + push @close, $kid_wtr; } else { - push @close, \*{$dad_rdr}, \*{$kid_wtr}; + push @close, \*{$dad_rdr}, $kid_wtr; } if ($dad_rdr ne $dad_err) { if ($dup_err) { - $kid_err = $dad_err ; - push @close, \*{$kid_err}; + $kid_err = \*{$dad_err}; + push @close, $kid_err; } else { - push @close, \*{$dad_err}, \*{$kid_err}; + push @close, \*{$dad_err}, $kid_err; } } else { $kid_err = $kid_wtr; @@ -218,13 +217,13 @@ sub _open3 { require IO::Pipe; $kidpid = eval { spawn_with_handles( [ { mode => 'r', - open_as => \*{$kid_rdr}, + open_as => $kid_rdr, handle => \*STDIN }, { mode => 'w', - open_as => \*{$kid_wtr}, + open_as => $kid_wtr, handle => \*STDOUT }, { mode => 'w', - open_as => \*{$kid_err}, + open_as => $kid_err, handle => \*STDERR }, ], \@close, @cmd); }; diff --git a/contrib/perl5/lib/Math/BigFloat.pm b/contrib/perl5/lib/Math/BigFloat.pm index 576f341..03bc2f4 100644 --- a/contrib/perl5/lib/Math/BigFloat.pm +++ b/contrib/perl5/lib/Math/BigFloat.pm @@ -301,7 +301,7 @@ floats as =item number format canonical strings have the form /[+-]\d+E[+-]\d+/ . Input values can -have inbedded whitespace. +have imbedded whitespace. =item Error returns 'NaN' diff --git a/contrib/perl5/lib/Math/BigInt.pm b/contrib/perl5/lib/Math/BigInt.pm index ef4af61..b61b884 100644 --- a/contrib/perl5/lib/Math/BigInt.pm +++ b/contrib/perl5/lib/Math/BigInt.pm @@ -258,9 +258,9 @@ sub bdiv { #(dividend: num_str, divisor: num_str) return num_str else { push(@x, 0); } - @q = (); ($v2,$v1) = @y[-2,-1]; + @q = (); ($v2,$v1) = ($y[-2] || 0, $y[-1]); while ($#x > $#y) { - ($u2,$u1,$u0) = @x[-3..-1]; + ($u2,$u1,$u0) = ($x[-3] || 0, $x[-2] || 0, $x[-1]); $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1)); --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2); if ($q) { @@ -400,8 +400,8 @@ In particular perl -MMath::BigInt=:constant -e 'print 2**100' -print the integer value of C<2**100>. Note that without convertion of -constants the expression 2**100 will be calculatted as floating point number. +print the integer value of C<2**100>. Note that without conversion of +constants the expression 2**100 will be calculated as floating point number. =head1 BUGS diff --git a/contrib/perl5/lib/Math/Complex.pm b/contrib/perl5/lib/Math/Complex.pm index e711c14..5b69039 100644 --- a/contrib/perl5/lib/Math/Complex.pm +++ b/contrib/perl5/lib/Math/Complex.pm @@ -14,7 +14,7 @@ use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); my ( $i, $ip2, %logn ); -$VERSION = sprintf("%s", q$Id: Complex.pm,v 1.25 1998/02/05 16:07:37 jhi Exp $ =~ /(\d+\.\d+)/); +$VERSION = sprintf("%s", q$Id: Complex.pm,v 1.26 1998/11/01 00:00:00 dsl Exp $ =~ /(\d+\.\d+)/); @ISA = qw(Exporter); @@ -401,38 +401,21 @@ sub divide { } # -# _zerotozero -# -# Die on zero raised to the zeroth. -# -sub _zerotozero { - my $mess = "The zero raised to the zeroth power is not defined.\n"; - - my @up = caller(1); - - $mess .= "Died at $up[1] line $up[2].\n"; - - die $mess; -} - -# # (power) # # Computes z1**z2 = exp(z2 * log z1)). # sub power { my ($z1, $z2, $inverted) = @_; - my $z1z = $z1 == 0; - my $z2z = $z2 == 0; - _zerotozero if ($z1z and $z2z); if ($inverted) { - return 0 if ($z2z); - return 1 if ($z1z or $z2 == 1); + return 1 if $z1 == 0 || $z2 == 1; + return 0 if $z2 == 0 && Re($z1) > 0; } else { - return 0 if ($z1z); - return 1 if ($z2z or $z1 == 1); + return 1 if $z2 == 0 || $z1 == 1; + return 0 if $z1 == 0 && Re($z2) > 0; } - my $w = $inverted ? CORE::exp($z1 * CORE::log($z2)) : CORE::exp($z2 * CORE::log($z1)); + my $w = $inverted ? CORE::exp($z1 * CORE::log($z2)) + : CORE::exp($z2 * CORE::log($z1)); # If both arguments cartesian, return cartesian, else polar. return $z1->{c_dirty} == 0 && (not ref $z2 or $z2->{c_dirty} == 0) ? @@ -443,7 +426,7 @@ sub power { # (spaceship) # # Computes z1 <=> z2. -# Sorts on the real part first, then on the imaginary part. Thus 2-4i > 3+8i. +# Sorts on the real part first, then on the imaginary part. Thus 2-4i < 3+8i. # sub spaceship { my ($z1, $z2, $inverted) = @_; @@ -1273,7 +1256,7 @@ sub gcd { my ($a, $b) = @_; my $id = "$a $b"; - + unless (exists $gcd{$id}) { $gcd{$id} = _gcd($a, $b); $gcd{"$b $a"} = $gcd{$id}; @@ -1702,7 +1685,7 @@ Here are some examples: The division (/) and the following functions log ln log10 logn - tan sec csc cot + tan sec csc cot atan asec acsc acot tanh sech csch coth atanh asech acsch acoth diff --git a/contrib/perl5/lib/Math/Trig.pm b/contrib/perl5/lib/Math/Trig.pm index b7b5d5d..924286d 100644 --- a/contrib/perl5/lib/Math/Trig.pm +++ b/contrib/perl5/lib/Math/Trig.pm @@ -314,9 +314,11 @@ known as the I coordinate. The angle in the I-plane coordinate. The angle from the I-axis is B, also known as the I coordinate. The `North Pole' is therefore I<0, 0, rho>, and the `Bay of Guinea' (think of the missing big chunk of Africa) I<0, -pi/2, rho>. +pi/2, rho>. In geographical terms I is latitude (northward +positive, southward negative) and I is longitude (eastward +positive, westward negative). -B: some texts define I and I the other way round, +B: some texts define I and I the other way round, some texts define the I to start from the horizontal plane, some texts use I in place of I. @@ -374,13 +376,25 @@ by importing the C function: use Math::Trig 'great_circle_distance' - $distance = great_circle_distance($theta0, $phi0, $theta1, $phi, [, $rho]); + $distance = great_circle_distance($theta0, $phi0, $theta1, $phi1, [, $rho]); The I is the shortest distance between two points on a sphere. The distance is in C<$rho> units. The C<$rho> is optional, it defaults to 1 (the unit sphere), therefore the distance defaults to radians. +If you think geographically the I are longitudes: zero at the +Greenwhich meridian, eastward positive, westward negative--and the +I are latitudes: zero at the North Pole, northward positive, +southward negative. B: this formula thinks in mathematics, not +geographically: the I zero is at the North Pole, not at the +Equator on the west coast of Africa (Bay of Guinea). You need to +subtract your geographical coordinates from I (also known as 90 +degrees). + + $distance = great_circle_distance($lon0, pi/2 - $lat0, + $lon1, pi/2 - $lat1, $rho); + =head1 EXAMPLES To calculate the distance between London (51.3N 0.5W) and Tokyo (35.7N @@ -394,8 +408,8 @@ To calculate the distance between London (51.3N 0.5W) and Tokyo (35.7N $km = great_circle_distance(@L, @T, 6378); -The answer may be off by up to 0.3% because of the irregular (slightly -aspherical) form of the Earth. +The answer may be off by few percentages because of the irregular +(slightly aspherical) form of the Earth. =head1 BUGS diff --git a/contrib/perl5/lib/Net/hostent.pm b/contrib/perl5/lib/Net/hostent.pm index 96b090d..d586358 100644 --- a/contrib/perl5/lib/Net/hostent.pm +++ b/contrib/perl5/lib/Net/hostent.pm @@ -89,7 +89,7 @@ $h_name if you import the fields. Array references are available as regular array variables, so for example C<@{ $host_obj-Ealiases() }> would be simply @h_aliases. -The gethost() funtion is a simple front-end that forwards a numeric +The gethost() function is a simple front-end that forwards a numeric argument to gethostbyaddr() by way of Socket::inet_aton, and the rest to gethostbyname(). diff --git a/contrib/perl5/lib/Net/netent.pm b/contrib/perl5/lib/Net/netent.pm index b82447c..fbc6d98 100644 --- a/contrib/perl5/lib/Net/netent.pm +++ b/contrib/perl5/lib/Net/netent.pm @@ -92,7 +92,7 @@ $n_name if you import the fields. Array references are available as regular array variables, so for example C<@{ $net_obj-Ealiases() }> would be simply @n_aliases. -The getnet() funtion is a simple front-end that forwards a numeric +The getnet() function is a simple front-end that forwards a numeric argument to getnetbyaddr(), and the rest to getnetbyname(). diff --git a/contrib/perl5/lib/Pod/Html.pm b/contrib/perl5/lib/Pod/Html.pm index 5d2e07b..e71afa8 100644 --- a/contrib/perl5/lib/Pod/Html.pm +++ b/contrib/perl5/lib/Pod/Html.pm @@ -11,6 +11,8 @@ use Cwd; use Carp; +use locale; # make \w work right in non-ASCII lands + use strict; use Config; @@ -300,18 +302,20 @@ sub pod2html { open(HTML, ">$htmlfile") || die "$0: cannot open $htmlfile file for output: $!\n"; - # put a title in the HTML file - $title = ''; - TITLE_SEARCH: { - for (my $i = 0; $i < @poddata; $i++) { - if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { - for my $para ( @poddata[$i, $i+1] ) { - last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+.*\S)/s; - } - } + # put a title in the HTML file if one wasn't specified + if ($title eq '') { + TITLE_SEARCH: { + for (my $i = 0; $i < @poddata; $i++) { + if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { + for my $para ( @poddata[$i, $i+1] ) { + last TITLE_SEARCH + if ($title) = $para =~ /(\S+\s+-+.*\S)/s; + } + } - } - } + } + } + } if (!$title and $podfile =~ /\.pod$/) { # probably a split pod so take first =head[12] as title for (my $i = 0; $i < @poddata; $i++) { @@ -1371,9 +1375,6 @@ sub process_L { # LREF: a la HREF L $linktext = $1 if s:^([^|]+)\|::; - # a :: acts like a / - s,::,/,; - # make sure sections start with a / s,^",/",g; s,^,/,g if (!m,/, && / /); @@ -1397,6 +1398,11 @@ sub process_L { if ($page eq "") { $link = "#" . htmlify(0,$section); $linktext = $section unless defined($linktext); + } elsif ( $page =~ /::/ ) { + $linktext = ($section ? "$section" : "$page"); + $page =~ s,::,/,g; + $link = "$htmlroot/$page.html"; + $link .= "#" . htmlify(0,$section) if ($section); } elsif (!defined $pages{$page}) { warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n"; $link = ""; diff --git a/contrib/perl5/lib/Pod/Text.pm b/contrib/perl5/lib/Pod/Text.pm index 67993db..549bab5 100644 --- a/contrib/perl5/lib/Pod/Text.pm +++ b/contrib/perl5/lib/Pod/Text.pm @@ -52,6 +52,8 @@ require Exporter; use vars qw($VERSION); $VERSION = "1.0203"; +use locale; # make \w work right in non-ASCII lands + $termcap=0; $opt_alt_format = 0; @@ -273,14 +275,14 @@ sub prepare_for_output { my $paratag = $_; $_ = ; if (/^=/) { # tricked! - local($indent) = $indent[$#index - 1] || $DEF_INDENT; + local($indent) = $indent[$#indent - 1] || $DEF_INDENT; output($paratag); redo POD_DIRECTIVE; } &prepare_for_output; IP_output($paratag, $_); } else { - local($indent) = $indent[$#index - 1] || $DEF_INDENT; + local($indent) = $indent[$#indent - 1] || $DEF_INDENT; output($_, 0); } } @@ -368,7 +370,7 @@ sub fill { sub IP_output { local($tag, $_) = @_; - local($tag_indent) = $indent[$#index - 1] || $DEF_INDENT; + local($tag_indent) = $indent[$#indent - 1] || $DEF_INDENT; $tag_cols = $SCREEN - $tag_indent; $cols = $SCREEN - $indent; $tag =~ s/\s*$//; diff --git a/contrib/perl5/lib/SelfLoader.pm b/contrib/perl5/lib/SelfLoader.pm index a73f68a..311d953 100644 --- a/contrib/perl5/lib/SelfLoader.pm +++ b/contrib/perl5/lib/SelfLoader.pm @@ -133,7 +133,7 @@ is available for reading via the filehandle FOOBAR::DATA, where FOOBAR is the name of the current package when the C<__DATA__> token is reached. This works just the same as C<__END__> does in package 'main', but for other modules data after C<__END__> is not -automatically retreivable , whereas data after C<__DATA__> is. +automatically retrievable, whereas data after C<__DATA__> is. The C<__DATA__> token is not recognized in versions of perl prior to 5.001m. @@ -203,7 +203,7 @@ There is no need to inherit from the B. The B works similarly to the AutoLoader, but picks up the subs from after the C<__DATA__> instead of in the 'lib/auto' directory. -There is a maintainance gain in not needing to run AutoSplit on the module +There is a maintenance gain in not needing to run AutoSplit on the module at installation, and a runtime gain in not needing to keep opening and closing files to load subs. There is a runtime loss in needing to parse the code after the C<__DATA__>. Details of the B and diff --git a/contrib/perl5/lib/Symbol.pm b/contrib/perl5/lib/Symbol.pm index 5ed6b26..a842c1c 100644 --- a/contrib/perl5/lib/Symbol.pm +++ b/contrib/perl5/lib/Symbol.pm @@ -46,7 +46,7 @@ C turns unqualified symbol names into qualified variable names (e.g. "myvar" -E "MyPackage::myvar"). If it is given a second parameter, C uses it as the default package; otherwise, it uses the package of its caller. Regardless, global -variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with +variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with "main::". Qualification applies only to symbol names (strings). References are diff --git a/contrib/perl5/lib/Term/Complete.pm b/contrib/perl5/lib/Term/Complete.pm index 275aade..445dfca 100644 --- a/contrib/perl5/lib/Term/Complete.pm +++ b/contrib/perl5/lib/Term/Complete.pm @@ -5,7 +5,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(Complete); -# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91 +# @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91 =head1 NAME @@ -13,8 +13,8 @@ Term::Complete - Perl word completion module =head1 SYNOPSIS - $input = complete('prompt_string', \@completion_list); - $input = complete('prompt_string', @completion_list); + $input = Complete('prompt_string', \@completion_list); + $input = Complete('prompt_string', @completion_list); =head1 DESCRIPTION @@ -56,7 +56,7 @@ Bell sounds when word completion fails. =head1 BUGS -The completion charater EtabE cannot be changed. +The completion character EtabE cannot be changed. =head1 AUTHOR @@ -72,7 +72,11 @@ CONFIG: { } sub Complete { - my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r); + my($prompt, @cmp_list, $cmp, $test, $l, @match); + my ($return, $r) = ("", 0); + + $return = ""; + $r = 0; $prompt = shift; if (ref $_[0] || $_[0] =~ /^\*/) { @@ -90,17 +94,17 @@ sub Complete { # (TAB) attempt completion $_ eq "\t" && do { @match = grep(/^$return/, @cmp_lst); - $l = length($test = shift(@match)); unless ($#match < 0) { + $l = length($test = shift(@match)); foreach $cmp (@match) { until (substr($cmp, 0, $l) eq substr($test, 0, $l)) { $l--; } } print("\a"); + print($test = substr($test, $r, $l - $r)); + $r = length($return .= $test); } - print($test = substr($test, $r, $l - $r)); - $r = length($return .= $test); last CASE; }; @@ -113,8 +117,8 @@ sub Complete { # (^U) kill $_ eq $kill && do { if ($r) { - undef $r; - undef $return; + $r = 0; + $return = ""; print("\r\n"); redo LOOP; } diff --git a/contrib/perl5/lib/Term/ReadLine.pm b/contrib/perl5/lib/Term/ReadLine.pm index 470226d..e7cf00c 100644 --- a/contrib/perl5/lib/Term/ReadLine.pm +++ b/contrib/perl5/lib/Term/ReadLine.pm @@ -139,7 +139,7 @@ None =head1 ENVIRONMENT -The envrironment variable C governs which ReadLine clone is +The environment variable C governs which ReadLine clone is loaded. If the value is false, a dummy interface is used. If the value is true, it should be tail of the name of the package to use, such as C or C. diff --git a/contrib/perl5/lib/Test.pm b/contrib/perl5/lib/Test.pm index 6f57415..7a0e59b 100644 --- a/contrib/perl5/lib/Test.pm +++ b/contrib/perl5/lib/Test.pm @@ -2,17 +2,19 @@ use strict; package Test; use Test::Harness 1.1601 (); use Carp; -use vars (qw($VERSION @ISA @EXPORT $ntest $TestLevel), #public-ish - qw($ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish -$VERSION = '1.04'; +use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish + qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish +$VERSION = '1.122'; require Exporter; @ISA=('Exporter'); -@EXPORT= qw(&plan &ok &skip $ntest); +@EXPORT=qw(&plan &ok &skip); +@EXPORT_OK=qw($ntest $TESTOUT); $TestLevel = 0; # how many extra stack frames to skip $|=1; #$^W=1; ? $ntest=1; +$TESTOUT = *STDOUT{IO}; # Use of this variable is strongly discouraged. It is set mainly to # help test coverage analyzers know which test is running. @@ -35,9 +37,9 @@ sub plan { } my @todo = sort { $a <=> $b } keys %todo; if (@todo) { - print "1..$max todo ".join(' ', @todo).";\n"; + print $TESTOUT "1..$max todo ".join(' ', @todo).";\n"; } else { - print "1..$max\n"; + print $TESTOUT "1..$max\n"; } ++$planned; } @@ -47,9 +49,6 @@ sub to_value { (ref $v or '') eq 'CODE' ? $v->() : $v; } -# STDERR is NOT used for diagnostic output which should have been -# fixed before release. Is this appropriate? - sub ok ($;$$) { croak "ok: plan before you test!" if !$planned; my ($pkg,$file,$line) = caller($TestLevel); @@ -63,49 +62,49 @@ sub ok ($;$$) { $ok = $result; } else { $expected = to_value(shift); - # until regex can be manipulated like objects... my ($regex,$ignore); - if (($regex) = ($expected =~ m,^ / (.+) / $,sx) or + if ((ref($expected)||'') eq 'Regexp') { + $ok = $result =~ /$expected/; + } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) { $ok = $result =~ /$regex/; } else { $ok = $result eq $expected; } } - if ($todo{$ntest}) { - if ($ok) { - print "ok $ntest # Wow! ($context)\n"; - } else { - $diag = to_value(shift) if @_; - if (!$diag) { - print "not ok $ntest # (failure expected in $context)\n"; - } else { - print "not ok $ntest # (failure expected: $diag)\n"; - } - } + my $todo = $todo{$ntest}; + if ($todo and $ok) { + $context .= ' TODO?!' if $todo; + print $TESTOUT "ok $ntest # ($context)\n"; } else { - print "not " if !$ok; - print "ok $ntest\n"; + print $TESTOUT "not " if !$ok; + print $TESTOUT "ok $ntest\n"; if (!$ok) { my $detail = { 'repetition' => $repetition, 'package' => $pkg, - 'result' => $result }; + 'result' => $result, 'todo' => $todo }; $$detail{expected} = $expected if defined $expected; $diag = $$detail{diagnostic} = to_value(shift) if @_; + $context .= ' *TODO*' if $todo; if (!defined $expected) { if (!$diag) { - print STDERR "# Failed test $ntest in $context\n"; + print $TESTOUT "# Failed test $ntest in $context\n"; } else { - print STDERR "# Failed test $ntest in $context: $diag\n"; + print $TESTOUT "# Failed test $ntest in $context: $diag\n"; } } else { my $prefix = "Test $ntest"; - print STDERR "# $prefix got: '$result' ($context)\n"; + print $TESTOUT "# $prefix got: '$result' ($context)\n"; $prefix = ' ' x (length($prefix) - 5); + if ((ref($expected)||'') eq 'Regexp') { + $expected = 'qr/'.$expected.'/' + } else { + $expected = "'$expected'"; + } if (!$diag) { - print STDERR "# $prefix Expected: '$expected'\n"; + print $TESTOUT "# $prefix Expected: $expected\n"; } else { - print STDERR "# $prefix Expected: '$expected' ($diag)\n"; + print $TESTOUT "# $prefix Expected: $expected ($diag)\n"; } } push @FAILDETAIL, $detail; @@ -116,8 +115,10 @@ sub ok ($;$$) { } sub skip ($$;$$) { - if (to_value(shift)) { - print "ok $ntest # skip\n"; + my $whyskip = to_value(shift); + if ($whyskip) { + $whyskip = 'skip' if $whyskip =~ m/^\d+$/; + print $TESTOUT "ok $ntest # $whyskip\n"; ++ $ntest; 1; } else { @@ -141,7 +142,12 @@ __END__ use strict; use Test; - BEGIN { plan tests => 13, todo => [3,4] } + + # use a BEGIN block so we print our plan before MyModule is loaded + BEGIN { plan tests => 14, todo => [3,4] } + + # load your module... + use MyModule; ok(0); # failure ok(1); # success @@ -152,10 +158,11 @@ __END__ ok(0,1); # failure: '0' ne '1' ok('broke','fixed'); # failure: 'broke' ne 'fixed' ok('fixed','fixed'); # success: 'fixed' eq 'fixed' + ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/ ok(sub { 1+1 }, 2); # success: '2' eq '2' ok(sub { 1+1 }, 3); # failure: '2' ne '3' - ok(0, int(rand(2)); # (just kidding! :-) + ok(0, int(rand(2)); # (just kidding :-) my @list = (0,0); ok @list, 3, "\@list=".join(',',@list); #extra diagnostics @@ -165,9 +172,9 @@ __END__ =head1 DESCRIPTION -Test::Harness expects to see particular output when it executes tests. -This module aims to make writing proper test scripts just a little bit -easier (and less error prone :-). +L expects to see particular output when it executes +tests. This module aims to make writing proper test scripts just a +little bit easier (and less error prone :-). =head1 TEST TYPES @@ -175,57 +182,64 @@ easier (and less error prone :-). =item * NORMAL TESTS -These tests are expected to succeed. If they don't, something's +These tests are expected to succeed. If they don't something's screwed up! =item * SKIPPED TESTS -Skip tests need a platform specific feature that might or might not be -available. The first argument should evaluate to true if the required -feature is NOT available. After the first argument, skip tests work +Skip is for tests that might or might not be possible to run depending +on the availability of platform specific features. The first argument +should evaluate to true (think "yes, please skip") if the required +feature is not available. After the first argument, skip works exactly the same way as do normal tests. =item * TODO TESTS -TODO tests are designed for maintaining an executable TODO list. -These tests are expected NOT to succeed (otherwise the feature they -test would be on the new feature list, not the TODO list). +TODO tests are designed for maintaining an B. +These tests are expected NOT to succeed. If a TODO test does succeed, +the feature in question should not be on the TODO list, now should it? -Packages should NOT be released with successful TODO tests. As soon +Packages should NOT be released with succeeding TODO tests. As soon as a TODO test starts working, it should be promoted to a normal test -and the newly minted feature should be documented in the release -notes. +and the newly working feature should be documented in the release +notes or change log. =back +=head1 RETURN VALUE + +Both C and C return true if their test succeeds and false +otherwise in a scalar context. + =head1 ONFAIL BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } } -The test failures can trigger extra diagnostics at the end of the test -run. C is passed an array ref of hash refs that describe each -test failure. Each hash will contain at least the following fields: -package, repetition, and result. (The file, line, and test number are -not included because their correspondance to a particular test is -fairly weak.) If the test had an expected value or a diagnostic -string, these will also be included. - -This optional feature might be used simply to print out the version of -your package and/or how to report problems. It might also be used to -generate extremely sophisticated diagnostics for a particular test -failure. It's not a panacea, however. Core dumps or other -unrecoverable errors will prevent the C hook from running. -(It is run inside an END block.) Besides, C is probably -over-kill in the majority of cases. (Your test code should be simpler +While test failures should be enough, extra diagnostics can be +triggered at the end of a test run. C is passed an array ref +of hash refs that describe each test failure. Each hash will contain +at least the following fields: C, C, and +C. (The file, line, and test number are not included because +their correspondance to a particular test is tenuous.) If the test +had an expected value or a diagnostic string, these will also be +included. + +The B C hook might be used simply to print out the +version of your package and/or how to report problems. It might also +be used to generate extremely sophisticated diagnostics for a +particularly bizarre test failure. However it's not a panacea. Core +dumps or other unrecoverable errors prevent the C hook from +running. (It is run inside an C block.) Besides, C is +probably over-kill in most cases. (Your test code should be simpler than the code it is testing, yes?) =head1 SEE ALSO -L and various test coverage analysis tools. +L and, perhaps, test coverage analysis tools. =head1 AUTHOR -Copyright (C) 1998 Joshua Nathaniel Pritikin. All rights reserved. +Copyright (c) 1998 Joshua Nathaniel Pritikin. All rights reserved. This package is free software and is provided "as is" without express or implied warranty. It may be used, redistributed and/or modified diff --git a/contrib/perl5/lib/Test/Harness.pm b/contrib/perl5/lib/Test/Harness.pm index 9c61d3a..935e8f0 100644 --- a/contrib/perl5/lib/Test/Harness.pm +++ b/contrib/perl5/lib/Test/Harness.pm @@ -160,7 +160,7 @@ sub runtests { } else { push @failed, $next..$max; $failed = @failed; - (my $txt, $canon) = canonfailed($max,@failed); + (my $txt, $canon) = canonfailed($max,$skipped,@failed); $percent = 100*(scalar @failed)/$max; print "DIED. ",$txt; } @@ -173,7 +173,7 @@ sub runtests { } elsif ($ok == $max && $next == $max+1) { if ($max and $skipped + $bonus) { my @msg; - push(@msg, "$skipped subtest".($skipped>1?'s':'')." skipped") + push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped") if $skipped; push(@msg, "$bonus subtest".($bonus>1?'s':''). " unexpectedly succeeded") @@ -191,7 +191,7 @@ sub runtests { push @failed, $next..$max; } if (@failed) { - my ($txt, $canon) = canonfailed($max,@failed); + my ($txt, $canon) = canonfailed($max,$skipped,@failed); print $txt; $failedtests{$test} = { canon => $canon, max => $max, failed => scalar @failed, @@ -300,7 +300,7 @@ sub corestatus { } sub canonfailed ($@) { - my($max,@failed) = @_; + my($max,$skipped,@failed) = @_; my %seen; @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed; my $failed = @failed; @@ -330,7 +330,12 @@ sub canonfailed ($@) { } push @result, "\tFailed $failed/$max tests, "; - push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n"; + push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay"; + my $ender = 's' x ($skipped > 1); + my $good = $max - $failed - $skipped; + my $goodper = sprintf("%.2f",100*($good/$max)); + push @result, " (-$skipped skipped test$ender: $good okay, $goodper%)" if $skipped; + push @result, "\n"; my $txt = join "", @result; ($txt, $canon); } diff --git a/contrib/perl5/lib/Text/ParseWords.pm b/contrib/perl5/lib/Text/ParseWords.pm index 2414f80..065c2f7 100644 --- a/contrib/perl5/lib/Text/ParseWords.pm +++ b/contrib/perl5/lib/Text/ParseWords.pm @@ -63,7 +63,7 @@ sub parse_line { ([\000-\377]*) # and the rest | # --OR-- ^((?:\\.|[^\\"'])*?) # an $unquoted text - (\Z(?!\n)|$delimiter|(?!^)(?=["'])) + (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["'])) # plus EOL, delimiter, or quote ([\000-\377]*) # the rest /x; # extended layout diff --git a/contrib/perl5/lib/Text/Wrap.pm b/contrib/perl5/lib/Text/Wrap.pm index 0fe7fb9..5f95edb 100644 --- a/contrib/perl5/lib/Text/Wrap.pm +++ b/contrib/perl5/lib/Text/Wrap.pm @@ -1,57 +1,65 @@ package Text::Wrap; -use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $columns $debug); -use strict; -use Exporter; +require Exporter; -$VERSION = "97.02"; @ISA = qw(Exporter); -@EXPORT = qw(wrap); -@EXPORT_OK = qw($columns $tabstop fill); +@EXPORT = qw(wrap fill); +@EXPORT_OK = qw($columns $break $huge); -use Text::Tabs qw(expand unexpand $tabstop); +$VERSION = 98.112902; +use vars qw($VERSION $columns $debug $break $huge); +use strict; BEGIN { - $columns = 76; # <= screen width - $debug = 0; + $columns = 76; # <= screen width + $debug = 0; + $break = '\s'; + $huge = 'wrap'; # alternatively: 'die' } +use Text::Tabs qw(expand unexpand); + sub wrap { - my ($ip, $xp, @t) = @_; - - my @rv; - my $t = expand(join(" ",@t)); - - my $lead = $ip; - my $ll = $columns - length(expand($lead)) - 1; - my $nl = ""; - - $t =~ s/^\s+//; - while(length($t) > $ll) { - # remove up to a line length of things that - # aren't new lines and tabs. - if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//) { - my ($l,$r) = ($1,$2); - $l =~ s/\s+$//; - print "WRAP $lead$l..($r)\n" if $debug; - push @rv, unexpand($lead . $l), "\n"; - - } elsif ($t =~ s/^([^\n]{$ll})//) { - print "SPLIT $lead$1..\n" if $debug; - push @rv, unexpand($lead . $1),"\n"; + my ($ip, $xp, @t) = @_; + + my $r = ""; + my $t = expand(join(" ",@t)); + my $lead = $ip; + my $ll = $columns - length(expand($ip)) - 1; + my $nll = $columns - length(expand($xp)) - 1; + my $nl = ""; + my $remainder = ""; + + while ($t !~ /^\s*$/) { + if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//xm) { + $r .= unexpand($nl . $lead . $1); + $remainder = $2; + } elsif ($huge eq 'wrap' && $t =~ s/^([^\n]{$ll})//) { + $r .= unexpand($nl . $lead . $1); + $remainder = "\n"; + } elsif ($huge eq 'die') { + die "couldn't wrap '$t'"; + } else { + die "This shouldn't happen"; + } + + $lead = $xp; + $ll = $nll; + $nl = "\n"; } - # recompute the leader - $lead = $xp; - $ll = $columns - length(expand($lead)) - 1; - $t =~ s/^\s+//; - } - print "TAIL $lead$t\n" if $debug; - push @rv, $lead.$t if $t ne ""; - return join '', @rv; -} + $r .= $remainder; + print "-----------$r---------\n" if $debug; + + print "Finish up with '$lead', '$t'\n" if $debug; + + $r .= $lead . $t if $t ne ""; + + print "-----------$r---------\n" if $debug;; + return $r; +} sub fill { @@ -83,26 +91,32 @@ Text::Wrap - line wrapping to form simple paragraphs use Text::Wrap print wrap($initial_tab, $subsequent_tab, @text); + print fill($initial_tab, $subsequent_tab, @text); - use Text::Wrap qw(wrap $columns $tabstop fill); + use Text::Wrap qw(wrap $columns $huge); $columns = 132; - $tabstop = 4; - - print fill($initial_tab, $subsequent_tab, @text); - print fill("", "", `cat book`); + $huge = 'die'; + $huge = 'wrap'; =head1 DESCRIPTION Text::Wrap::wrap() is a very simple paragraph formatter. It formats a -single paragraph at a time by breaking lines at word boundries. +single paragraph at a time by breaking lines at word boundaries. Indentation is controlled for the first line ($initial_tab) and -all subsquent lines ($subsequent_tab) independently. $Text::Wrap::columns -should be set to the full width of your output device. +all subsequent lines ($subsequent_tab) independently. + +Lines are wrapped at $Text::Wrap::columns columns. +$Text::Wrap::columns should be set to the full width of your output device. + +When words that are longer than $columns are encountered, they +are broken up. Previous versions of wrap() die()ed instead. +To restore the old (dying) behavior, set $Text::Wrap::huge to +'die'. Text::Wrap::fill() is a simple multi-paragraph formatter. It formats each paragraph separately and then joins them together when it's done. It -will destory any whitespace in the original text. It breaks text into +will destroy any whitespace in the original text. It breaks text into paragraphs by looking for whitespace after a newline. In other respects it acts like wrap(). @@ -111,15 +125,8 @@ it acts like wrap(). print wrap("\t","","This is a bit of text that forms a normal book-style paragraph"); -=head1 BUGS - -It's not clear what the correct behavior should be when Wrap() is -presented with a word that is longer than a line. The previous -behavior was to die. Now the word is now split at line-length. - =head1 AUTHOR David Muir Sharnoff with help from Tim Pierce and -others. Updated by Jacqui Caren. +many many others. -=cut diff --git a/contrib/perl5/lib/Tie/Array.pm b/contrib/perl5/lib/Tie/Array.pm index 4041b00..3f34c3b 100644 --- a/contrib/perl5/lib/Tie/Array.pm +++ b/contrib/perl5/lib/Tie/Array.pm @@ -176,23 +176,23 @@ provides the methods below. =item STORE this, index, value -Store datum I into I for the tied array assoicated with +Store datum I into I for the tied array associated with object I. If this makes the array larger then class's mapping of C should be returned for new positions. =item FETCH this, index -Retrieve the datum in I for the tied array assoicated with +Retrieve the datum in I for the tied array associated with object I. =item FETCHSIZE this -Returns the total number of items in the tied array assoicated with +Returns the total number of items in the tied array associated with object I. (Equivalent to C). =item STORESIZE this, count -Sets the total number of items in the tied array assoicated with +Sets the total number of items in the tied array associated with object I to be I. If this makes the array larger then class's mapping of C should be returned for new positions. If the array becomes smaller then entries beyond count should be @@ -205,7 +205,7 @@ Can be used to optimize allocation. This method need do nothing. =item CLEAR this -Clear (remove, delete, ...) all values from the tied array assoicated with +Clear (remove, delete, ...) all values from the tied array associated with object I. =item DESTROY this @@ -227,7 +227,7 @@ and return it. =item UNSHIFT this, LIST -Insert LIST elements at the begining of the array, moving existing elements +Insert LIST elements at the beginning of the array, moving existing elements up to make room. =item SPLICE this, offset, length, LIST diff --git a/contrib/perl5/lib/Tie/Hash.pm b/contrib/perl5/lib/Tie/Hash.pm index 7ed1896..2902efb 100644 --- a/contrib/perl5/lib/Tie/Hash.pm +++ b/contrib/perl5/lib/Tie/Hash.pm @@ -92,7 +92,7 @@ but may be omitted in favor of a simple default. =head1 MORE INFORMATION -The packages relating to various DBM-related implemetations (F, +The packages relating to various DBM-related implementations (F, F, etc.) show examples of general tied hashes, as does the L module. While these do not utilize B, they serve as good working examples. diff --git a/contrib/perl5/lib/Tie/SubstrHash.pm b/contrib/perl5/lib/Tie/SubstrHash.pm index 44c2140..4b18a58 100644 --- a/contrib/perl5/lib/Tie/SubstrHash.pm +++ b/contrib/perl5/lib/Tie/SubstrHash.pm @@ -69,7 +69,7 @@ sub FETCH { sub STORE { local($self,$key,$val) = @_; local($klen, $vlen, $tsize, $rlen) = @$self[1..4]; - croak("Table is full") if $self[5] == $tsize; + croak("Table is full") if $$self[5] == $tsize; croak(qq/Value "$val" is not $vlen characters long./) if length($val) != $vlen; my $writeoffset; diff --git a/contrib/perl5/lib/Time/Local.pm b/contrib/perl5/lib/Time/Local.pm index eef412d..b2fba7c 100644 --- a/contrib/perl5/lib/Time/Local.pm +++ b/contrib/perl5/lib/Time/Local.pm @@ -17,16 +17,18 @@ Time::Local - efficiently compute time from local and GMT time =head1 DESCRIPTION -These routines are quite efficient and yet are always guaranteed to agree -with localtime() and gmtime(). We manage this by caching the start times -of any months we've seen before. If we know the start time of the month, -we can always calculate any time within the month. The start times -themselves are guessed by successive approximation starting at the -current time, since most dates seen in practice are close to the -current date. Unlike algorithms that do a binary search (calling gmtime -once for each bit of the time value, resulting in 32 calls), this algorithm -calls it at most 6 times, and usually only once or twice. If you hit -the month cache, of course, it doesn't call it at all. +These routines are quite efficient and yet are always guaranteed to +agree with localtime() and gmtime(), the most notable points being +that year is year-1900 and month is 0..11. We manage this by caching +the start times of any months we've seen before. If we know the start +time of the month, we can always calculate any time within the month. +The start times themselves are guessed by successive approximation +starting at the current time, since most dates seen in practice are +close to the current date. Unlike algorithms that do a binary search +(calling gmtime once for each bit of the time value, resulting in 32 +calls), this algorithm calls it at most 6 times, and usually only once +or twice. If you hit the month cache, of course, it doesn't call it +at all. timelocal is implemented using the same cache. We just assume that we're translating a GMT time, and then fudge it when we're done for the timezone diff --git a/contrib/perl5/lib/Time/gmtime.pm b/contrib/perl5/lib/Time/gmtime.pm index c1d11d7..9b823f6 100644 --- a/contrib/perl5/lib/Time/gmtime.pm +++ b/contrib/perl5/lib/Time/gmtime.pm @@ -69,7 +69,7 @@ still overrides your core functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. -The gmctime() funtion provides a way of getting at the +The gmctime() function provides a way of getting at the scalar sense of the original CORE::gmtime() function. To access this functionality without the core overrides, diff --git a/contrib/perl5/lib/Time/localtime.pm b/contrib/perl5/lib/Time/localtime.pm index 9437752..18a36c7 100644 --- a/contrib/perl5/lib/Time/localtime.pm +++ b/contrib/perl5/lib/Time/localtime.pm @@ -65,7 +65,7 @@ variables named with a preceding C in front their method names. Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. -The ctime() funtion provides a way of getting at the +The ctime() function provides a way of getting at the scalar sense of the original CORE::localtime() function. To access this functionality without the core overrides, diff --git a/contrib/perl5/lib/User/grent.pm b/contrib/perl5/lib/User/grent.pm index deb0a8d..e4e226d 100644 --- a/contrib/perl5/lib/User/grent.pm +++ b/contrib/perl5/lib/User/grent.pm @@ -74,7 +74,7 @@ to $gr_gid if you import the fields. Array references are available as regular array variables, so C<@{ $group_obj-Emembers() }> would be simply @gr_members. -The getpw() funtion is a simple front-end that forwards +The getpw() function is a simple front-end that forwards a numeric argument to getpwuid() and the rest to getpwnam(). To access this functionality without the core overrides, diff --git a/contrib/perl5/lib/User/pwent.pm b/contrib/perl5/lib/User/pwent.pm index 32301ca..bb2dace 100644 --- a/contrib/perl5/lib/User/pwent.pm +++ b/contrib/perl5/lib/User/pwent.pm @@ -84,7 +84,7 @@ variables named with a preceding C in front their method names. Thus, C<$passwd_obj-Eshell()> corresponds to $pw_shell if you import the fields. -The getpw() funtion is a simple front-end that forwards +The getpw() function is a simple front-end that forwards a numeric argument to getpwuid() and the rest to getpwnam(). To access this functionality without the core overrides, diff --git a/contrib/perl5/lib/constant.pm b/contrib/perl5/lib/constant.pm index 464e20c..5d3dd91 100644 --- a/contrib/perl5/lib/constant.pm +++ b/contrib/perl5/lib/constant.pm @@ -20,6 +20,18 @@ constant - Perl pragma to declare constants print "This line does nothing" unless DEBUGGING; + # references can be declared constant + use constant CHASH => { foo => 42 }; + use constant CARRAY => [ 1,2,3,4 ]; + use constant CPSEUDOHASH => [ { foo => 1}, 42 ]; + use constant CCODE => sub { "bite $_[0]\n" }; + + print CHASH->{foo}; + print CARRAY->[$i]; + print CPSEUDOHASH->{foo}; + print CCODE->("me"); + print CHASH->[10]; # compile-time error + =head1 DESCRIPTION This will declare a symbol to be a constant with the given scalar @@ -86,6 +98,8 @@ constants at compile time, allowing for way cool stuff like this. print E2BIG, "\n"; # something like "Arg list too long" print 0+E2BIG, "\n"; # "7" +Errors in dereferencing constant references are trapped at compile-time. + =head1 TECHNICAL NOTE In the current implementation, scalar constants are actually diff --git a/contrib/perl5/lib/diagnostics.pm b/contrib/perl5/lib/diagnostics.pm index 78bf445..b9aaba5 100755 --- a/contrib/perl5/lib/diagnostics.pm +++ b/contrib/perl5/lib/diagnostics.pm @@ -27,7 +27,7 @@ Aa a program: =head2 The C Pragma This module extends the terse diagnostics normally emitted by both the -perl compiler and the perl interpeter, augmenting them with the more +perl compiler and the perl interpreter, augmenting them with the more explicative and endearing descriptions found in L. Like the other pragmata, it affects the compilation phase of your program rather than merely the execution phase. diff --git a/contrib/perl5/lib/fields.pm b/contrib/perl5/lib/fields.pm index db2eea7..54602a6 100644 --- a/contrib/perl5/lib/fields.pm +++ b/contrib/perl5/lib/fields.pm @@ -32,7 +32,7 @@ does so by updating the %FIELDS hash in the calling package. If a typed lexical variable holding a reference is used to access a hash element and the %FIELDS hash of the given type exists, then the operation is turned into an array access at compile time. The %FIELDS -hash map from hash element names to the array indices. If the hash +hash maps from hash element names to the array indices. If the hash element is not present in the %FIELDS hash, then a compile-time error is signaled. @@ -57,7 +57,7 @@ constructor like this does the job: { my $class = shift; no strict 'refs'; - my $self = bless [\%{"$class\::FIELDS"], $class; + my $self = bless [\%{"$class\::FIELDS"}], $class; $self; } diff --git a/contrib/perl5/lib/overload.pm b/contrib/perl5/lib/overload.pm index 43fef8a..f06b49c 100644 --- a/contrib/perl5/lib/overload.pm +++ b/contrib/perl5/lib/overload.pm @@ -167,13 +167,6 @@ overload - Package for overloading perl operations ... $strval = overload::StrVal $b; -=head1 CAVEAT SCRIPTOR - -Overloading of operators is a subject not to be taken lightly. -Neither its precise implementation, syntax, nor semantics are -100% endorsed by Larry Wall. So any of these may be changed -at some point in the future. - =head1 DESCRIPTION =head2 Declaration of overloaded functions @@ -274,7 +267,7 @@ value of their arguments, and may leave it as is. The result is going to be assigned to the value in the left-hand-side if different from this value. -This allows for the same method to be used as averloaded C<+=> and +This allows for the same method to be used as overloaded C<+=> and C<+>. Note that this is I, but not recommended, since by the semantic of L<"Fallback"> Perl will call the method for C<+> anyway, if C<+=> is not overloaded. @@ -283,7 +276,7 @@ if C<+=> is not overloaded. B Due to the presense of assignment versions of operations, routines which may be called in assignment context may create -self-referencial structures. Currently Perl will not free self-referential +self-referential structures. Currently Perl will not free self-referential structures until cycles are C broken. You may get problems when traversing your structures too. @@ -537,7 +530,7 @@ C<'='> was overloaded with C<\&clone>. =back -Same behaviour is triggered by C<$b = $a++>, which is consider a synonim for +Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for C<$b = $a; ++$a>. =head1 MAGIC AUTOGENERATION @@ -748,7 +741,7 @@ There is no size penalty for data if overload is not used. The only size penalty if overload is used in some package is that I the packages acquire a magic during the next Cing into the package. This magic is three-words-long for packages without -overloading, and carries the cache tabel if the package is overloaded. +overloading, and carries the cache table if the package is overloaded. Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is carried out before any operation that can imply an assignment to the @@ -760,8 +753,8 @@ to be changed are constant (but this is not enforced). =head1 Metaphor clash -One may wonder why the semantic of overloaded C<=> is so counterintuive. -If it I counterintuive to you, you are subject to a metaphor +One may wonder why the semantic of overloaded C<=> is so counter intuitive. +If it I counter intuitive to you, you are subject to a metaphor clash. Here is a Perl object metaphor: @@ -868,7 +861,7 @@ Put this in F in your Perl library directory: This module is very unusual as overloaded modules go: it does not provide any usual overloaded operators, instead it provides the L operator C. In this example the corresponding -subroutine returns an object which encupsulates operations done over +subroutine returns an object which encapsulates operations done over the objects: C contains C<['n', 3]>, C<2 + new symbolic 3> contains C<['+', 2, ['n', 3]]>. @@ -955,7 +948,7 @@ compare an object to 0. In fact, it is easier to write a numeric conversion routine. Here is the text of F with such a routine added (and -slightly modifed str()): +slightly modified str()): package symbolic; # Primitive symbolic calculator use overload @@ -994,7 +987,7 @@ slightly modifed str()): } All the work of numeric conversion is done in %subr and num(). Of -course, %subr is not complete, it contains only operators used in teh +course, %subr is not complete, it contains only operators used in the example below. Here is the extra-credit question: why do we need an explicit recursion in num()? (Answer is at the end of this section.) @@ -1024,7 +1017,7 @@ mutator methods (C<++>, C<-=> and so on), does not do deep copying (not required without mutators!), and implements only those arithmetic operations which are used in the example. -To implement most arithmetic operattions is easy, one should just use +To implement most arithmetic operations is easy, one should just use the tables of operations, and change the code which fills %subr to my %subr = ( 'n' => sub {$_[0]} ); @@ -1102,8 +1095,8 @@ the argument of num(). If you wonder why defaults for conversion are different for str() and num(), note how easy it was to write the symbolic calculator. This simplicity is due to an appropriate choice of defaults. One extra -note: due to teh explicit recursion num() is more fragile than sym(): -we need to explicitly check for the type of $a and $b. If componets +note: due to the explicit recursion num() is more fragile than sym(): +we need to explicitly check for the type of $a and $b. If components $a and $b happen to be of some related type, this may lead to problems. =head2 I symbolic calculator diff --git a/contrib/perl5/lib/perl5db.pl b/contrib/perl5/lib/perl5db.pl index 099a49b..4d05e6d 100644 --- a/contrib/perl5/lib/perl5db.pl +++ b/contrib/perl5/lib/perl5db.pl @@ -2,7 +2,7 @@ package DB; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.0401; +$VERSION = 1.0402; $header = "perl5db.pl version $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -235,7 +235,11 @@ $pretype = [] unless defined $pretype; warnLevel($warnLevel); dieLevel($dieLevel); signalLevel($signalLevel); -&pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager; +&pager((defined($ENV{PAGER}) + ? $ENV{PAGER} + : ($^O eq 'os2' + ? 'cmd /c more' + : 'more'))) unless defined $pager; &recallCommand("!") unless defined $prc; &shellBang("!") unless defined $psh; $maxtrace = 400 unless defined $maxtrace; @@ -361,7 +365,7 @@ sub DB { # _After_ the perl program is compiled, $single is set to 1: if ($single and not $second_time++) { if ($runnonstop) { # Disable until signal - for ($i=0; $i <= $#stack; ) { + for ($i=0; $i <= $stack_depth; ) { $stack[$i++] &= ~1; } $single = 0; @@ -412,11 +416,11 @@ EOP $was_signal = $signal; $signal = 0; if ($single || ($trace & 1) || $was_signal) { - $term || &setterm; if ($emacs) { $position = "\032\032$filename:$line:0\n"; print $LINEINFO $position; } elsif ($package eq 'DB::fake') { + $term || &setterm; print_help(< to quit or B to restart, use B I to avoid stopping after program termination, @@ -439,7 +443,7 @@ EOP $position = "$prefix$line$infix$dbline[$line]$after"; } if ($frame) { - print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after"; + print $LINEINFO ' ' x $stack_depth, "$line:\t$dbline[$line]$after"; } else { print $LINEINFO $position; } @@ -450,7 +454,7 @@ EOP $incr_pos = "$prefix$i$infix$dbline[$i]$after"; $position .= $incr_pos; if ($frame) { - print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after"; + print $LINEINFO ' ' x $stack_depth, "$i:\t$dbline[$i]$after"; } else { print $LINEINFO $incr_pos; } @@ -463,7 +467,7 @@ EOP foreach $evalarg (@$pre) { &eval; } - print $OUT $#stack . " levels deep in subroutine calls!\n" + print $OUT $stack_depth . " levels deep in subroutine calls!\n" if $single & 4; $start = $line; $incr = -1; # for backward motion. @@ -640,8 +644,9 @@ EOP $arrow .= 'b' if $stop; $arrow .= 'a' if $action; print $OUT "$i$arrow\t", $dbline[$i]; - last if $signal; + $i++, last if $signal; } + print $OUT "\n" unless $dbline[$i-1] =~ /\n$/; } $start = $i; # remember in case they want more $start = $max if $start > $max; @@ -879,14 +884,14 @@ EOP } $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p. } - for ($i=0; $i <= $#stack; ) { + for ($i=0; $i <= $stack_depth; ) { $stack[$i++] &= ~1; } last CMD; }; $cmd =~ /^r$/ && do { end_report(), next CMD if $finished and $level <= 1; - $stack[$#stack] |= 1; - $doret = $option{PrintRet} ? $#stack - 1 : -2; + $stack[$stack_depth] |= 1; + $doret = $option{PrintRet} ? $stack_depth - 1 : -2; last CMD; }; $cmd =~ /^R$/ && do { print $OUT "Warning: some settings and command-line options may be lost!\n"; @@ -1169,24 +1174,26 @@ sub sub { if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') { $al = " for $$sub"; } - push(@stack, $single); + local $stack_depth = $stack_depth + 1; # Protect from non-local exits + $#stack = $stack_depth; + $stack[-1] = $single; $single &= 1; - $single |= 4 if $#stack == $deep; + $single |= 4 if $stack_depth == $deep; ($frame & 4 - ? ( (print $LINEINFO ' ' x ($#stack - 1), "in "), + ? ( (print $LINEINFO ' ' x ($stack_depth - 1), "in "), # Why -1? But it works! :-( print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) - : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame; + : print $LINEINFO ' ' x ($stack_depth - 1), "entering $sub$al\n") if $frame; if (wantarray) { @ret = &$sub; - $single |= pop(@stack); + $single |= $stack[$stack_depth--]; ($frame & 4 - ? ( (print $LINEINFO ' ' x $#stack, "out "), + ? ( (print $LINEINFO ' ' x $stack_depth, "out "), print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) - : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2; - if ($doret eq $#stack or $frame & 16) { - my $fh = ($doret eq $#stack ? $OUT : $LINEINFO); - print $fh ' ' x $#stack if $frame & 16; + : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2; + if ($doret eq $stack_depth or $frame & 16) { + my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO); + print $fh ' ' x $stack_depth if $frame & 16; print $fh "list context return from $sub:\n"; dumpit($fh, \@ret ); $doret = -2; @@ -1198,14 +1205,14 @@ sub sub { } else { &$sub; undef $ret; }; - $single |= pop(@stack); + $single |= $stack[$stack_depth--]; ($frame & 4 - ? ( (print $LINEINFO ' ' x $#stack, "out "), + ? ( (print $LINEINFO ' ' x $stack_depth, "out "), print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) - : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2; - if ($doret eq $#stack or $frame & 16 and defined wantarray) { - my $fh = ($doret eq $#stack ? $OUT : $LINEINFO); - print $fh (' ' x $#stack) if $frame & 16; + : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2; + if ($doret eq $stack_depth or $frame & 16 and defined wantarray) { + my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO); + print $fh (' ' x $stack_depth) if $frame & 16; print $fh (defined wantarray ? "scalar context return from $sub: " : "void context return from $sub\n"); @@ -1226,7 +1233,6 @@ sub save { sub eval { my @res; { - local (@stack) = @stack; # guard against recursive debugging my $otrace = $trace; my $osingle = $single; my $od = $^D; @@ -1284,7 +1290,7 @@ sub postponed { $filename =~ s/^_.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do + if [ "$osname" = uwin ]; then + uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" + else + if [ "$osname" = os2 ]; then + uwinfix="-e s,\\\\\\\\,/,g" + else + uwinfix= + fi + fi case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; @@ -126,7 +136,7 @@ for file in `$cat .clist`; do -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' | \ + -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp done diff --git a/contrib/perl5/malloc.c b/contrib/perl5/malloc.c index 73c4039..eca7322 100644 --- a/contrib/perl5/malloc.c +++ b/contrib/perl5/malloc.c @@ -141,7 +141,7 @@ #define MIN_BUC_POW2 (sizeof(void*) > 4 ? 3 : 2) /* Allow for 4-byte arena. */ #define MIN_BUCKET (MIN_BUC_POW2 * BUCKETS_PER_POW2) -#if !(defined(I286) || defined(atarist)) +#if !(defined(I286) || defined(atarist) || defined(__MINT__)) /* take 2k unless the block is bigger than that */ # define LOG_OF_MIN_ARENA 11 #else @@ -247,7 +247,7 @@ #define u_short unsigned short /* 286 and atarist like big chunks, which gives too much overhead. */ -#if (defined(RCHECK) || defined(I286) || defined(atarist)) && defined(PACK_MALLOC) +#if (defined(RCHECK) || defined(I286) || defined(atarist) || defined(__MINT__)) && defined(PACK_MALLOC) # undef PACK_MALLOC #endif @@ -570,12 +570,19 @@ static char bucket_of[] = # define BIG_SIZE (1<<16) /* 64K */ # endif +#ifdef MUTEX_INIT_CALLS_MALLOC +# undef MUTEX_LOCK +# define MUTEX_LOCK(m) STMT_START { if (*m) mutex_lock(*m); } STMT_END +# undef MUTEX_UNLOCK +# define MUTEX_UNLOCK(m) STMT_START { if (*m) mutex_unlock(*m); } STMT_END +#endif + static char *emergency_buffer; static MEM_SIZE emergency_buffer_size; +static Malloc_t emergency_sbrk(MEM_SIZE size); static Malloc_t -emergency_sbrk(size) - MEM_SIZE size; +emergency_sbrk(MEM_SIZE size) { MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<'s whole list */ +int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */ Malloc_t realloc(void *mp, size_t nbytes) @@ -1572,11 +1581,7 @@ dump_mstats(char *s) #ifdef USE_PERL_SBRK -# ifdef NeXT -# define PERL_SBRK_VIA_MALLOC -# endif - -# ifdef __MACHTEN_PPC__ +# if defined(__MACHTEN_PPC__) || defined(__NeXT__) # define PERL_SBRK_VIA_MALLOC /* * MachTen's malloc() returns a buffer aligned on a two-byte boundary. @@ -1619,8 +1624,7 @@ static long Perl_sbrk_oldsize; # define PERLSBRK_64_K (1<<16) Malloc_t -Perl_sbrk(size) -int size; +Perl_sbrk(int size) { IV got; int small, reqsize; diff --git a/contrib/perl5/mg.c b/contrib/perl5/mg.c index 9dfbd4f..d69fd53 100644 --- a/contrib/perl5/mg.c +++ b/contrib/perl5/mg.c @@ -1,6 +1,6 @@ /* mg.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -248,7 +248,9 @@ mg_copy(SV *sv, SV *nsv, char *key, I32 klen) MAGIC* mg; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { if (isUPPER(mg->mg_type)) { - sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen); + sv_magic(nsv, + mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj, + toLOWER(mg->mg_type), key, klen); count++; } } @@ -339,8 +341,10 @@ magic_len(SV *sv, MAGIC *mg) return (STRLEN)PL_orslen; } magic_get(sv,mg); - if (!SvPOK(sv) && SvNIOK(sv)) - sv_2pv(sv, &PL_na); + if (!SvPOK(sv) && SvNIOK(sv)) { + STRLEN n_a; + sv_2pv(sv, &n_a); + } if (SvPOK(sv)) return SvCUR(sv); return 0; @@ -360,6 +364,9 @@ magic_get(SV *sv, MAGIC *mg) case '\001': /* ^A */ sv_setsv(sv, PL_bodytarget); break; + case '\003': /* ^C */ + sv_setiv(sv, (IV)PL_minus_c); + break; case '\004': /* ^D */ sv_setiv(sv, (IV)(PL_debug & 32767)); break; @@ -382,8 +389,11 @@ magic_get(SV *sv, MAGIC *mg) sv_setnv(sv, (double)errno); sv_setpv(sv, errno ? Strerror(errno) : ""); } else { - if (errno != errno_isOS2) - Perl_rc = _syserrno(); + if (errno != errno_isOS2) { + int tmp = _syserrno(); + if (tmp) /* 2nd call to _syserrno() makes it 0 */ + Perl_rc = tmp; + } sv_setnv(sv, (double)Perl_rc); sv_setpv(sv, os2error(Perl_rc)); } @@ -716,7 +726,8 @@ magic_setenv(SV *sv, MAGIC *mg) int magic_clearenv(SV *sv, MAGIC *mg) { - my_setenv(MgPV(mg,PL_na),Nullch); + STRLEN n_a; + my_setenv(MgPV(mg,n_a),Nullch); return 0; } @@ -729,12 +740,13 @@ magic_set_all_env(SV *sv, MAGIC *mg) dTHR; if (PL_localizing) { HE* entry; + STRLEN n_a; magic_clear_all_env(sv,mg); hv_iterinit((HV*)sv); while (entry = hv_iternext((HV*)sv)) { I32 keylen; my_setenv(hv_iterkey(entry, &keylen), - SvPV(hv_iterval((HV*)sv, entry), PL_na)); + SvPV(hv_iterval((HV*)sv, entry), n_a)); } } #endif @@ -757,7 +769,7 @@ magic_clear_all_env(SV *sv, MAGIC *mg) *end = '\0'; my_setenv(cur,Nullch); *end = '='; - cur += strlen(end+1)+1; + cur = end + strlen(end+1)+2; } else if ((len = strlen(cur))) cur += len+1; @@ -782,8 +794,9 @@ int magic_getsig(SV *sv, MAGIC *mg) { I32 i; + STRLEN n_a; /* Are we fetching a signal entry? */ - i = whichsig(MgPV(mg,PL_na)); + i = whichsig(MgPV(mg,n_a)); if (i) { if(psig_ptr[i]) sv_setsv(sv,psig_ptr[i]); @@ -805,8 +818,9 @@ int magic_clearsig(SV *sv, MAGIC *mg) { I32 i; + STRLEN n_a; /* Are we clearing a signal entry? */ - i = whichsig(MgPV(mg,PL_na)); + i = whichsig(MgPV(mg,n_a)); if (i) { if(psig_ptr[i]) { SvREFCNT_dec(psig_ptr[i]); @@ -827,8 +841,9 @@ magic_setsig(SV *sv, MAGIC *mg) register char *s; I32 i; SV** svp; + STRLEN n_a; - s = MgPV(mg,PL_na); + s = MgPV(mg,n_a); if (*s == '_') { if (strEQ(s,"__DIE__")) svp = &PL_diehook; @@ -865,7 +880,7 @@ magic_setsig(SV *sv, MAGIC *mg) *svp = SvREFCNT_inc(sv); return 0; } - s = SvPV_force(sv,PL_na); + s = SvPV_force(sv,n_a); if (strEQ(s,"IGNORE")) { if (i) (void)rsignal(i, SIG_IGN); @@ -922,7 +937,7 @@ magic_getnkeys(SV *sv, MAGIC *mg) if (hv) { (void) hv_iterinit(hv); - if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P')) + if (! SvTIED_mg((SV*)hv, 'P')) i = HvKEYS(hv); else { /*SUPPRESS 560*/ @@ -947,13 +962,13 @@ magic_setnkeys(SV *sv, MAGIC *mg) /* caller is responsible for stack switching/cleanup */ STATIC int -magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val) +magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val) { dSP; PUSHMARK(SP); EXTEND(SP, n); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj(sv, mg)); if (n > 1) { if (mg->mg_ptr) { if (mg->mg_len >= 0) @@ -982,7 +997,7 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth) SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); - if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) { + if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) { sv_setsv(sv, *PL_stack_sp--); } @@ -1007,7 +1022,7 @@ magic_setpack(SV *sv, MAGIC *mg) dSP; ENTER; PUSHSTACKi(PERLSI_MAGIC); - magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); + magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); POPSTACK; LEAVE; return 0; @@ -1029,7 +1044,7 @@ magic_sizepack(SV *sv, MAGIC *mg) ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); - if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) { + if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) { sv = *PL_stack_sp--; retval = (U32) SvIV(sv)-1; } @@ -1046,7 +1061,7 @@ int magic_wipepack(SV *sv, MAGIC *mg) ENTER; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - XPUSHs(mg->mg_obj); + XPUSHs(SvTIED_obj(sv, mg)); PUTBACK; perl_call_method("CLEAR", G_SCALAR|G_DISCARD); POPSTACK; @@ -1065,7 +1080,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key) PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP, 2); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj(sv, mg)); if (SvOK(key)) PUSHs(key); PUTBACK; @@ -1093,11 +1108,12 @@ magic_setdbline(SV *sv, MAGIC *mg) I32 i; GV* gv; SV** svp; + STRLEN n_a; gv = PL_DBline; i = SvTRUE(sv); svp = av_fetch(GvAV(gv), - atoi(MgPV(mg,PL_na)), FALSE); + atoi(MgPV(mg,n_a)), FALSE); if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) o->op_private = i; else @@ -1193,10 +1209,11 @@ magic_setglob(SV *sv, MAGIC *mg) { register char *s; GV* gv; + STRLEN n_a; if (!SvOK(sv)) return 0; - s = SvPV(sv, PL_na); + s = SvPV(sv, n_a); if (*s == '*' && s[1]) s++; gv = gv_fetchpv(s,TRUE, SVt_PVGV); @@ -1406,8 +1423,10 @@ vivify_defelem(SV *sv) if (svp) value = *svp; } - if (!value || value == &PL_sv_undef) - croak(no_helem, SvPV(mg->mg_obj, PL_na)); + if (!value || value == &PL_sv_undef) { + STRLEN n_a; + croak(no_helem, SvPV(mg->mg_obj, n_a)); + } } else { AV* av = (AV*)LvTARG(sv); @@ -1498,6 +1517,9 @@ magic_set(SV *sv, MAGIC *mg) case '\001': /* ^A */ sv_setsv(PL_bodytarget, sv); break; + case '\003': /* ^C */ + PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + break; case '\004': /* ^D */ PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000; DEBUG_x(dump_all()); @@ -1524,7 +1546,7 @@ magic_set(SV *sv, MAGIC *mg) if (PL_inplace) Safefree(PL_inplace); if (SvOK(sv)) - PL_inplace = savepv(SvPV(sv,PL_na)); + PL_inplace = savepv(SvPV(sv,len)); else PL_inplace = Nullch; break; @@ -1532,7 +1554,7 @@ magic_set(SV *sv, MAGIC *mg) if (PL_osname) Safefree(PL_osname); if (SvOK(sv)) - PL_osname = savepv(SvPV(sv,PL_na)); + PL_osname = savepv(SvPV(sv,len)); else PL_osname = Nullch; break; @@ -1559,12 +1581,12 @@ magic_set(SV *sv, MAGIC *mg) break; case '^': Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); - IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na)); + IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '~': Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); - IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na)); + IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '=': @@ -1621,7 +1643,7 @@ magic_set(SV *sv, MAGIC *mg) case '#': if (PL_ofmt) Safefree(PL_ofmt); - PL_ofmt = savepv(SvPV(sv,PL_na)); + PL_ofmt = savepv(SvPV(sv,len)); break; case '[': PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); @@ -1729,7 +1751,7 @@ magic_set(SV *sv, MAGIC *mg) case ')': #ifdef HAS_SETGROUPS { - char *p = SvPV(sv, PL_na); + char *p = SvPV(sv, len); Groups_t gary[NGROUPS]; SET_NUMERIC_STANDARD(); @@ -1777,7 +1799,7 @@ magic_set(SV *sv, MAGIC *mg) PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ':': - PL_chopset = SvPV_force(sv,PL_na); + PL_chopset = SvPV_force(sv,len); break; case '0': if (!PL_origalen) { @@ -1790,7 +1812,10 @@ magic_set(SV *sv, MAGIC *mg) || PL_origargv[i] == s + 2 #endif ) - s += strlen(++s); /* this one is ok too */ + { + ++s; + s += strlen(s); /* this one is ok too */ + } else break; } @@ -1803,8 +1828,10 @@ magic_set(SV *sv, MAGIC *mg) my_setenv("NoNe SuCh", Nullch); /* force copy of environment */ for (i = 0; PL_origenviron[i]; i++) - if (PL_origenviron[i] == s + 1) - s += strlen(++s); + if (PL_origenviron[i] == s + 1) { + ++s; + s += strlen(s); + } else break; } @@ -1851,7 +1878,6 @@ magic_mutexfree(SV *sv, MAGIC *mg) croak("panic: magic_mutexfree"); MUTEX_DESTROY(MgMUTEXP(mg)); COND_DESTROY(MgCONDP(mg)); - SvREFCNT_dec(sv); return 0; } #endif /* USE_THREADS */ diff --git a/contrib/perl5/mg.h b/contrib/perl5/mg.h index 16efdb5..ccd3acc 100644 --- a/contrib/perl5/mg.h +++ b/contrib/perl5/mg.h @@ -1,6 +1,6 @@ /* mg.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -43,3 +43,8 @@ struct magic { #define MgPV(mg,lp) (((lp = (mg)->mg_len) == HEf_SVKEY) ? \ SvPV((SV*)((mg)->mg_ptr),lp) : \ (mg)->mg_ptr) + +#define SvTIED_mg(sv,how) \ + (SvRMAGICAL(sv) ? mg_find((sv),(how)) : Null(MAGIC*)) +#define SvTIED_obj(sv,mg) \ + ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv))) diff --git a/contrib/perl5/miniperlmain.c b/contrib/perl5/miniperlmain.c index 4eb1dcd..cfbe95b 100644 --- a/contrib/perl5/miniperlmain.c +++ b/contrib/perl5/miniperlmain.c @@ -13,6 +13,12 @@ static void xs_init _((void)); static PerlInterpreter *my_perl; +#if defined (__MINT__) || defined (atarist) +/* The Atari operating system doesn't have a dynamic stack. The + stack size is determined from this value. */ +long _stksize = 64 * 1024; +#endif + int main(int argc, char **argv, char **env) { diff --git a/contrib/perl5/objXSUB.h b/contrib/perl5/objXSUB.h index d548d20..94ea6be 100644 --- a/contrib/perl5/objXSUB.h +++ b/contrib/perl5/objXSUB.h @@ -19,6 +19,8 @@ #define PL_colors pPerl->PL_colors #undef PL_colorset #define PL_colorset pPerl->PL_colorset +#undef PL_cred_mutex +#define PL_cred_mutex pPerl->PL_cred_mutex #undef PL_curcop #define PL_curcop pPerl->PL_curcop #undef PL_curpad @@ -443,6 +445,8 @@ #define PL_strchop pPerl->PL_strchop #undef PL_strtab #define PL_strtab pPerl->PL_strtab +#undef PL_strtab_mutex +#define PL_strtab_mutex pPerl->PL_strtab_mutex #undef PL_sub_generation #define PL_sub_generation pPerl->PL_sub_generation #undef PL_sublex_info @@ -902,6 +906,8 @@ #define do_vecset pPerl->Perl_do_vecset #undef do_vop #define do_vop pPerl->Perl_do_vop +#undef dofile +#define dofile pPerl->Perl_dofile #undef dowantarray #define dowantarray pPerl->Perl_dowantarray #undef dump_all @@ -966,6 +972,8 @@ #define get_opargs pPerl->Perl_get_opargs #undef get_specialsv_list #define get_specialsv_list pPerl->Perl_get_specialsv_list +#undef get_vtbl +#define get_vtbl pPerl->Perl_get_vtbl #undef gp_free #define gp_free pPerl->Perl_gp_free #undef gp_ref @@ -1569,6 +1577,8 @@ #define save_freeop pPerl->Perl_save_freeop #undef save_freepv #define save_freepv pPerl->Perl_save_freepv +#undef save_generic_svref +#define save_generic_svref pPerl->Perl_generic_save_svref #undef save_gp #define save_gp pPerl->Perl_save_gp #undef save_hash @@ -1977,8 +1987,8 @@ #define signal PerlProc_signal #define htonl PerlSock_htonl #define htons PerlSock_htons -#define ntohs PerlSock_ntohl -#define ntohl PerlSock_ntohs +#define ntohl PerlSock_ntohl +#define ntohs PerlSock_ntohs #define accept PerlSock_accept #define bind PerlSock_bind #define connect PerlSock_connect diff --git a/contrib/perl5/objpp.h b/contrib/perl5/objpp.h index e0c2f24..dd24e38 100644 --- a/contrib/perl5/objpp.h +++ b/contrib/perl5/objpp.h @@ -3,6 +3,10 @@ #undef amagic_call #define amagic_call CPerlObj::Perl_amagic_call +#undef amagic_cmp +#define amagic_cmp CPerlObj::amagic_cmp +#undef amagic_cmp_locale +#define amagic_cmp_locale CPerlObj::amagic_cmp_locale #undef Gv_AMupdate #define Gv_AMupdate CPerlObj::Perl_Gv_AMupdate #undef add_data @@ -289,6 +293,8 @@ #define do_vecset CPerlObj::Perl_do_vecset #undef do_vop #define do_vop CPerlObj::Perl_do_vop +#undef dofile +#define dofile CPerlObj::Perl_dofile #undef do_clean_all #define do_clean_all CPerlObj::do_clean_all #undef do_clean_named_objs @@ -375,6 +381,8 @@ #define get_opargs CPerlObj::Perl_get_opargs #undef get_specialsv_list #define get_specialsv_list CPerlObj::Perl_get_specialsv_list +#undef get_vtbl +#define get_vtbl CPerlObj::Perl_get_vtbl #undef getlogin #define getlogin CPerlObj::getlogin #undef gp_free @@ -1095,6 +1103,8 @@ #define save_freeop CPerlObj::Perl_save_freeop #undef save_freepv #define save_freepv CPerlObj::Perl_save_freepv +#undef save_generic_svref +#define save_generic_svref CPerlObj::Perl_save_generic_svref #undef save_gp #define save_gp CPerlObj::Perl_save_gp #undef save_hash diff --git a/contrib/perl5/op.c b/contrib/perl5/op.c index 421a093..bf944a6 100644 --- a/contrib/perl5/op.c +++ b/contrib/perl5/op.c @@ -1,6 +1,6 @@ /* op.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -35,6 +35,8 @@ Nullop ) \ : (CHECKCALL[type])((OP*)o)) +#define PAD_MAX 999999999 + static bool scalar_mod_type _((OP *o, I32 type)); #ifndef PERL_OBJECT static I32 list_assignment _((OP *o)); @@ -46,7 +48,7 @@ static OP *too_few_arguments _((OP *o, char* name)); static OP *too_many_arguments _((OP *o, char* name)); static void null _((OP* o)); static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, - CV* startcv, I32 cx_ix)); + CV* startcv, I32 cx_ix, I32 saweval, U32 flags)); static OP *newDEFSVOP _((void)); static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); #endif @@ -55,8 +57,9 @@ STATIC char* gv_ename(GV *gv) { SV* tmpsv = sv_newmortal(); + STRLEN n_a; gv_efullname3(tmpsv, gv, Nullch); - return SvPV(tmpsv,PL_na); + return SvPV(tmpsv,n_a); } STATIC OP * @@ -131,10 +134,11 @@ pad_allocmy(char *name) for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) { if ((sv = svp[off]) && sv != &PL_sv_undef - && SvIVX(sv) == 999999999 /* var is in open scope */ + && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) && strEQ(name, SvPVX(sv))) { - warn("\"my\" variable %s masks earlier declaration in same scope", name); + warn("\"my\" variable %s masks earlier declaration in same %s", + name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); break; } } @@ -152,7 +156,7 @@ pad_allocmy(char *name) PL_sv_objcount++; } av_store(PL_comppad_name, off, sv); - SvNVX(sv) = (double)999999999; + SvNVX(sv) = (double)PAD_MAX; SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ if (!PL_min_intro_pending) PL_min_intro_pending = off; @@ -165,8 +169,11 @@ pad_allocmy(char *name) return off; } +#define FINDLEX_NOSEARCH 1 /* don't search outer contexts */ + STATIC PADOFFSET -pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) +pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, + U32 flags) { dTHR; CV *cv; @@ -174,7 +181,6 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) SV *sv; register I32 i; register PERL_CONTEXT *cx; - int saweval; for (cv = startcv; cv; cv = CvOUTSIDE(cv)) { AV *curlist = CvPADLIST(cv); @@ -214,8 +220,14 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) sv_setpv(namesv, name); av_store(PL_comppad_name, newoff, namesv); SvNVX(namesv) = (double)PL_curcop->cop_seq; - SvIVX(namesv) = 999999999; /* A ref, intro immediately */ + SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */ SvFAKE_on(namesv); /* A ref, not a real var */ + if (SvOBJECT(svp[off])) { /* A typed var */ + SvOBJECT_on(namesv); + (void)SvUPGRADE(namesv, SVt_PVMG); + SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(svp[off])); + PL_sv_objcount++; + } if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(PL_compcv); @@ -227,14 +239,18 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) CV *bcv; for (bcv = startcv; bcv && bcv != cv && !CvCLONE(bcv); - bcv = CvOUTSIDE(bcv)) { + bcv = CvOUTSIDE(bcv)) + { if (CvANON(bcv)) CvCLONE_on(bcv); else { - if (PL_dowarn && !CvUNIQUE(cv)) + if (PL_dowarn + && !CvUNIQUE(bcv) && !CvUNIQUE(cv)) + { warn( "Variable \"%s\" may be unavailable", name); + } break; } } @@ -251,25 +267,28 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) } } + if (flags & FINDLEX_NOSEARCH) + return 0; + /* Nothing in current lexical context--try eval's context, if any. * This is necessary to let the perldb get at lexically scoped variables. * XXX This will also probably interact badly with eval tree caching. */ - saweval = 0; for (i = cx_ix; i >= 0; i--) { cx = &cxstack[i]; - switch (cx->cx_type) { + switch (CxTYPE(cx)) { default: if (i == 0 && saweval) { seq = cxstack[saweval].blk_oldcop->cop_seq; - return pad_findlex(name, newoff, seq, PL_main_cv, 0); + return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0); } break; case CXt_EVAL: switch (cx->blk_eval.old_op_type) { case OP_ENTEREVAL: - saweval = i; + if (CxREALEVAL(cx)) + saweval = i; break; case OP_REQUIRE: /* require must have its own scope */ @@ -285,7 +304,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) continue; } seq = cxstack[saweval].blk_oldcop->cop_seq; - return pad_findlex(name, newoff, seq, cv, i-1); + return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH); } } @@ -301,6 +320,8 @@ pad_findmy(char *name) SV *sv; SV **svp = AvARRAY(PL_comppad_name); U32 seq = PL_cop_seqmax; + PERL_CONTEXT *cx; + CV *outside; #ifdef USE_THREADS /* @@ -330,8 +351,20 @@ pad_findmy(char *name) } } + outside = CvOUTSIDE(PL_compcv); + + /* Check if if we're compiling an eval'', and adjust seq to be the + * eval's seq number. This depends on eval'' having a non-null + * CvOUTSIDE() while it is being compiled. The eval'' itself is + * identified by CvEVAL being true and CvGV being null. */ + if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) { + cx = &cxstack[cxstack_ix]; + if (CxREALEVAL(cx)) + seq = cx->blk_oldcop->cop_seq; + } + /* See if it's in a nested scope */ - off = pad_findlex(name, 0, seq, CvOUTSIDE(PL_compcv), cxstack_ix); + off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0); if (off) { /* If there is a pending local definition, this new alias must die */ if (pendoff) @@ -355,7 +388,7 @@ pad_leavemy(I32 fill) } /* "Deintroduce" my variables that are leaving with this scope. */ for (off = AvFILLp(PL_comppad_name); off > fill; off--) { - if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == 999999999) + if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX) SvIVX(sv) = PL_cop_seqmax; } } @@ -517,11 +550,15 @@ find_threadsv(char *name) if (!p) return NOT_IN_PAD; key = p - PL_threadsv_names; + MUTEX_LOCK(&thr->mutex); svp = av_fetch(thr->threadsv, key, FALSE); - if (!svp) { + if (svp) + MUTEX_UNLOCK(&thr->mutex); + else { SV *sv = NEWSV(0, 0); av_store(thr->threadsv, key, sv); thr->threadsvp = AvARRAY(thr->threadsv); + MUTEX_UNLOCK(&thr->mutex); /* * Some magic variables used to be automagically initialised * in gv_fetchpv. Those which are now per-thread magicals get @@ -538,6 +575,16 @@ find_threadsv(char *name) case '`': case '\'': PL_sawampersand = TRUE; + /* FALL THROUGH */ + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': SvREADONLY_on(sv); /* FALL THROUGH */ @@ -774,7 +821,8 @@ scalarvoid(OP *o) SV* sv; /* assumes no premature commitment */ - if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count + U8 want = o->op_flags & OPf_WANT; + if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count || o->op_type == OP_RETURN) return o; @@ -1076,6 +1124,7 @@ mod(OP *o, I32 type) dTHR; OP *kid; SV *sv; + STRLEN n_a; if (!o || PL_error_count) return o; @@ -1202,7 +1251,7 @@ mod(OP *o, I32 type) PL_modcount++; if (!type) croak("Can't localize lexical variable %s", - SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na)); + SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a)); break; #ifdef USE_THREADS @@ -1866,7 +1915,7 @@ append_list(I32 type, LISTOP *first, LISTOP *last) first->op_last = last->op_last; first->op_children += last->op_children; if (first->op_children) - last->op_flags |= OPf_KIDS; + first->op_flags |= OPf_KIDS; Safefree(last); return (OP*)first; @@ -2179,8 +2228,11 @@ pmruntime(OP *o, OP *expr, OP *repl) if (repl) { OP *curop; - if (pm->op_pmflags & PMf_EVAL) + if (pm->op_pmflags & PMf_EVAL) { curop = 0; + if (PL_curcop->cop_line < PL_multi_end) + PL_curcop->cop_line = PL_multi_end; + } #ifdef USE_THREADS else if (repl->op_type == OP_THREADSV && strchr("&`'123456789+", @@ -2339,6 +2391,7 @@ package(OP *o) sv_setpv(PL_curstname,""); PL_curstash = Nullhv; } + PL_hints |= HINT_BLOCK_SCOPE; PL_copline = NOLINE; PL_expect = XSTATE; } @@ -2351,6 +2404,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) OP *rqop; OP *imop; OP *veop; + GV *gv; if (id->op_type != OP_CONST) croak("Module name must be constant"); @@ -2402,8 +2456,21 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) newUNOP(OP_METHOD, 0, meth))); } - /* Fake up a require */ - rqop = newUNOP(OP_REQUIRE, 0, id); + /* Fake up a require, handle override, if any */ + gv = gv_fetchpv("require", FALSE, SVt_PVCV); + if (!(gv && GvIMPORTED_CV(gv))) + gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV); + + if (gv && GvIMPORTED_CV(gv)) { + rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, id, + scalar(newUNOP(OP_RV2CV, 0, + newGVOP(OP_GV, 0, + gv)))))); + } + else { + rqop = newUNOP(OP_REQUIRE, 0, id); + } /* Fake up the BEGIN {}, which does its thing immediately. */ newSUB(floor, @@ -2420,6 +2487,29 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) } OP * +dofile(OP *term) +{ + OP *doop; + GV *gv; + + gv = gv_fetchpv("do", FALSE, SVt_PVCV); + if (!(gv && GvIMPORTED_CV(gv))) + gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV); + + if (gv && GvIMPORTED_CV(gv)) { + doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, term, + scalar(newUNOP(OP_RV2CV, 0, + newGVOP(OP_GV, 0, + gv)))))); + } + else { + doop = newUNOP(OP_DOFILE, 0, scalar(term)); + } + return doop; +} + +OP * newSLICEOP(I32 flags, OP *subscript, OP *listval) { return newBINOP(OP_LSLICE, flags, @@ -2663,7 +2753,7 @@ intro_my(void) svp = AvARRAY(PL_comppad_name); for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) { if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) { - SvIVX(sv) = 999999999; /* Don't know scope end yet. */ + SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */ SvNVX(sv) = (double)PL_cop_seqmax; } } @@ -3115,13 +3205,14 @@ newLOOPEX(I32 type, OP *label) { dTHR; OP *o; + STRLEN n_a; if (type != OP_GOTO || label->op_type == OP_CONST) { /* "last()" means "last" */ if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) o = newOP(type, OPf_SPECIAL); else { o = newPVOP(type, 0, savepv(label->op_type == OP_CONST - ? SvPVx(((SVOP*)label)->op_sv, PL_na) + ? SvPVx(((SVOP*)label)->op_sv, n_a) : "")); } op_free(label); @@ -3211,7 +3302,7 @@ CV* cv; cv, (CvANON(cv) ? "ANON" : (cv == PL_main_cv) ? "MAIN" - : CvUNIQUE(outside) ? "UNIQUE" + : CvUNIQUE(cv) ? "UNIQUE" : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"), outside, (!outside ? "null" @@ -3311,7 +3402,7 @@ cv_clone2(CV *proto, CV *outside) char *name = SvPVX(namesv); /* XXX */ if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */ I32 off = pad_findlex(name, ix, SvIVX(namesv), - CvOUTSIDE(cv), cxstack_ix); + CvOUTSIDE(cv), cxstack_ix, 0, 0); if (!off) PL_curpad[ix] = SvREFCNT_inc(ppad[ix]); else if (off != ix) @@ -3375,7 +3466,11 @@ cv_clone2(CV *proto, CV *outside) CV * cv_clone(CV *proto) { - return cv_clone2(proto, CvOUTSIDE(proto)); + CV *cv; + MUTEX_LOCK(&PL_cred_mutex); /* XXX create separate mutex */ + cv = cv_clone2(proto, CvOUTSIDE(proto)); + MUTEX_UNLOCK(&PL_cred_mutex); /* XXX create separate mutex */ + return cv; } void @@ -3451,10 +3546,11 @@ CV * newSUB(I32 floor, OP *o, OP *proto, OP *block) { dTHR; - char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch; + STRLEN n_a; + char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV); - char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch; + char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch; register CV *cv=0; I32 ix; @@ -3536,9 +3632,10 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) CvSTASH(cv) = PL_curstash; #ifdef USE_THREADS CvOWNER(cv) = 0; - if (!CvMUTEXP(cv)) + if (!CvMUTEXP(cv)) { New(666, CvMUTEXP(cv), 1, perl_mutex); - MUTEX_INIT(CvMUTEXP(cv)); + MUTEX_INIT(CvMUTEXP(cv)); + } #endif /* USE_THREADS */ if (ps) @@ -3558,7 +3655,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) else { /* force display of errors found but not reported */ sv_catpv(ERRSV, not_safe); - croak("%s", SvPVx(ERRSV, PL_na)); + croak("%s", SvPVx(ERRSV, n_a)); } } } @@ -3683,6 +3780,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) return cv; } +/* XXX unsafe for threads if eval_owner isn't held */ void newCONSTSUB(HV *stash, char *name, SV *sv) { @@ -3729,7 +3827,8 @@ newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename) && HvNAME(GvSTASH(CvGV(cv))) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { line_t oldline = PL_curcop->cop_line; - PL_curcop->cop_line = PL_copline; + if (PL_copline != NOLINE) + PL_curcop->cop_line = PL_copline; warn("Subroutine %s redefined",name); PL_curcop->cop_line = oldline; } @@ -3781,6 +3880,7 @@ newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename) if (!PL_initav) PL_initav = newAV(); av_push(PL_initav, (SV *)cv); + GvCV(gv) = 0; } } else @@ -3797,9 +3897,10 @@ newFORM(I32 floor, OP *o, OP *block) char *name; GV *gv; I32 ix; + STRLEN n_a; if (o) - name = SvPVx(cSVOPo->op_sv, PL_na); + name = SvPVx(cSVOPo->op_sv, n_a); else name = "STDOUT"; gv = gv_fetchpv(name,TRUE, SVt_PVFM); @@ -3861,7 +3962,7 @@ oopsAV(OP *o) case OP_PADSV: o->op_type = OP_PADAV; o->op_ppaddr = ppaddr[OP_PADAV]; - return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV); + return ref(o, OP_RV2AV); case OP_RV2SV: o->op_type = OP_RV2AV; @@ -3884,7 +3985,7 @@ oopsHV(OP *o) case OP_PADAV: o->op_type = OP_PADHV; o->op_ppaddr = ppaddr[OP_PADHV]; - return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV); + return ref(o, OP_RV2HV); case OP_RV2SV: case OP_RV2AV: @@ -3914,7 +4015,7 @@ newAVREF(OP *o) OP * newGVREF(I32 type, OP *o) { - if (type == OP_MAPSTART) + if (type == OP_MAPSTART || type == OP_GREPSTART) return newUNOP(OP_NULL, 0, o); return ref(newUNOP(OP_RV2GV, OPf_REF, o), type); } @@ -4145,8 +4246,48 @@ ck_rvconst(register OP *o) char *name; int iscv; GV *gv; + SV *kidsv = kid->op_sv; + STRLEN n_a; + + /* Is it a constant from cv_const_sv()? */ + if (SvROK(kidsv) && SvREADONLY(kidsv)) { + SV *rsv = SvRV(kidsv); + int svtype = SvTYPE(rsv); + char *badtype = Nullch; + + switch (o->op_type) { + case OP_RV2SV: + if (svtype > SVt_PVMG) + badtype = "a SCALAR"; + break; + case OP_RV2AV: + if (svtype != SVt_PVAV) + badtype = "an ARRAY"; + break; + case OP_RV2HV: + if (svtype != SVt_PVHV) { + if (svtype == SVt_PVAV) { /* pseudohash? */ + SV **ksv = av_fetch((AV*)rsv, 0, FALSE); + if (ksv && SvROK(*ksv) + && SvTYPE(SvRV(*ksv)) == SVt_PVHV) + { + break; + } + } + badtype = "a HASH"; + } + break; + case OP_RV2CV: + if (svtype != SVt_PVCV) + badtype = "a CODE"; + break; + } + if (badtype) + croak("Constant is not %s reference", badtype); + return o; + } + name = SvPV(kidsv, n_a); - name = SvPV(kid->op_sv, PL_na); if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) { char *badthing = Nullch; switch (o->op_type) { @@ -4209,8 +4350,9 @@ ck_ftst(OP *o) SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { + STRLEN n_a; OP *newop = newGVOP(type, OPf_REF, - gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO)); + gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO)); op_free(o); return newop; } @@ -4245,6 +4387,7 @@ ck_fun(OP *o) } if (o->op_flags & OPf_KIDS) { + STRLEN n_a; tokid = &cLISTOPo->op_first; kid = cLISTOPo->op_first; if (kid->op_type == OP_PUSHMARK || @@ -4274,7 +4417,7 @@ ck_fun(OP *o) case OA_AVREF: if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na); + char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVAV) )); if (PL_dowarn) @@ -4292,7 +4435,7 @@ ck_fun(OP *o) case OA_HVREF: if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na); + char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVHV) )); if (PL_dowarn) @@ -4323,11 +4466,15 @@ ck_fun(OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { OP *newop = newGVOP(OP_GV, 0, - gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE, + gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE, SVt_PVIO) ); op_free(kid); kid = newop; } + else if (kid->op_type == OP_READLINE) { + /* neophyte patrol: open(), close() etc. */ + bad_type(numargs, "HANDLE", op_desc[o->op_type], kid); + } else { kid->op_sibling = 0; kid = newUNOP(OP_RV2GV, 0, scalar(kid)); @@ -4376,7 +4523,9 @@ ck_glob(OP *o) gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); if (gv && GvIMPORTED_CV(gv)) { +#ifndef PERL_OBJECT static int glob_index; +#endif append_elem(OP_GLOB, o, newSVOP(OP_CONST, 0, newSViv(glob_index++))); @@ -4455,6 +4604,8 @@ ck_index(OP *o) { if (o->op_flags & OPf_KIDS) { OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ + if (kid) + kid = kid->op_sibling; /* get past "big" */ if (kid && kid->op_type == OP_CONST) fbm_compile(((SVOP*)kid)->op_sv, 0); } @@ -4661,6 +4812,11 @@ ck_sort(OP *o) if (o->op_flags & OPf_STACKED) { OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; + + if (o->op_type == OP_SORT) { + GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); + GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV)); + } kid = kUNOP->op_first; /* get past rv2gv */ if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) { @@ -4693,7 +4849,9 @@ ck_sort(OP *o) kid->op_next = k; o->op_flags |= OPf_SPECIAL; } - } + else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV) + null(cLISTOPo->op_first->op_sibling); + } return o; } @@ -4762,6 +4920,7 @@ ck_subr(OP *o) GV *namegv = 0; int optional = 0; I32 arg = 0; + STRLEN n_a; for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ; if (cvop->op_type == OP_RV2CV) { @@ -4773,7 +4932,7 @@ ck_subr(OP *o) cv = GvCVu(tmpop->op_sv); if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) { namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv); - proto = SvPV((SV*)cv, PL_na); + proto = SvPV((SV*)cv, n_a); } } } @@ -4806,19 +4965,13 @@ ck_subr(OP *o) bad_type(arg, "block", gv_ename(namegv), o2); break; case '*': + /* '*' allows any scalar type, including bareword */ proto++; arg++; if (o2->op_type == OP_RV2GV) - goto wrapref; - { - OP* kid = o2; - OP* sib = kid->op_sibling; - kid->op_sibling = 0; - o2 = newUNOP(OP_RV2GV, 0, kid); - o2->op_sibling = sib; - prev->op_sibling = o2; - } - goto wrapref; + goto wrapref; /* autoconvert GLOB -> GLOBref */ + scalar(o2); + break; case '\\': proto++; arg++; @@ -4865,7 +5018,7 @@ ck_subr(OP *o) default: oops: croak("Malformed prototype for %s: %s", - gv_ename(namegv), SvPV((SV*)cv, PL_na)); + gv_ename(namegv), SvPV((SV*)cv, n_a)); } } else @@ -4909,6 +5062,7 @@ peep(register OP *o) { dTHR; register OP* oldop = 0; + STRLEN n_a; if (!o || o->op_seq) return; ENTER; @@ -4997,24 +5151,6 @@ peep(register OP *o) o->op_seq = PL_op_seqmax++; break; - case OP_PADAV: - if (o->op_next->op_type == OP_RV2AV - && (o->op_next->op_flags & OPf_REF)) - { - null(o->op_next); - o->op_next = o->op_next->op_next; - } - break; - - case OP_PADHV: - if (o->op_next->op_type == OP_RV2HV - && (o->op_next->op_flags & OPf_REF)) - { - null(o->op_next); - o->op_next = o->op_next->op_next; - } - break; - case OP_MAPWHILE: case OP_GREPWHILE: case OP_AND: @@ -5088,7 +5224,7 @@ peep(register OP *o) indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); if (!indsvp) { croak("No such field \"%s\" in variable %s of type %s", - key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname))); + key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); } ind = SvIV(*indsvp); if (ind < 1) diff --git a/contrib/perl5/op.h b/contrib/perl5/op.h index 75e674e..d0b56f3 100644 --- a/contrib/perl5/op.h +++ b/contrib/perl5/op.h @@ -1,6 +1,6 @@ /* op.h * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/opcode.h b/contrib/perl5/opcode.h index 8f4f00b..81e1690 100644 --- a/contrib/perl5/opcode.h +++ b/contrib/perl5/opcode.h @@ -891,7 +891,7 @@ EXT char *op_desc[] = { "line sequence", "next statement", "debug next statement", - "unstack", + "iteration finalizer", "block entry", "block exit", "block", @@ -2320,7 +2320,7 @@ EXT U32 opargs[] = { 0x00002505, /* anonhash */ 0x02993501, /* splice */ 0x0002351d, /* push */ - 0x00003c14, /* pop */ + 0x00003c04, /* pop */ 0x00003c04, /* shift */ 0x0002351d, /* unshift */ 0x0002d501, /* sort */ @@ -2385,7 +2385,7 @@ EXT U32 opargs[] = { 0x09116504, /* sysopen */ 0x00116504, /* sysseek */ 0x0917651d, /* sysread */ - 0x0911651d, /* syswrite */ + 0x0991651d, /* syswrite */ 0x0911651d, /* send */ 0x0117651d, /* recv */ 0x0000ec14, /* eof */ diff --git a/contrib/perl5/opcode.pl b/contrib/perl5/opcode.pl index f2ed795..cec51c0 100755 --- a/contrib/perl5/opcode.pl +++ b/contrib/perl5/opcode.pl @@ -432,7 +432,7 @@ anonhash anonymous hash ck_fun ms@ L splice splice ck_fun m@ A S? S? L push push ck_fun imst@ A L -pop pop ck_shift si% A +pop pop ck_shift s% A shift shift ck_shift s% A unshift unshift ck_fun imst@ A L sort sort ck_sort m@ C? L @@ -470,7 +470,7 @@ reset reset ck_fun is% S? lineseq line sequence ck_null @ nextstate next statement ck_null s; dbstate debug next statement ck_null s; -unstack unstack ck_null s0 +unstack iteration finalizer ck_null s0 enter block entry ck_null 0 leave block exit ck_null @ scope block ck_null @ @@ -519,7 +519,7 @@ print print ck_listiob ims@ F? L sysopen sysopen ck_fun s@ F S S S? sysseek sysseek ck_fun s@ F S S sysread sysread ck_fun imst@ F R S S? -syswrite syswrite ck_fun imst@ F S S S? +syswrite syswrite ck_fun imst@ F S S? S? send send ck_fun imst@ F S S S? recv recv ck_fun imst@ F R S S diff --git a/contrib/perl5/patchlevel.h b/contrib/perl5/patchlevel.h index 2245b1f..cbf0b1d 100644 --- a/contrib/perl5/patchlevel.h +++ b/contrib/perl5/patchlevel.h @@ -1,7 +1,7 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 5 #undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */ -#define SUBVERSION 2 +#define SUBVERSION 3 /* local_patches -- list of locally applied less-than-subversion patches. diff --git a/contrib/perl5/perl.c b/contrib/perl5/perl.c index e76d83a..cc1f7ed 100644 --- a/contrib/perl5/perl.c +++ b/contrib/perl5/perl.c @@ -1,6 +1,6 @@ /* perl.c * - * Copyright (c) 1987-1998 Larry Wall + * Copyright (c) 1987-1999 Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -64,6 +64,9 @@ static void my_exit_jump _((void)) __attribute__((noreturn)); static void nuke_stacks _((void)); static void open_script _((char *, bool, SV *, int *fd)); static void usage _((char *)); +#ifdef IAMSUID +static int fd_on_nosuid_fs _((int)); +#endif static void validate_suid _((char *, char*, int)); static I32 read_e_script _((int idx, SV *buf_sv, int maxlen)); #endif @@ -126,6 +129,7 @@ perl_construct(register PerlInterpreter *sv_interp) croak("panic: pthread_key_create"); #endif MUTEX_INIT(&PL_sv_mutex); + MUTEX_INIT(&PL_cred_mutex); /* * Safe to use basic SV functions from now on (though * not things like mortals or tainting yet). @@ -551,9 +555,14 @@ perl_destruct(register PerlInterpreter *sv_interp) DEBUG_P(debprofdump()); #ifdef USE_THREADS + MUTEX_DESTROY(&PL_strtab_mutex); MUTEX_DESTROY(&PL_sv_mutex); + MUTEX_DESTROY(&PL_cred_mutex); MUTEX_DESTROY(&PL_eval_mutex); COND_DESTROY(&PL_eval_cond); +#ifdef EMULATE_ATOMIC_REFCOUNTS + MUTEX_DESTROY(&PL_svref_mutex); +#endif /* EMULATE_ATOMIC_REFCOUNTS */ /* As the penultimate thing, free the non-arena SV for thrsv */ Safefree(SvPVX(PL_thrsv)); @@ -719,6 +728,9 @@ setuid perl scripts securely.\n"); s = argv[0]+1; reswitch: switch (*s) { +#ifndef PERL_STRICT_CR + case '\r': +#endif case ' ': case '0': case 'F': @@ -1138,6 +1150,7 @@ CV* perl_get_cv(char *name, I32 create) { GV* gv = gv_fetchpv(name, create, SVt_PVCV); + /* XXX unsafe for threads if eval_owner isn't held */ if (create && !GvCVu(gv)) return newSUB(start_subparse(FALSE, 0), newSVOP(OP_CONST, 0, newSVpv(name,0)), @@ -1440,8 +1453,10 @@ perl_eval_pv(char *p, I32 croak_on_error) sv = POPs; PUTBACK; - if (croak_on_error && SvTRUE(ERRSV)) - croak(SvPVx(ERRSV, PL_na)); + if (croak_on_error && SvTRUE(ERRSV)) { + STRLEN n_a; + croak(SvPVx(ERRSV, n_a)); + } return sv; } @@ -1713,7 +1728,7 @@ moreswitches(char *s) LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : ""); #endif - printf("\n\nCopyright 1987-1998, Larry Wall\n"); + printf("\n\nCopyright 1987-1999, Larry Wall\n"); #ifdef MSDOS printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); #endif @@ -1737,6 +1752,12 @@ moreswitches(char *s) #ifdef OEMVS printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n"); #endif +#ifdef __VOS__ + printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n"); +#endif +#ifdef __MINT__ + printf("MiNT port by Guido Flohr, 1997\n"); +#endif #ifdef BINARY_BUILD_NOTICE BINARY_BUILD_NOTICE; #endif @@ -1758,7 +1779,7 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n"); break; case '-': case 0: -#ifdef WIN32 +#if defined(WIN32) || !defined(PERL_STRICT_CR) case '\r': #endif case '\n': @@ -1886,6 +1907,9 @@ init_main_stash(void) about not iterating on it, and not adding tie magic to it. It is properly deallocated in perl_destruct() */ PL_strtab = newHV(); +#ifdef USE_THREADS + MUTEX_INIT(&PL_strtab_mutex); +#endif HvSHAREKEYS_off(PL_strtab); /* mandatory */ hv_ksplit(PL_strtab, 512); @@ -1913,7 +1937,7 @@ init_main_stash(void) PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV)); PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV)); /* We must init $/ before switches are processed. */ - sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1); + sv_setpvn(perl_get_sv("/", TRUE), "\n", 1); } STATIC void @@ -2056,6 +2080,71 @@ sed %s -e \"/^[^#]/b\" \ } } +#ifdef IAMSUID +static int +fd_on_nosuid_fs(int fd) +{ + int on_nosuid = 0; + int check_okay = 0; +/* + * Preferred order: fstatvfs(), fstatfs(), getmntent(). + * fstatvfs() is UNIX98. + * fstatfs() is BSD. + * getmntent() is O(number-of-mounted-filesystems) and can hang. + */ + +# ifdef HAS_FSTATVFS + struct statvfs stfs; + check_okay = fstatvfs(fd, &stfs) == 0; + on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID); +# else +# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS) + struct statfs stfs; + check_okay = fstatfs(fd, &stfs) == 0; +# undef PERL_MOUNT_NOSUID +# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) +# define PERL_MOUNT_NOSUID MNT_NOSUID +# endif +# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) +# define PERL_MOUNT_NOSUID MS_NOSUID +# endif +# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) +# define PERL_MOUNT_NOSUID M_NOSUID +# endif +# ifdef PERL_MOUNT_NOSUID + on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID); +# endif +# else +# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID) + FILE *mtab = fopen("/etc/mtab", "r"); + struct mntent *entry; + struct stat stb, fsb; + + if (mtab && (fstat(fd, &stb) == 0)) { + while (entry = getmntent(mtab)) { + if (stat(entry->mnt_dir, &fsb) == 0 + && fsb.st_dev == stb.st_dev) + { + /* found the filesystem */ + check_okay = 1; + if (hasmntopt(entry, MNTOPT_NOSUID)) + on_nosuid = 1; + break; + } /* A single fs may well fail its stat(). */ + } + } + if (mtab) + fclose(mtab); +# endif /* mntent */ +# endif /* statfs */ +# endif /* statvfs */ + if (!check_okay) + croak("Can't check filesystem of script \"%s\" for nosuid", + PL_origfilename); + return on_nosuid; +} +#endif /* IAMSUID */ + STATIC void validate_suid(char *validarg, char *scriptname, int fdscript) { @@ -2089,6 +2178,7 @@ validate_suid(char *validarg, char *scriptname, int fdscript) croak("Can't stat script \"%s\"",PL_origfilename); if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) { I32 len; + STRLEN n_a; #ifdef IAMSUID #ifndef HAS_SETREUID @@ -2123,6 +2213,10 @@ validate_suid(char *validarg, char *scriptname, int fdscript) croak("Can't swap uid and euid"); /* really paranoid */ if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0) croak("Permission denied"); /* testing full pathname here */ +#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK) + if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) + croak("Permission denied"); +#endif if (tmpstatbuf.st_dev != PL_statbuf.st_dev || tmpstatbuf.st_ino != PL_statbuf.st_ino) { (void)PerlIO_close(PL_rsfp); @@ -2161,12 +2255,12 @@ validate_suid(char *validarg, char *scriptname, int fdscript) PL_doswitches = FALSE; /* -s is insecure in suid */ PL_curcop->cop_line++; if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch || - strnNE(SvPV(PL_linestr,PL_na),"#!",2) ) /* required even on Sys V */ + strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */ croak("No #! line"); - s = SvPV(PL_linestr,PL_na)+2; + s = SvPV(PL_linestr,n_a)+2; if (*s == ' ') s++; while (!isSPACE(*s)) s++; - for (s2 = s; (s2 > SvPV(PL_linestr,PL_na)+2 && + for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 && (isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ; if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */ croak("Not a perl script"); @@ -2705,7 +2799,7 @@ incpush(char *p, int addsubdirs) char *unix; STRLEN len; - if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) { + if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) { len = strlen(unix); while (unix[len-1] == '/') len--; /* Cosmetic */ sv_usepvn(libdir,unix,len); @@ -2713,7 +2807,7 @@ incpush(char *p, int addsubdirs) else PerlIO_printf(PerlIO_stderr(), "Failed to unixify @INC element \"%s\"\n", - SvPV(libdir,PL_na)); + SvPV(libdir,len)); #endif /* .../archname/version if -d .../archname/version/auto */ sv_setsv(subdir, libdir); diff --git a/contrib/perl5/perl.h b/contrib/perl5/perl.h index 6a063b8..cab0bbc 100644 --- a/contrib/perl5/perl.h +++ b/contrib/perl5/perl.h @@ -1,6 +1,6 @@ /* perl.h * - * Copyright (c) 1987-1997, Larry Wall + * Copyright (c) 1987-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -209,6 +209,12 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # define LIBERAL 1 #endif +#if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90 +#define ASCIIish +#else +#undef ASCIIish +#endif + /* * The following contortions are brought to you on behalf of all the * standards, semi-standards, de facto standards, not-so-de-facto standards @@ -244,7 +250,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #define TAINT_NOT (PL_tainted = FALSE) #define TAINT_IF(c) if (c) { PL_tainted = TRUE; } #define TAINT_ENV() if (PL_tainting) { taint_env(); } -#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(no_security, s); } +#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); } /* XXX All process group stuff is handled in pp_sys.c. Should these defines move there? If so, I could simplify this a lot. --AD 9/96. @@ -585,7 +591,7 @@ Free_t Perl_free _((Malloc_t where)); set_vaxc_errno(vmserrcode); \ } STMT_END #else -# define SETERRNO(errcode,vmserrcode) errno = (errcode) +# define SETERRNO(errcode,vmserrcode) (errno = (errcode)) #endif #ifdef USE_THREADS @@ -1109,7 +1115,11 @@ typedef I32 (*filter_t) _((int, SV *, int)); # if defined(MPE) # include "mpeix/mpeixish.h" # else -# include "unixish.h" +# if defined(__VOS__) +# include "vosish.h" +# else +# include "unixish.h" +# endif # endif # endif # endif @@ -1140,11 +1150,22 @@ typedef I32 (*filter_t) _((int, SV *, int)); # ifdef OS2 # include "os2thread.h" # else -# include -typedef pthread_t perl_os_thread; -typedef pthread_mutex_t perl_mutex; -typedef pthread_cond_t perl_cond; -typedef pthread_key_t perl_key; +# ifdef I_MACH_CTHREADS +# include +# ifdef NeXT +# define MUTEX_INIT_CALLS_MALLOC +# endif +typedef cthread_t perl_os_thread; +typedef mutex_t perl_mutex; +typedef condition_t perl_cond; +typedef void * perl_key; +# else /* Posix threads */ +# include +typedef pthread_t perl_os_thread; +typedef pthread_mutex_t perl_mutex; +typedef pthread_cond_t perl_cond; +typedef pthread_key_t perl_key; +# endif /* I_MACH_CTHREADS */ # endif /* OS2 */ # endif /* WIN32 */ # endif /* FAKE_THREADS */ @@ -1360,7 +1381,7 @@ EXT char Error[1]; # define HAS_VTOHS # define HAS_HTOVL # define HAS_HTOVS -# if BYTEORDER == 0x4321 +# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 # define vtohl(x) ((((x)&0xFF)<<24) \ +(((x)>>24)&0xFF) \ +(((x)&0x0000FF00)<<8) \ @@ -1545,7 +1566,7 @@ char *getlogin _((void)); #define UNLINK unlnk I32 unlnk _((char*)); #else -#define UNLINK unlink +#define UNLINK PerlLIO_unlink #endif #ifndef HAS_SETREUID @@ -1585,8 +1606,22 @@ typedef Sighandler_t Sigsave_t; #endif #ifdef MYMALLOC -# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) -# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) +# ifdef MUTEX_INIT_CALLS_MALLOC +# define MALLOC_INIT \ + STMT_START { \ + PL_malloc_mutex = NULL; \ + MUTEX_INIT(&PL_malloc_mutex); \ + } STMT_END +# define MALLOC_TERM \ + STMT_START { \ + perl_mutex tmp = PL_malloc_mutex; \ + PL_malloc_mutex = NULL; \ + MUTEX_DESTROY(&tmp); \ + } STMT_END +# else +# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) +# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) +# endif #else # define MALLOC_INIT # define MALLOC_TERM @@ -1903,6 +1938,39 @@ typedef enum { XTERMBLOCK } expectation; +enum { /* pass one of these to get_vtbl */ + want_vtbl_sv, + want_vtbl_env, + want_vtbl_envelem, + want_vtbl_sig, + want_vtbl_sigelem, + want_vtbl_pack, + want_vtbl_packelem, + want_vtbl_dbline, + want_vtbl_isa, + want_vtbl_isaelem, + want_vtbl_arylen, + want_vtbl_glob, + want_vtbl_mglob, + want_vtbl_nkeys, + want_vtbl_taint, + want_vtbl_substr, + want_vtbl_vec, + want_vtbl_pos, + want_vtbl_bm, + want_vtbl_fm, + want_vtbl_uvar, + want_vtbl_defelem, + want_vtbl_regexp, + want_vtbl_collxfrm, + want_vtbl_amagic, + want_vtbl_amagicelem +#ifdef USE_THREADS + , + want_vtbl_mutex +#endif +}; + /* Note: the lowest 8 bits are reserved for stuffing into op->op_private */ @@ -2075,6 +2143,50 @@ typedef void *Thread; #endif #ifdef PERL_OBJECT +/* from perly.c */ +#undef yydebug +#undef yynerrs +#undef yyerrflag +#undef yychar +#undef yyssp +#undef yyvsp +#undef yyval +#undef yylval +#define yydebug PL_yydebug +#define yynerrs PL_yynerrs +#define yyerrflag PL_yyerrflag +#define yychar PL_yychar +#define yyssp PL_yyssp +#define yyvsp PL_yyvsp +#define yyval PL_yyval +#define yylval PL_yylval +PERLVAR(yydebug, int) +PERLVAR(yynerrs, int) +PERLVAR(yyerrflag, int) +PERLVAR(yychar, int) +PERLVAR(yyssp, short*) +PERLVAR(yyvsp, YYSTYPE*) +PERLVAR(yyval, YYSTYPE) +PERLVAR(yylval, YYSTYPE) + +#define efloatbuf PL_efloatbuf +#define efloatsize PL_efloatsize +PERLVAR(efloatbuf, char *) +PERLVAR(efloatsize, STRLEN) + +#define glob_index PL_glob_index +#define srand_called PL_srand_called +#define uudmap PL_uudmap +#define bitcount PL_bitcount +#define filter_debug PL_filter_debug +PERLVAR(glob_index, int) +PERLVAR(srand_called, bool) +PERLVAR(uudmap[256], char) +PERLVAR(bitcount, char*) +PERLVAR(filter_debug, int) +PERLVAR(super_bufptr, char*) /* PL_bufptr that was */ +PERLVAR(super_bufend, char*) /* PL_bufend that was */ + /* * The following is a buffer where new variables must * be defined to maintain binary compatibility with PERL_OBJECT @@ -2449,4 +2561,18 @@ enum { # endif #endif +#ifdef IAMSUID + +#ifdef I_SYS_STATVFS +# include /* for f?statvfs() */ +#endif +#ifdef I_SYS_MOUNT +# include /* for *BSD f?statfs() */ +#endif +#ifdef I_MNTENT +# include /* for getmntent() */ +#endif + +#endif /* IAMSUID */ + #endif /* Include guard */ diff --git a/contrib/perl5/perl_exp.SH b/contrib/perl5/perl_exp.SH index b8b2907..d8ae949 100755 --- a/contrib/perl5/perl_exp.SH +++ b/contrib/perl5/perl_exp.SH @@ -49,8 +49,10 @@ rm -f perl.exp echo "#!" > perl.exp # No compat3 since 5.004_50. -# perlio.sym will added below if needed. -syms="global.sym interp.sym thread.sym" +# No interp.sym since 5.005_03. +# perlio.sym will added later if needed. + +syms="global.sym thread.sym" sed -n '/^[A-Za-z]/ s/^/Perl_/p' $syms >> perl.exp @@ -59,7 +61,7 @@ sed -n 's/^PERLVAR.*(I\([^[,]*\).*/PL_\1/p' intrpvar.h >> perl.exp sed -n 's/^PERLVAR.*(T\([^[,]*\).*/PL_\1/p' thrdvar.h >> perl.exp # -# If we use the PerlIO abstraction layer, add its symbols +# If we use the PerlIO abstraction layer, add its symbols. # if [ $useperlio = "define" ] @@ -72,7 +74,7 @@ fi # not actually be defined, but there's no harm in that). # -cat <> perl.exp +cat >> perl.exp <>perl.exp <>perl.exp <yyvs = yyvs = - (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); + (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); ysave->yyss = yyss = - (short*)realloc((char*)yyss,yystacksize * sizeof(short)); + (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short)); if (!yyvs || !yyss) goto yyoverflow; yyssp = yyss + yyps_index; @@ -1460,9 +1462,9 @@ yyinrecovery: int yyps_index = (yyssp - yyss); int yypv_index = (yyvsp - yyvs); yystacksize += YYSTACKSIZE; - ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs, + ysave->yyvs = yyvs = (YYSTYPE*)PerlMem_realloc((char*)yyvs, yystacksize * sizeof(YYSTYPE)); - ysave->yyss = yyss = (short*)realloc((char*)yyss, + ysave->yyss = yyss = (short*)PerlMem_realloc((char*)yyss, yystacksize * sizeof(short)); if (!yyvs || !yyss) goto yyoverflow; @@ -1772,10 +1774,10 @@ case 56: break; case 57: #line 302 "perly.y" -{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na); +{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - CvUNIQUE_on(PL_compcv); + CvSPECIAL_on(PL_compcv); yyval.opval = yyvsp[0].opval; } break; case 58: @@ -1800,7 +1802,7 @@ case 63: break; case 64: #line 325 "perly.y" -{ CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ } +{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 65: #line 327 "perly.y" @@ -2109,7 +2111,7 @@ case 134: break; case 135: #line 515 "perly.y" -{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } +{ yyval.opval = dofile(yyvsp[0].opval); } break; case 136: #line 517 "perly.y" @@ -2346,9 +2348,9 @@ break; int yypv_index = (yyvsp - yyvs); yystacksize += YYSTACKSIZE; ysave->yyvs = yyvs = - (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); + (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); ysave->yyss = yyss = - (short*)realloc((char*)yyss,yystacksize * sizeof(short)); + (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short)); if (!yyvs || !yyss) goto yyoverflow; yyssp = yyss + yyps_index; diff --git a/contrib/perl5/perly.y b/contrib/perl5/perly.y index e016cf4..41c6acd 100644 --- a/contrib/perl5/perly.y +++ b/contrib/perl5/perly.y @@ -1,6 +1,6 @@ /* perly.y * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -299,10 +299,10 @@ startformsub: /* NULL */ /* start a format subroutine scope */ { $$ = start_subparse(TRUE, 0); } ; -subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, PL_na); +subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv, n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - CvUNIQUE_on(PL_compcv); + CvSPECIAL_on(PL_compcv); $$ = $1; } ; @@ -322,7 +322,7 @@ package : PACKAGE WORD ';' ; use : USE startsub - { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ } + { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } WORD WORD listexpr ';' { utilize($1, $2, $4, $5, $6); } ; @@ -512,7 +512,7 @@ term : term ASSIGNOP term { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, $3, scalar($2))); } | DO term %prec UNIOP - { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); } + { $$ = dofile($2); } | DO block %prec '(' { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); } | DO WORD '(' ')' diff --git a/contrib/perl5/perly_c.diff b/contrib/perl5/perly_c.diff index aa0555b..5107901 100644 --- a/contrib/perl5/perly_c.diff +++ b/contrib/perl5/perly_c.diff @@ -1,23 +1,12 @@ -*** perly.c.orig Tue Jul 28 15:02:41 1998 ---- perly.c Tue Jul 28 15:14:54 1998 +*** perly.c.old Wed Jan 06 20:03:41 1999 +--- perly.c Wed Jan 06 18:51:20 1999 *************** -*** 7,11 **** ---- 7,19 ---- +*** 7,86 **** #include "perl.h" -+ #ifdef PERL_OBJECT static void -+ Dep(CPerlObj *pPerl) -+ { -+ pPerl->deprecate("\"do\" to call subroutines"); -+ } -+ #define dep() Dep(this) -+ #else -+ static void dep(void) { -*************** -*** 12,86 **** deprecate("\"do\" to call subroutines"); } @@ -93,7 +82,20 @@ - #define ARROW 314 #define YYERRCODE 256 short yylhs[] = { -1, ---- 20,26 ---- +--- 7,26 ---- + #include "perl.h" + ++ #ifdef PERL_OBJECT + static void ++ Dep(CPerlObj *pPerl) ++ { ++ pPerl->deprecate("\"do\" to call subroutines"); ++ } ++ #define dep() Dep(this) ++ #else ++ static void + dep(void) + { deprecate("\"do\" to call subroutines"); } + #endif @@ -102,12 +104,20 @@ #define YYERRCODE 256 short yylhs[] = { -1, *************** +*** 1337,1340 **** +--- 1277,1281 ---- + #endif + #endif ++ #ifndef PERL_OBJECT + int yydebug; + int yynerrs; +*************** *** 1345,1365 **** YYSTYPE yyval; YYSTYPE yylval; -- short yyss[YYSTACKSIZE]; -- YYSTYPE yyvs[YYSTACKSIZE]; -- #define yystacksize YYSTACKSIZE +! short yyss[YYSTACKSIZE]; +! YYSTYPE yyvs[YYSTACKSIZE]; +! #define yystacksize YYSTACKSIZE #line 643 "perly.y" /* PROGRAM */ ! #line 1353 "y.tab.c" @@ -124,9 +134,10 @@ if (yys = getenv("YYDEBUG")) { ---- 1285,1349 ---- +--- 1286,1351 ---- YYSTYPE yyval; YYSTYPE yylval; +! #endif #line 643 "perly.y" /* PROGRAM */ ! #line 1353 "perly.c" @@ -176,7 +187,7 @@ extern char *getenv(); + #endif + #endif - ++ + struct ysv *ysave; + New(73, ysave, 1, struct ysv); + SAVEDESTRUCTOR(yydestruct, ysave); @@ -186,13 +197,13 @@ + ysave->oldyychar = yychar; + ysave->oldyyval = yyval; + ysave->oldyylval = yylval; -+ + + #if YYDEBUG if (yys = getenv("YYDEBUG")) { *************** *** 1374,1377 **** ---- 1358,1371 ---- +--- 1360,1373 ---- yychar = (-1); + /* @@ -214,33 +225,30 @@ ! printf("yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } ---- 1383,1387 ---- +--- 1385,1389 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } *************** -*** 1399,1403 **** +*** 1399,1408 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif ---- 1393,1397 ---- - #if YYDEBUG - if (yydebug) -! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n", - yystate, yytable[yyn]); - #endif -*************** -*** 1404,1408 **** if (yyssp >= yyss + yystacksize - 1) { ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ---- 1398,1416 ---- +--- 1395,1418 ---- + #if YYDEBUG + if (yydebug) +! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n", + yystate, yytable[yyn]); + #endif if (yyssp >= yyss + yystacksize - 1) { ! /* @@ -251,9 +259,9 @@ ! int yypv_index = (yyvsp - yyvs); ! yystacksize += YYSTACKSIZE; ! ysave->yyvs = yyvs = -! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); +! (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); ! ysave->yyss = yyss = -! (short*)realloc((char*)yyss,yystacksize * sizeof(short)); +! (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short)); ! if (!yyvs || !yyss) ! goto yyoverflow; ! yyssp = yyss + yyps_index; @@ -272,7 +280,7 @@ ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ---- 1448,1472 ---- +--- 1450,1474 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, @@ -288,9 +296,9 @@ ! int yyps_index = (yyssp - yyss); ! int yypv_index = (yyvsp - yyvs); ! yystacksize += YYSTACKSIZE; -! ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs, +! ysave->yyvs = yyvs = (YYSTYPE*)PerlMem_realloc((char*)yyvs, ! yystacksize * sizeof(YYSTYPE)); -! ysave->yyss = yyss = (short*)realloc((char*)yyss, +! ysave->yyss = yyss = (short*)PerlMem_realloc((char*)yyss, ! yystacksize * sizeof(short)); ! if (!yyvs || !yyss) ! goto yyoverflow; @@ -306,7 +314,7 @@ ! *yyssp); #endif if (yyssp <= yyss) goto yyabort; ---- 1478,1484 ---- +--- 1480,1486 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, @@ -322,7 +330,7 @@ ! yystate, yychar, yys); } #endif ---- 1497,1503 ---- +--- 1499,1505 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, @@ -337,7 +345,7 @@ ! printf("yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif ---- 1508,1512 ---- +--- 1510,1514 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n", @@ -350,7 +358,7 @@ ! #line 2270 "y.tab.c" } yyssp -= yym; ---- 2292,2296 ---- +--- 2294,2298 ---- { yyval.opval = yyvsp[0].opval; } break; ! #line 2270 "perly.c" @@ -364,7 +372,7 @@ ! state %d\n", YYFINAL); #endif yystate = YYFINAL; ---- 2302,2308 ---- +--- 2304,2310 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, @@ -379,7 +387,7 @@ ! printf("yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } ---- 2318,2322 ---- +--- 2320,2324 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", @@ -397,7 +405,7 @@ ! goto yyoverflow; } *++yyssp = yystate; ---- 2333,2357 ---- +--- 2335,2359 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, @@ -414,9 +422,9 @@ ! int yypv_index = (yyvsp - yyvs); ! yystacksize += YYSTACKSIZE; ! ysave->yyvs = yyvs = -! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); +! (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); ! ysave->yyss = yyss = -! (short*)realloc((char*)yyss,yystacksize * sizeof(short)); +! (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short)); ! if (!yyvs || !yyss) ! goto yyoverflow; ! yyssp = yyss + yyps_index; @@ -433,7 +441,7 @@ yyaccept: ! return (0); } ---- 2359,2366 ---- +--- 2361,2368 ---- goto yyloop; yyoverflow: ! yyerror("Out of memory for yacc stack"); diff --git a/contrib/perl5/pod/Makefile b/contrib/perl5/pod/Makefile index 9187c84..eb3fcfe 100644 --- a/contrib/perl5/pod/Makefile +++ b/contrib/perl5/pod/Makefile @@ -16,12 +16,14 @@ REALPERL = ../perl POD = \ perl.pod \ perldelta.pod \ + perl5004delta.pod \ perldata.pod \ perlsyn.pod \ perlop.pod \ perlre.pod \ perlrun.pod \ perlfunc.pod \ + perlopentut.pod \ perlvar.pod \ perlsub.pod \ perlmod.pod \ @@ -30,6 +32,7 @@ POD = \ perlform.pod \ perllocale.pod \ perlref.pod \ + perlreftut.pod \ perldsc.pod \ perllol.pod \ perltoot.pod \ @@ -37,6 +40,7 @@ POD = \ perltie.pod \ perlbot.pod \ perlipc.pod \ + perlthrtut.pod \ perldebug.pod \ perldiag.pod \ perlsec.pod \ @@ -51,6 +55,7 @@ POD = \ perlxstut.pod \ perlguts.pod \ perlcall.pod \ + perlhist.pod \ perlfaq.pod \ perlfaq1.pod \ perlfaq2.pod \ @@ -66,12 +71,14 @@ POD = \ MAN = \ perl.man \ perldelta.man \ + perl5004delta.man \ perldata.man \ perlsyn.man \ perlop.man \ perlre.man \ perlrun.man \ perlfunc.man \ + perlopentut.man \ perlvar.man \ perlsub.man \ perlmod.man \ @@ -80,6 +87,7 @@ MAN = \ perlform.man \ perllocale.man \ perlref.man \ + perlreftut.man \ perldsc.man \ perllol.man \ perltoot.man \ @@ -87,6 +95,7 @@ MAN = \ perltie.man \ perlbot.man \ perlipc.man \ + perlthrtut.man \ perldebug.man \ perldiag.man \ perlsec.man \ @@ -101,6 +110,7 @@ MAN = \ perlxstut.man \ perlguts.man \ perlcall.man \ + perlhist.man \ perlfaq.man \ perlfaq1.man \ perlfaq2.man \ @@ -116,12 +126,14 @@ MAN = \ HTML = \ perl.html \ perldelta.html \ + perl5004delta.html \ perldata.html \ perlsyn.html \ perlop.html \ perlre.html \ perlrun.html \ perlfunc.html \ + perlopentut.html \ perlvar.html \ perlsub.html \ perlmod.html \ @@ -130,6 +142,7 @@ HTML = \ perlform.html \ perllocale.html \ perlref.html \ + perlreftut.html \ perldsc.html \ perllol.html \ perltoot.html \ @@ -137,6 +150,7 @@ HTML = \ perltie.html \ perlbot.html \ perlipc.html \ + perlthrtut.html \ perldebug.html \ perldiag.html \ perlsec.html \ @@ -151,6 +165,7 @@ HTML = \ perlxstut.html \ perlguts.html \ perlcall.html \ + perlhist.html \ perlfaq.html \ perlfaq1.html \ perlfaq2.html \ @@ -166,12 +181,14 @@ HTML = \ TEX = \ perl.tex \ perldelta.tex \ + perl5004delta.tex \ perldata.tex \ perlsyn.tex \ perlop.tex \ perlre.tex \ perlrun.tex \ perlfunc.tex \ + perlopentut.tex \ perlvar.tex \ perlsub.tex \ perlmod.tex \ @@ -180,6 +197,8 @@ TEX = \ perlform.tex \ perllocale.tex \ perlref.tex \ + perlreftut.tex \ + perlopentut.tex \ perldsc.tex \ perllol.tex \ perltoot.tex \ @@ -187,6 +206,7 @@ TEX = \ perltie.tex \ perlbot.tex \ perlipc.tex \ + perlthrtut.tex \ perldebug.tex \ perldiag.tex \ perlsec.tex \ @@ -201,6 +221,7 @@ TEX = \ perlxstut.tex \ perlguts.tex \ perlcall.tex \ + perlhist.tex \ perlfaq.tex \ perlfaq1.tex \ perlfaq2.tex \ diff --git a/contrib/perl5/pod/buildtoc b/contrib/perl5/pod/buildtoc index 80ca2ec..a4b9d5a 100644 --- a/contrib/perl5/pod/buildtoc +++ b/contrib/perl5/pod/buildtoc @@ -6,10 +6,10 @@ sub output ($); @pods = qw( perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 - perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata - perlsyn perlop perlre perlrun perlfunc perlvar perlsub + perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata perlopentut + perlsyn perlop perlre perlreftut perlrun perlfunc perlvar perlsub perlmod perlmodlib perlmodinstall perlform perllocale perlref perldsc - perllol perltoot perlobj perltie perlbot perlipc perldebug + perllol perltoot perlobj perltie perlthrtut perlbot perlipc perldebug perldiag perlsec perltrap perlport perlstyle perlpod perlbook perlembed perlapio perlxs perlxstut perlguts perlcall perlhist diff --git a/contrib/perl5/pod/perl.pod b/contrib/perl5/pod/perl.pod index 0b9e9fa..6e218cd 100644 --- a/contrib/perl5/pod/perl.pod +++ b/contrib/perl5/pod/perl.pod @@ -20,6 +20,7 @@ of sections: perl Perl overview (this section) perldelta Perl changes since previous version + perl5004delta Perl changes in version 5.004 perlfaq Perl frequently asked questions perltoc Perl documentation table of contents @@ -29,6 +30,7 @@ of sections: perlre Perl regular expressions perlrun Perl execution and options perlfunc Perl builtin functions + perlopentut Perl open() tutorial perlvar Perl predefined variables perlsub Perl subroutines perlmod Perl modules: how they work @@ -38,6 +40,7 @@ of sections: perllocale Perl locale support perlref Perl references + perlreftut Perl references short introduction perldsc Perl data structures intro perllol Perl data structures: lists of lists perltoot Perl OO tutorial @@ -45,6 +48,7 @@ of sections: perltie Perl objects hidden behind simple variables perlbot Perl OO tricks and examples perlipc Perl interprocess communication + perlthrtut Perl threads tutorial perldebug Perl debugging perldiag Perl diagnostic messages @@ -68,8 +72,8 @@ of sections: (If you're intending to read these straight through for the first time, the suggested order will tend to reduce the number of forward references.) -By default, all of the above manpages are installed in the -F directory. +By default, all of the above manpages are installed in the +F directory. Extensive additional documentation for Perl modules is available. The default configuration for perl will place this additional documentation @@ -116,9 +120,9 @@ BASIC-PLUS.) Expression syntax corresponds quite closely to C expression syntax. Unlike most Unix utilities, Perl does not arbitrarily limit the size of your data--if you've got the memory, Perl can slurp in your whole file as a single string. Recursion is of -unlimited depth. And the tables used by hashes (previously called +unlimited depth. And the tables used by hashes (sometimes called "associative arrays") grow as necessary to prevent degraded -performance. Perl uses sophisticated pattern matching techniques to +performance. Perl can use sophisticated pattern matching techniques to scan large amounts of data very quickly. Although optimized for scanning text, Perl can also deal with binary data, and can make dbm files look like hashes. Setuid Perl scripts are safer than C programs @@ -239,6 +243,79 @@ optimized C code. Okay, that's I enough hype. +=head1 AVAILABILITY + +Perl is available for the vast majority of operating system platforms, +including most Unix-like platforms. The following situation is as of +February 1999 and Perl 5.005_03. + +The following platforms are able to build Perl from the standard +source code distribution available at +F + + AIX Linux SCO ODT/OSR + A/UX MachTen Solaris + BeOS MPE/iX SunOS + BSD/OS NetBSD SVR4 + DG/UX NextSTEP Tru64 UNIX 3) + DomainOS OpenBSD Ultrix + DOS DJGPP 1) OpenSTEP UNICOS + DYNIX/ptx OS/2 VMS + FreeBSD OS390 2) VOS + HP-UX PowerMAX Windows 3.1 1) + Hurd QNX Windows 95 1) 4) + IRIX Windows 98 1) 4) + Windows NT 1) 4) + + 1) in DOS mode either the DOS or OS/2 ports can be used + 2) formerly known as MVS + 3) formerly known as Digital UNIX and before that DEC OSF/1 + 4) compilers: Borland, Cygwin32, Mingw32 EGCS/GCC, VC++ + +The following platforms have been known to build Perl from the source +but for the Perl release 5.005_03 we haven't been able to verify them, +either because the hardware/software platforms are rather rare or +because we don't have an active champion on these platforms, or both. + + 3b1 FPS Plan 9 + AmigaOS GENIX PowerUX + ConvexOS Greenhills RISC/os + CX/UX ISC Stellar + DC/OSx MachTen 68k SVR2 + DDE SMES MiNT TI1500 + DOS EMX MPC TitanOS + Dynix NEWS-OS UNICOS/mk + EP/IX Opus Unisys Dynix + ESIX Unixware + +The following platforms are planned to be supported in the standard +source code distribution of the Perl release 5.006 but are not +supported in the Perl release 5.005_03: + + BS2000 + Netware + Rhapsody + VM/ESA + +The following platforms have their own source code distributions and +binaries available via F. + + Perl release + + AS/400 5.003 + MacOS 5.004 + Netware 5.003_07 + Tandem Guardian 5.004 + +The following platforms have only binaries available via +F. + + Perl release + + Acorn RISCOS 5.005_02 + AOS 5.002 + LynxOS 5.004_02 + =head1 ENVIRONMENT See L. @@ -247,14 +324,13 @@ See L. Larry Wall >, with the help of oodles of other folks. -If your Perl success stories and testimonials may be of help to others -who wish to advocate the use of Perl in their applications, -or if you wish to simply express your gratitude to Larry and the +If your Perl success stories and testimonials may be of help to others +who wish to advocate the use of Perl in their applications, +or if you wish to simply express your gratitude to Larry and the Perl developers, please write to >. =head1 FILES - "/tmp/perl-e$$" temporary file for -e commands "@INC" locations of perl libraries =head1 SEE ALSO @@ -296,9 +372,10 @@ and syswrite().) While none of the built-in data types have any arbitrary size limits (apart from memory size), there are still a few arbitrary limits: a -given variable name may not be longer than 255 characters, and no -component of your PATH may be longer than 255 if you use B<-S>. A regular -expression may not compile to more than 32767 bytes internally. +given variable name may not be longer than 251 characters. Line numbers +displayed by diagnostics are internally stored as short integers, +so they are limited to a maximum of 65535 (higher numbers usually being +affected by wraparound). You may mail your bug reports (be sure to include full configuration information as output by the myconfig program in the perl source tree, diff --git a/contrib/perl5/pod/perl5004delta.pod b/contrib/perl5/pod/perl5004delta.pod index f1b6c8f..323830b 100644 --- a/contrib/perl5/pod/perl5004delta.pod +++ b/contrib/perl5/pod/perl5004delta.pod @@ -1432,7 +1432,7 @@ subscript, which can do weird things if you're expecting only one subscript. =item Stub found while resolving method `%s' overloading `%s' in package `%s' (P) Overloading resolution over @ISA tree may be broken by importing stubs. -Stubs should never be implicitely created, but explicit calls to C +Stubs should never be implicitly created, but explicit calls to C may break this. =item Too late for "B<-T>" option diff --git a/contrib/perl5/pod/perlcall.pod b/contrib/perl5/pod/perlcall.pod index c239cfe..2b83780 100644 --- a/contrib/perl5/pod/perlcall.pod +++ b/contrib/perl5/pod/perlcall.pod @@ -72,7 +72,7 @@ Each of the functions will now be discussed in turn. =over 5 -=item B +=item perl_call_sv I takes two parameters, the first, C, is an SV*. This allows you to specify the Perl subroutine to be called either as a @@ -80,7 +80,7 @@ C string (which has first been converted to an SV) or a reference to a subroutine. The section, I, shows how you can make use of I. -=item B +=item perl_call_pv The function, I, is similar to I except it expects its first parameter to be a C char* which identifies the Perl @@ -88,7 +88,7 @@ subroutine you want to call, e.g., C. If the subroutine you want to call is in another package, just include the package name in the string, e.g., C<"pkg::fred">. -=item B +=item perl_call_method The function I is used to call a method from a Perl class. The parameter C corresponds to the name of the method @@ -99,7 +99,7 @@ object (for a virtual method). See L for more information on static and virtual methods and L for an example of using I. -=item B +=item perl_call_argv I calls the Perl subroutine specified by the C string stored in the C parameter. It also takes the usual C @@ -971,7 +971,8 @@ and some C to call it /* Check the eval first */ if (SvTRUE(ERRSV)) { - printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ; + STRLEN n_a; + printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ; POPs ; } else @@ -1013,7 +1014,8 @@ The code if (SvTRUE(ERRSV)) { - printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ; + STRLEN n_a; + printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ; POPs ; } @@ -1923,8 +1925,8 @@ refers to the last. =head2 Creating and calling an anonymous subroutine in C As we've already shown, C can be used to invoke an -anonymous subroutine. However, our example showed how Perl script -invoking an XSUB to preform this operation. Let's see how it can be +anonymous subroutine. However, our example showed a Perl script +invoking an XSUB to perform this operation. Let's see how it can be done inside our C code: ... diff --git a/contrib/perl5/pod/perldata.pod b/contrib/perl5/pod/perldata.pod index 58c1123..9e41c2c 100644 --- a/contrib/perl5/pod/perldata.pod +++ b/contrib/perl5/pod/perldata.pod @@ -253,7 +253,7 @@ literals are subject to backslash and variable substitution; single-quoted strings are not (except for "C<\'>" and "C<\\>"). The usual Unix backslash rules apply for making characters such as newline, tab, etc., as well as some more exotic forms. See -L for a list. +L for a list. Octal or hex representations in string literals (e.g. '0xffff') are not automatically converted to their integer representation. The hex() and @@ -471,7 +471,7 @@ is legal to assign to: ($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00); -Array assignment in a scalar context returns the number of elements +List assignment in a scalar context returns the number of elements produced by the expression on the right side of the assignment: $x = (($foo,$bar) = (3,2,1)); # set $x to 3, not 2 diff --git a/contrib/perl5/pod/perldebug.pod b/contrib/perl5/pod/perldebug.pod index 7a6e814..760d517 100644 --- a/contrib/perl5/pod/perldebug.pod +++ b/contrib/perl5/pod/perldebug.pod @@ -1109,7 +1109,7 @@ or B, the stack backtrace will not show the original values. Perl is I frivolous with memory. There is a saying that to estimate memory usage of Perl, assume a reasonable algorithm of -allocation, and multiply your estimages by 10. This is not absolutely +allocation, and multiply your estimates by 10. This is not absolutely true, but may give you a good grasp of what happens. Say, an integer cannot take less than 20 bytes of memory, a float @@ -1161,7 +1161,7 @@ in the following example: Total sbrk(): 215040/47:145. Odd ends: pad+heads+chain+tail: 0+2192+0+6144. It is possible to ask for such a statistic at arbitrary moment by -usind Devel::Peek::mstats() (module Devel::Peek is available on CPAN). +using Devel::Peek::mstats() (module Devel::Peek is available on CPAN). Here is the explanation of different parts of the format: @@ -1195,7 +1195,7 @@ memory footprints of the buckets are between memory footprints of two buckets "above". Say, with the above example the memory footprints are (with current -algorith) +algorithm) free: 8 16 32 64 128 256 512 1024 2048 4096 8192 4 12 24 48 80 @@ -1328,7 +1328,7 @@ though the subroutine itself is not defined yet). It also creates C arrays to keep data for the stash (this is one HV, but it grows, thus there are 4 big allocations: the big chunks are not -freeed, but are kept as additional arenas for C allocations). +freed, but are kept as additional arenas for C allocations). =item C<054> diff --git a/contrib/perl5/pod/perldelta.pod b/contrib/perl5/pod/perldelta.pod index a3c6b6c..a0af1e1 100644 --- a/contrib/perl5/pod/perldelta.pod +++ b/contrib/perl5/pod/perldelta.pod @@ -85,7 +85,7 @@ begin with C be referenced with a C prefix. The bare function names without the C prefix are supported with macros, but this support may cease in a future release. -See L. +See L. =item Enabling threads has source compatibility issues @@ -100,7 +100,7 @@ directly accessing perl globals as C. The API call is backward compatible with existing perls and provides source compatibility with threading is enabled. -See L. +See L<"C Source Compatibility"> for more information. =back @@ -153,6 +153,9 @@ and some bugs. These are expected to be fixed in future versions. See L. +Mach cthreads (NEXTSTEP, OPENSTEP, Rhapsody) are now supported by +the Thread extension. + =head2 Compiler WARNING: The Compiler and related tools are considered B. @@ -310,7 +313,7 @@ and in XSUBs. Perl used to complain if it encountered literal carriage returns in scripts. Now they are mostly treated like whitespace within program text. Inside string literals and here documents, literal carriage returns are -ignored if they occur paired with newlines, or get interpreted as newlines +ignored if they occur paired with linefeeds, or get interpreted as whitespace if they stand alone. This behavior means that literal carriage returns in files should be avoided. You can get the older, more compatible (but less generous) behavior by defining the preprocessor symbol @@ -488,6 +491,30 @@ If C<$/> is a referenence to an integer, or a scalar that holds an integer, EE will read in records instead of lines. For more info, see L. +=head2 pack() format 'Z' supported + +The new format type 'Z' is useful for packing and unpacking null-terminated +strings. See L. + +=head1 Significant bug fixes + +=head2 EHANDLEE on empty files + +With C<$/> set to C, slurping an empty file returns a string of +zero length (instead of C, as it used to) for the first time the +HANDLE is read. Subsequent reads yield C. + +This means that the following will append "foo" to an empty file (it used +to not do anything before): + + perl -0777 -pi -e 's/^/foo/' empty_file + +Note that the behavior of: + + perl -pi -e 's/^/foo/' empty_file + +is unchanged (it continues to leave the file empty). + =head1 Supported Platforms Configure has many incremental improvements. Site-wide policy for building @@ -500,9 +527,15 @@ BeOS is now supported. See L. DOS is now supported under the DJGPP tools. See L. +GNU/Hurd is now supported. + +MiNT is now supported. See L. + MPE/iX is now supported. See L. -MVS (OS390) is now supported. See L. +MVS (aka OS390, aka Open Edition) is now supported. See L. + +Stratus VOS is now supported. See L. =head2 Changes in existing support @@ -528,6 +561,10 @@ Perl compiler and tools. See L. A module to pretty print Perl data. See L. +=item Dumpvalue + +A module to dump perl values to the screen. See L. + =item Errno A module to look up errors more conveniently. See L. @@ -587,10 +624,52 @@ Various pragmata to control behavior of regular expressions. =over +=item Benchmark + +You can now run tests for I seconds instead of guessing the right +number of tests to run: e.g. timethese(-5, ...) will run each of the +codes for at least 5 CPU seconds. Zero as the "number of repetitions" +means "for at least 3 CPU seconds". The output format has also +changed. For example: + +use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}}) + +will now output something like this: + +Benchmark: running a, b, each for at least 5 CPU seconds... + a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516) + b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686) + +New features: "each for at least N CPU seconds...", "wallclock secs", +and the "@ operations/CPU second (n=operations)". + +=item Carp + +Carp has a new function cluck(). cluck() warns, like carp(), but also adds +a stack backtrace to the error message, like confess(). + =item CGI CGI has been updated to version 2.42. +=item Fcntl + +More Fcntl constants added: F_SETLK64, F_SETLKW64, O_LARGEFILE for +large (more than 4G) file access (the 64-bit support is not yet +working, though, so no need to get overly excited), Free/Net/OpenBSD +locking behaviour flags F_FLOCK, F_POSIX, Linux F_SHLCK, and +O_ACCMODE: the mask of O_RDONLY, O_WRONLY, and O_RDWR. + +=item Math::Complex + +The accessor methods Re, Im, arg, abs, rho, and theta, can now also +act as mutators (accessor $z->Re(), mutator $z->Re(3)). + +=item Math::Trig + +A little bit of radial trigonometry (cylindrical and spherical) added: +radial coordinate conversions and the great circle distance. + =item POSIX POSIX now has its own platform-specific hints files. @@ -655,6 +734,12 @@ sites. Some more Perl traps are documented now. See L. +L gives a tutorial on using open(). + +L gives a tutorial on references. + +L gives a tutorial on threads. + =head1 New Diagnostics =over @@ -697,6 +782,10 @@ Something like this will reproduce the error: process $BADREF 1,2,3; $BADREF->process(1,2,3); +=item Can't check filesystem of script "%s" for nosuid + +(P) For some reason you can't check the filesystem of the script for nosuid. + =item Can't coerce array into hash (F) You used an array where a hash was expected, but the array has no @@ -776,7 +865,7 @@ See L. (W) You are blessing a reference to a zero length string. This has the effect of blessing the reference into the package main. This is usually not what you want. Consider providing a default target -package, e.g. bless($ref, $p or 'MyPackage'); +package, e.g. bless($ref, $p || 'MyPackage'); =item Illegal hex digit ignored @@ -860,7 +949,7 @@ not use those settings. This was not dead serious, fortunately: there is a "default locale" called "C" that Perl can and will use, the script will be run. Before you really fix the problem, however, you will get the same error message each time you run Perl. How to really -fix the problem can be found in L section B. +fix the problem can be found in L. =back @@ -874,18 +963,39 @@ fix the problem can be found in L section B. (F) The mktemp() routine failed for some reason while trying to process a B<-e> switch. Maybe your /tmp partition is full, or clobbered. +Removed because B<-e> doesn't use temporary files any more. + =item Can't write to temp file for B<-e>: %s (F) The write routine failed for some reason while trying to process a B<-e> switch. Maybe your /tmp partition is full, or clobbered. +Removed because B<-e> doesn't use temporary files any more. + =item Cannot open temporary file (F) The create routine failed for some reason while trying to process a B<-e> switch. Maybe your /tmp partition is full, or clobbered. +Removed because B<-e> doesn't use temporary files any more. + +=item regexp too big + +(F) The current implementation of regular expressions uses shorts as +address offsets within a string. Unfortunately this means that if +the regular expression compiles to longer than 32767, it'll blow up. +Usually when you want a regular expression this big, there is a better +way to do it with multiple statements. See L. + =back +=head1 Configuration Changes + +You can use "Configure -Uinstallusrbinperl" which causes installperl +to skip installing perl also as /usr/bin/perl. This is useful if you +prefer not to modify /usr/bin for some reason or another but harmful +because many scripts assume to find Perl in /usr/bin/perl. + =head1 BUGS If you find what you think is a bug, you might check the headers of diff --git a/contrib/perl5/pod/perldiag.pod b/contrib/perl5/pod/perldiag.pod index 8d21323..fe31991 100644 --- a/contrib/perl5/pod/perldiag.pod +++ b/contrib/perl5/pod/perldiag.pod @@ -33,11 +33,11 @@ The symbols C<"%(-?@> sort before the letters, while C<[> and C<\> sort after. to try to declare one with a package qualifier on the front. Use local() if you want to localize a package variable. -=item "my" variable %s masks earlier declaration in same scope +=item "my" variable %s masks earlier declaration in same %s -(W) A lexical variable has been redeclared in the same scope, effectively -eliminating all access to the previous instance. This is almost always -a typographical error. Note that the earlier variable will still exist +(W) A lexical variable has been redeclared in the current scope or statement, +effectively eliminating all access to the previous instance. This is almost +always a typographical error. Note that the earlier variable will still exist until the end of the scope or until all closure referents to it are destroyed. @@ -143,6 +143,18 @@ Perl yourself. instead of Perl. Check the #! line, or manually feed your script into Perl yourself. +=item (in cleanup) %s + +(W) This prefix usually indicates that a DESTROY() method raised +the indicated exception. Since destructors are usually called by +the system at arbitrary points during execution, and often a vast +number of times, the warning is issued only once for any number +of failures that would otherwise result in the same message being +repeated. + +Failure of user callbacks dispatched using the C flag +could also result in this warning. See L. + =item (Missing semicolon on previous line?) (S) This is an educated guess made in conjunction with the message "%s @@ -376,7 +388,7 @@ Perl yourself. =item Bareword "%s" not allowed while "strict subs" in use (F) With "strict subs" in use, a bareword is only allowed as a -subroutine identifier, in curly braces or to the left of the "=>" symbol. +subroutine identifier, in curly brackets or to the left of the "=>" symbol. Perhaps you need to predeclare a subroutine? =item Bareword "%s" refers to nonexistent package @@ -499,6 +511,10 @@ Something like this will reproduce the error: (F) You called C, but C is not a directory that you can chdir to, possibly because it doesn't exist. +=item Can't check filesystem of script "%s" for nosuid + +(P) For some reason you can't check the filesystem of the script for nosuid. + =item Can't coerce %s to integer in %s (F) Certain types of SVs, in particular real symbol table entries @@ -1002,6 +1018,14 @@ for information on I.) (W) You tried to do a connect on a closed socket. Did you forget to check the return value of your socket() call? See L. +=item Constant is not %s reference + +(F) A constant value (perhaps declared using the C pragma) +is being dereferenced, but it amounts to the wrong type of reference. The +message indicates the type of reference that was expected. This usually +indicates a syntax error in dereferencing the constant value. +See L and L. + =item Constant subroutine %s redefined (S) You redefined a subroutine which had previously been eligible for @@ -1162,7 +1186,7 @@ a return, a goto, or a loop control statement. (W) You are blessing a reference to a zero length string. This has the effect of blessing the reference into the package main. This is usually not what you want. Consider providing a default target -package, e.g. bless($ref, $p or 'MyPackage'); +package, e.g. bless($ref, $p || 'MyPackage'); =item Fatal VMS error at %s, line %d @@ -1258,7 +1282,6 @@ Did you forget to check the return value of your socket() call? (S) A warning peculiar to VMS. The call to C underlying the C operator returned an invalid UIC. - =item Glob not terminated (F) The lexer saw a left angle bracket in a place where it was expecting @@ -1404,7 +1427,7 @@ architecture. On a 32-bit architecture the largest octal literal is (S) A warning peculiar to VMS. Perl keeps track of the number of times you've called C and C, to determine whether the current call to C should affect the current -script or a subprocess (see L). Somehow, this count +script or a subprocess (see L). Somehow, this count has become scrambled, so Perl is making a guess and treating this C as a request to terminate the Perl script and execute the specified command. @@ -1413,16 +1436,19 @@ and execute the specified command. (P) Something went badly wrong in the regular expression parser. -=item internal error: glob failed +=item glob failed (%s) -(P) Something went wrong with the external program(s) used for C -and C*.cE>. This may mean that your csh (C shell) is -broken. If so, you should change all of the csh-related variables in -config.sh: If you have tcsh, make the variables refer to it as if it -were csh (e.g. C); otherwise, make them all -empty (except that C should be C<'undef'>) so that Perl will -think csh is missing. In either case, after editing config.sh, run -C<./Configure -S> and rebuild Perl. +(W) Something went wrong with the external program(s) used for C +and C*.cE>. Usually, this means that you supplied a C +pattern that caused the external program to fail and exit with a nonzero +status. If the message indicates that the abnormal exit resulted in a +coredump, this may also mean that your csh (C shell) is broken. If so, +you should change all of the csh-related variables in config.sh: If you +have tcsh, make the variables refer to it as if it were csh (e.g. +C); otherwise, make them all empty (except that +C should be C<'undef'>) so that Perl will think csh is missing. +In either case, after editing config.sh, run C<./Configure -S> and +rebuild Perl. =item internal urp in regexp at /%s/ @@ -2322,12 +2348,14 @@ from the user it isn't running under, and isn't in a location where the CGI server can't find it, basically, more or less. Please see the following for more information: - http://www.perl.com/perl/faq/idiots-guide.html - http://www.perl.com/perl/faq/perl-cgi-faq.html + http://www.perl.com/CPAN/doc/FAQs/cgi/idiots-guide.html + http://www.perl.com/CPAN/doc/FAQs/cgi/perl-cgi-faq.html ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq http://hoohoo.ncsa.uiuc.edu/cgi/interface.html http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html +You should also look at L. + =item setegid() not implemented (F) You tried to assign to C<$)>, and your operating system doesn't support @@ -2405,6 +2433,14 @@ there was a failure. You probably wanted to use system() instead, which does return. To suppress this warning, put the exec() in a block by itself. +=item Strange *+?{} on zero-length expression + +(W) You applied a regular expression quantifier in a place where it +makes no sense, such as on a zero-width assertion. +Try putting the quantifier inside the assertion instead. For example, +the way to match "abc" provided that it is followed by three +repetitions of "xyz" is C, not C. + =item Stub found while resolving method `%s' overloading `%s' in package `%s' (P) Overloading resolution over @ISA tree may be broken by importation stubs. diff --git a/contrib/perl5/pod/perldsc.pod b/contrib/perl5/pod/perldsc.pod index d0cc335..ef3ae75 100644 --- a/contrib/perl5/pod/perldsc.pod +++ b/contrib/perl5/pod/perldsc.pod @@ -690,7 +690,7 @@ many different sorts: print $rec->{TEXT}; - print $rec->{LIST}[0]; + print $rec->{SEQUENCE}[0]; $last = pop @ { $rec->{SEQUENCE} }; print $rec->{LOOKUP}{"key"}; diff --git a/contrib/perl5/pod/perlembed.pod b/contrib/perl5/pod/perlembed.pod index c09d6e3..03c5507 100644 --- a/contrib/perl5/pod/perlembed.pod +++ b/contrib/perl5/pod/perlembed.pod @@ -141,7 +141,7 @@ you: If the B module isn't part of your Perl distribution, you can retrieve it from -http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils::Embed. (If +http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils/. (If this documentation came from your Perl distribution, then you're running 5.004 or better and you already have it.) @@ -285,6 +285,7 @@ the first, a C from the second, and a C from the third. main (int argc, char **argv, char **env) { + STRLEN n_a; char *embedding[] = { "", "-e", "0" }; my_perl = perl_alloc(); @@ -303,7 +304,7 @@ the first, a C from the second, and a C from the third. /** Treat $a as a string **/ perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE); - printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), PL_na)); + printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a)); perl_destruct(my_perl); perl_free(my_perl); @@ -325,8 +326,9 @@ possible and in most cases a better strategy to fetch the return value from I instead. Example: ... + STRLEN n_a; SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE); - printf("%s\n", SvPV(val,PL_na)); + printf("%s\n", SvPV(val,n_a)); ... This way, we avoid namespace pollution by not creating global @@ -371,6 +373,7 @@ been wrapped here): { dSP; SV* retval; + STRLEN n_a; PUSHMARK(SP); perl_eval_sv(sv, G_SCALAR); @@ -380,7 +383,7 @@ been wrapped here): PUTBACK; if (croak_on_error && SvTRUE(ERRSV)) - croak(SvPVx(ERRSV, PL_na)); + croak(SvPVx(ERRSV, n_a)); return retval; } @@ -395,9 +398,10 @@ been wrapped here): I32 match(SV *string, char *pattern) { SV *command = NEWSV(1099, 0), *retval; + STRLEN n_a; sv_setpvf(command, "my $string = '%s'; $string =~ %s", - SvPV(string,PL_na), pattern); + SvPV(string,n_a), pattern); retval = my_perl_eval_sv(command, TRUE); SvREFCNT_dec(command); @@ -416,9 +420,10 @@ been wrapped here): I32 substitute(SV **string, char *pattern) { SV *command = NEWSV(1099, 0), *retval; + STRLEN n_a; sv_setpvf(command, "$string = '%s'; ($string =~ %s)", - SvPV(*string,PL_na), pattern); + SvPV(*string,n_a), pattern); retval = my_perl_eval_sv(command, TRUE); SvREFCNT_dec(command); @@ -439,9 +444,10 @@ been wrapped here): { SV *command = NEWSV(1099, 0); I32 num_matches; + STRLEN n_a; sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)", - SvPV(string,PL_na), pattern); + SvPV(string,n_a), pattern); my_perl_eval_sv(command, TRUE); SvREFCNT_dec(command); @@ -459,6 +465,7 @@ been wrapped here): AV *match_list; I32 num_matches, i; SV *text = NEWSV(1099,0); + STRLEN n_a; perl_construct(my_perl); perl_parse(my_perl, NULL, 3, embedding, NULL); @@ -480,7 +487,7 @@ been wrapped here): printf("matches: m/(wi..)/g found %d matches...\n", num_matches); for (i = 0; i < num_matches; i++) - printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),PL_na)); + printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),n_a)); printf("\n"); /** Remove all vowels from text **/ @@ -488,7 +495,7 @@ been wrapped here): if (num_matches) { printf("substitute: s/[aeiou]//gi...%d substitutions made.\n", num_matches); - printf("Now text is: %s\n\n", SvPV(text,PL_na)); + printf("Now text is: %s\n\n", SvPV(text,n_a)); } /** Attempt a substitution **/ @@ -726,6 +733,7 @@ with L whenever possible. char *args[] = { "", DO_CLEAN, NULL }; char filename [1024]; int exitstatus = 0; + STRLEN n_a; if((perl = perl_alloc()) == NULL) { fprintf(stderr, "no memory!"); @@ -747,7 +755,7 @@ with L whenever possible. /* check $@ */ if(SvTRUE(ERRSV)) - fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,PL_na)); + fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,n_a)); } } @@ -955,7 +963,7 @@ Interfacing to ActiveState's Perl library is quite different from the examples in this documentation, as significant changes were made to the internal Perl API. However, it is possible to embed ActiveState's Perl runtime. For details, see the Perl for Win32 FAQ at -http://www.perl.com/perl/faq/win32/Perl_for_Win32_FAQ.html. +http://www.perl.com/CPAN/doc/FAQs/win32/perlwin32faq.html. With the "official" Perl version 5.004 or higher, all the examples within this documentation will compile and run untouched, although diff --git a/contrib/perl5/pod/perlfaq.pod b/contrib/perl5/pod/perlfaq.pod index e6be112..cb35493 100644 --- a/contrib/perl5/pod/perlfaq.pod +++ b/contrib/perl5/pod/perlfaq.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq - frequently asked questions about Perl ($Date: 1998/08/05 12:09:32 $) +perlfaq - frequently asked questions about Perl ($Date: 1999/01/08 05:54:52 $) =head1 DESCRIPTION @@ -16,42 +16,682 @@ This document. Very general, high-level information about Perl. +=over 4 + +=item * What is Perl? + +=item * Who supports Perl? Who develops it? Why is it free? + +=item * Which version of Perl should I use? + +=item * What are perl4 and perl5? + +=item * What is perl6? + +=item * How stable is Perl? + +=item * Is Perl difficult to learn? + +=item * How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl? + +=item * Can I do [task] in Perl? + +=item * When shouldn't I program in Perl? + +=item * What's the difference between "perl" and "Perl"? + +=item * Is it a Perl program or a Perl script? + +=item * What is a JAPH? + +=item * Where can I get a list of Larry Wall witticisms? + +=item * How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)? + +=back + + =item L: Obtaining and Learning about Perl Where to find source and documentation to Perl, support, and related matters. +=over 4 + +=item * What machines support Perl? Where do I get it? + +=item * How can I get a binary version of Perl? + +=item * I don't have a C compiler on my system. How can I compile perl? + +=item * I copied the Perl binary from one machine to another, but scripts don't work. + +=item * I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work? + +=item * What modules and extensions are available for Perl? What is CPAN? What does CPAN/src/... mean? + +=item * Is there an ISO or ANSI certified version of Perl? + +=item * Where can I get information on Perl? + +=item * What are the Perl newsgroups on USENET? Where do I post questions? + +=item * Where should I post source code? + +=item * Perl Books + +=item * Perl in Magazines + +=item * Perl on the Net: FTP and WWW Access + +=item * What mailing lists are there for perl? + +=item * Archives of comp.lang.perl.misc + +=item * Where can I buy a commercial version of Perl? + +=item * Where do I send bug reports? + +=item * What is perl.com? + +=back + + =item L: Programming Tools Programmer tools and programming support. +=over 4 + +=item * How do I do (anything)? + +=item * How can I use Perl interactively? + +=item * Is there a Perl shell? + +=item * How do I debug my Perl programs? + +=item * How do I profile my Perl programs? + +=item * How do I cross-reference my Perl programs? + +=item * Is there a pretty-printer (formatter) for Perl? + +=item * Is there a ctags for Perl? + +=item * Is there an IDE or Windows Perl Editor? + +=item * Where can I get Perl macros for vi? + +=item * Where can I get perl-mode for emacs? + +=item * How can I use curses with Perl? + +=item * How can I use X or Tk with Perl? + +=item * How can I generate simple menus without using CGI or Tk? + +=item * What is undump? + +=item * How can I make my Perl program run faster? + +=item * How can I make my Perl program take less memory? + +=item * Is it unsafe to return a pointer to local data? + +=item * How can I free an array or hash so my program shrinks? + +=item * How can I make my CGI script more efficient? + +=item * How can I hide the source for my Perl program? + +=item * How can I compile my Perl program into byte code or C? + +=item * How can I compile Perl into Java? + +=item * How can I get C<#!perl> to work on [MS-DOS,NT,...]? + +=item * Can I write useful perl programs on the command line? + +=item * Why don't perl one-liners work on my DOS/Mac/VMS system? + +=item * Where can I learn about CGI or Web programming in Perl? + +=item * Where can I learn about object-oriented Perl programming? + +=item * Where can I learn about linking C with Perl? [h2xs, xsubpp] + +=item * I've read perlembed, perlguts, etc., but I can't embed perl in +my C program, what am I doing wrong? + +=item * When I tried to run my script, I got this message. What does it +mean? + +=item * What's MakeMaker? + +=back + + =item L: Data Manipulation Manipulating numbers, dates, strings, arrays, hashes, and miscellaneous data issues. +=over 4 + +=item * Why am I getting long decimals (eg, 19.9499999999999) instead of the numbers I should be getting (eg, 19.95)? + +=item * Why isn't my octal data interpreted correctly? + +=item * Does Perl have a round() function? What about ceil() and floor()? Trig functions? + +=item * How do I convert bits into ints? + +=item * Why doesn't & work the way I want it to? + +=item * How do I multiply matrices? + +=item * How do I perform an operation on a series of integers? + +=item * How can I output Roman numerals? + +=item * Why aren't my random numbers random? + +=item * How do I find the week-of-the-year/day-of-the-year? + +=item * How can I compare two dates and find the difference? + +=item * How can I take a string and turn it into epoch seconds? + +=item * How can I find the Julian Day? + +=item * How do I find yesterday's date? + +=item * Does Perl have a year 2000 problem? Is Perl Y2K compliant? + +=item * How do I validate input? + +=item * How do I unescape a string? + +=item * How do I remove consecutive pairs of characters? + +=item * How do I expand function calls in a string? + +=item * How do I find matching/nesting anything? + +=item * How do I reverse a string? + +=item * How do I expand tabs in a string? + +=item * How do I reformat a paragraph? + +=item * How can I access/change the first N letters of a string? + +=item * How do I change the Nth occurrence of something? + +=item * How can I count the number of occurrences of a substring within a string? + +=item * How do I capitalize all the words on one line? + +=item * How can I split a [character] delimited string except when inside +[character]? (Comma-separated files) + +=item * How do I strip blank space from the beginning/end of a string? + +=item * How do I pad a string with blanks or pad a number with zeroes? + +=item * How do I extract selected columns from a string? + +=item * How do I find the soundex value of a string? + +=item * How can I expand variables in text strings? + +=item * What's wrong with always quoting "$vars"? + +=item * Why don't my EEHERE documents work? + +=item * What is the difference between a list and an array? + +=item * What is the difference between $array[1] and @array[1]? + +=item * How can I extract just the unique elements of an array? + +=item * How can I tell whether a list or array contains a certain element? + +=item * How do I compute the difference of two arrays? How do I compute the intersection of two arrays? + +=item * How do I test whether two arrays or hashes are equal? + +=item * How do I find the first array element for which a condition is true? + +=item * How do I handle linked lists? + +=item * How do I handle circular lists? + +=item * How do I shuffle an array randomly? + +=item * How do I process/modify each element of an array? + +=item * How do I select a random element from an array? + +=item * How do I permute N elements of a list? + +=item * How do I sort an array by (anything)? + +=item * How do I manipulate arrays of bits? + +=item * Why does defined() return true on empty arrays and hashes? + +=item * How do I process an entire hash? + +=item * What happens if I add or remove keys from a hash while iterating over it? + +=item * How do I look up a hash element by value? + +=item * How can I know how many entries are in a hash? + +=item * How do I sort a hash (optionally by value instead of key)? + +=item * How can I always keep my hash sorted? + +=item * What's the difference between "delete" and "undef" with hashes? + +=item * Why don't my tied hashes make the defined/exists distinction? + +=item * How do I reset an each() operation part-way through? + +=item * How can I get the unique keys from two hashes? + +=item * How can I store a multidimensional array in a DBM file? + +=item * How can I make my hash remember the order I put elements into it? + +=item * Why does passing a subroutine an undefined element in a hash create it? + +=item * How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays? + +=item * How can I use a reference as a hash key? + +=item * How do I handle binary data correctly? + +=item * How do I determine whether a scalar is a number/whole/integer/float? + +=item * How do I keep persistent data across program calls? + +=item * How do I print out or copy a recursive data structure? + +=item * How do I define methods for every class/object? + +=item * How do I verify a credit card checksum? + +=item * How do I pack arrays of doubles or floats for XS code? + +=back + + =item L: Files and Formats I/O and the "f" issues: filehandles, flushing, formats and footers. +=over 4 + +=item * How do I flush/unbuffer an output filehandle? Why must I do this? + +=item * How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file? + +=item * How do I count the number of lines in a file? + +=item * How do I make a temporary file name? + +=item * How can I manipulate fixed-record-length files? + +=item * How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles? + +=item * How can I use a filehandle indirectly? + +=item * How can I set up a footer format to be used with write()? + +=item * How can I write() into a string? + +=item * How can I output my numbers with commas added? + +=item * How can I translate tildes (~) in a filename? + +=item * How come when I open a file read-write it wipes it out? + +=item * Why do I sometimes get an "Argument list too long" when I use E*E? + +=item * Is there a leak/bug in glob()? + +=item * How can I open a file with a leading "E" or trailing blanks? + +=item * How can I reliably rename a file? + +=item * How can I lock a file? + +=item * Why can't I just open(FH, ">file.lock")? + +=item * I still don't get locking. I just want to increment the number in the file. How can I do this? + +=item * How do I randomly update a binary file? + +=item * How do I get a file's timestamp in perl? + +=item * How do I set a file's timestamp in perl? + +=item * How do I print to more than one file at once? + +=item * How can I read in a file by paragraphs? + +=item * How can I read a single character from a file? From the keyboard? + +=item * How can I tell whether there's a character waiting on a filehandle? + +=item * How do I do a C in perl? + +=item * How do I dup() a filehandle in Perl? + +=item * How do I close a file descriptor by number? + +=item * Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? + +=item * Why doesn't glob("*.*") get all the files? + +=item * Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl? + +=item * How do I select a random line from a file? + +=item * Why do I get weird spaces when I print an array of lines? + +=back + + =item L: Regexps Pattern matching and regular expressions. +=over 4 + +=item * How can I hope to use regular expressions without creating illegible and unmaintainable code? + +=item * I'm having trouble matching over more than one line. What's wrong? + +=item * How can I pull out lines between two patterns that are themselves on different lines? + +=item * I put a regular expression into $/ but it didn't work. What's wrong? + +=item * How do I substitute case insensitively on the LHS, but preserving case on the RHS? + +=item * How can I make C<\w> match national character sets? + +=item * How can I match a locale-smart version of C? + +=item * How can I quote a variable to use in a regexp? + +=item * What is C really for? + +=item * How do I use a regular expression to strip C style comments from a file? + +=item * Can I use Perl regular expressions to match balanced text? + +=item * What does it mean that regexps are greedy? How can I get around it? + +=item * How do I process each word on each line? + +=item * How can I print out a word-frequency or line-frequency summary? + +=item * How can I do approximate matching? + +=item * How do I efficiently match many regular expressions at once? + +=item * Why don't word-boundary searches with C<\b> work for me? + +=item * Why does using $&, $`, or $' slow my program down? + +=item * What good is C<\G> in a regular expression? + +=item * Are Perl regexps DFAs or NFAs? Are they POSIX compliant? + +=item * What's wrong with using grep or map in a void context? + +=item * How can I match strings with multibyte characters? + +=item * How do I match a pattern that is supplied by the user? + +=back + + =item L: General Perl Language Issues General Perl language issues that don't clearly fit into any of the other sections. +=over 4 + +=item * Can I get a BNF/yacc/RE for the Perl language? + +=item * What are all these $@%* punctuation signs, and how do I know when to use them? + +=item * Do I always/never have to quote my strings or use semicolons and commas? + +=item * How do I skip some return values? + +=item * How do I temporarily block warnings? + +=item * What's an extension? + +=item * Why do Perl operators have different precedence than C operators? + +=item * How do I declare/create a structure? + +=item * How do I create a module? + +=item * How do I create a class? + +=item * How can I tell if a variable is tainted? + +=item * What's a closure? + +=item * What is variable suicide and how can I prevent it? + +=item * How can I pass/return a {Function, FileHandle, Array, Hash, Method, Regexp}? + +=item * How do I create a static variable? + +=item * What's the difference between dynamic and lexical (static) scoping? Between local() and my()? + +=item * How can I access a dynamic variable while a similarly named lexical is in scope? + +=item * What's the difference between deep and shallow binding? + +=item * Why doesn't "my($foo) = EFILEE;" work right? + +=item * How do I redefine a builtin function, operator, or method? + +=item * What's the difference between calling a function as &foo and foo()? + +=item * How do I create a switch or case statement? + +=item * How can I catch accesses to undefined variables/functions/methods? + +=item * Why can't a method included in this same file be found? + +=item * How can I find out my current package? + +=item * How can I comment out a large block of perl code? + +=item * How do I clear a package? + +=back + + =item L: System Interaction Interprocess communication (IPC), control over the user-interface (keyboard, screen and pointing devices). +=over 4 + +=item * How do I find out which operating system I'm running under? + +=item * How come exec() doesn't return? + +=item * How do I do fancy stuff with the keyboard/screen/mouse? + +=item * How do I print something out in color? + +=item * How do I read just one key without waiting for a return key? + +=item * How do I check whether input is ready on the keyboard? + +=item * How do I clear the screen? + +=item * How do I get the screen size? + +=item * How do I ask the user for a password? + +=item * How do I read and write the serial port? + +=item * How do I decode encrypted password files? + +=item * How do I start a process in the background? + +=item * How do I trap control characters/signals? + +=item * How do I modify the shadow password file on a Unix system? + +=item * How do I set the time and date? + +=item * How can I sleep() or alarm() for under a second? + +=item * How can I measure time under a second? + +=item * How can I do an atexit() or setjmp()/longjmp()? (Exception handling) + +=item * Why doesn't my sockets program work under System V (Solaris)? What does the error message "Protocol not supported" mean? + +=item * How can I call my system's unique C functions from Perl? + +=item * Where do I get the include files to do ioctl() or syscall()? + +=item * Why do setuid perl scripts complain about kernel problems? + +=item * How can I open a pipe both to and from a command? + +=item * Why can't I get the output of a command with system()? + +=item * How can I capture STDERR from an external command? + +=item * Why doesn't open() return an error when a pipe open fails? + +=item * What's wrong with using backticks in a void context? + +=item * How can I call backticks without shell processing? + +=item * Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)? + +=item * How can I convert my shell script to perl? + +=item * Can I use perl to run a telnet or ftp session? + +=item * How can I write expect in Perl? + +=item * Is there a way to hide perl's command line from programs such as "ps"? + +=item * I {changed directory, modified my environment} in a perl script. How come the change disappeared when I exited the script? How do I get my changes to be visible? + +=item * How do I close a process's filehandle without waiting for it to complete? + +=item * How do I fork a daemon process? + +=item * How do I make my program run with sh and csh? + +=item * How do I find out if I'm running interactively or not? + +=item * How do I timeout a slow event? + +=item * How do I set CPU limits? + +=item * How do I avoid zombies on a Unix system? + +=item * How do I use an SQL database? + +=item * How do I make a system() exit on control-C? + +=item * How do I open a file without blocking? + +=item * How do I install a CPAN module? + +=item * What's the difference between require and use? + +=item * How do I keep my own module/library directory? + +=item * How do I add the directory my program lives in to the module/library search path? + +=item * How do I add a directory to my include path at runtime? + +=item * What is socket.ph and where do I get it? + +=back + + =item L: Networking Networking, the Internet, and a few on the web. +=over 4 + +=item * My CGI script runs from the command line but not the browser. (500 Server Error) + +=item * How can I get better error messages from a CGI program? + +=item * How do I remove HTML from a string? + +=item * How do I extract URLs? + +=item * How do I download a file from the user's machine? How do I open a file on another machine? + +=item * How do I make a pop-up menu in HTML? + +=item * How do I fetch an HTML file? + +=item * How do I automate an HTML form submission? + +=item * How do I decode or create those %-encodings on the web? + +=item * How do I redirect to another page? + +=item * How do I put a password on my web pages? + +=item * How do I edit my .htpasswd and .htgroup files with Perl? + +=item * How do I make sure users can't enter values into a form that cause my CGI script to do bad things? + +=item * How do I parse a mail header? + +=item * How do I decode a CGI form? + +=item * How do I check a valid mail address? + +=item * How do I decode a MIME/BASE64 string? + +=item * How do I return the user's mail address? + +=item * How do I send mail? + +=item * How do I read mail? + +=item * How do I find out my hostname/domainname/IP address? + +=item * How do I fetch a news article or the active newsgroups? + +=item * How do I fetch/put an FTP file? + +=item * How can I do RPC in Perl? + +=back + + =back =head2 Where to get this document @@ -66,6 +706,7 @@ at http://www.perl.com/perl/faq/ . You may mail corrections, additions, and suggestions to perlfaq-suggestions@perl.com . This alias should not be used to I FAQs. It's for fixing the current FAQ. +Send questions to the comp.lang.perl.misc newsgroup. =head2 What will happen if you mail your Perl programming problems to the authors @@ -88,7 +729,7 @@ Perl Porters. =head1 Author and Copyright Information -Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington. +Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington. All rights reserved. =head2 Bundled Distributions @@ -117,6 +758,11 @@ in respect of this information or its use. =over 4 +=item 7/January/99 + +Small touchups here and there. Added all questions in this +document as a sort of table of contents. + =item 22/June/98 Significant changes throughout in preparation for the 5.005 @@ -170,3 +816,4 @@ This is the initial release of version 3 of the FAQ; consequently there have been no changes since its initial release. =back + diff --git a/contrib/perl5/pod/perlfaq1.pod b/contrib/perl5/pod/perlfaq1.pod index 5a95f19..d4cac42 100644 --- a/contrib/perl5/pod/perlfaq1.pod +++ b/contrib/perl5/pod/perlfaq1.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq1 - General Questions About Perl ($Revision: 1.15 $, $Date: 1998/08/05 11:52:24 $) +perlfaq1 - General Questions About Perl ($Revision: 1.20 $, $Date: 1999/01/08 04:22:09 $) =head1 DESCRIPTION @@ -32,12 +32,14 @@ the personal note at the end of the README file in the perl source distribution for more details. See L (new as of 5.005) for Perl's milestone releases. -In particular, the core development team (known as the Perl -Porters) are a rag-tag band of highly altruistic individuals -committed to producing better software for free than you -could hope to purchase for money. You may snoop on pending -developments via news://genetics.upenn.edu/perl.porters-gw/ and -http://www.frii.com/~gnat/perl/porters/summary.html. +In particular, the core development team (known as the Perl Porters) +are a rag-tag band of highly altruistic individuals committed +to producing better software for free than you could hope to +purchase for money. You may snoop on pending developments via +nntp://news.perl.com/perl.porters-gw/ and the Deja News archive at +http://www.dejanews.com/ using the perl.porters-gw newsgroup, or you can +subscribe to the mailing list by sending perl5-porters-request@perl.org +a subscription request. While the GNU project includes Perl in its distributions, there's no such thing as "GNU Perl". Perl is not produced nor maintained by the @@ -51,12 +53,16 @@ users the informal support will more than suffice. See the answer to =head2 Which version of Perl should I use? You should definitely use version 5. Version 4 is old, limited, and -no longer maintained; its last patch (4.036) was in 1992. The most -recent production release is 5.005_01. Further references to the Perl -language in this document refer to this production release unless -otherwise specified. There may be one or more official bug fixes for -5.005_01 by the time you read this, and also perhaps some experimental -versions on the way to the next release. +no longer maintained; its last patch (4.036) was in 1992, long ago and +far away. Sure, it's stable, but so is anything that's dead; in fact, +perl4 had been called a dead, flea-bitten camel carcass. The most recent +production release is 5.005_02 (although 5.004_04 is still supported). +The most cutting-edge development release is 5.005_54. Further references +to the Perl language in this document refer to the production release +unless otherwise specified. There may be one or more official bug +fixes for 5.005_02 by the time you read this, and also perhaps some +experimental versions on the way to the next release. All releases +prior to 5.004 were subject to buffer overruns, a grave security issue. =head2 What are perl4 and perl5? @@ -68,11 +74,12 @@ Perl5 is merely the popular name for the fifth major release (October 1994), while perl4 was the fourth major release (March 1991). There was also a perl1 (in January 1988), a perl2 (June 1988), and a perl3 (October 1989). -The 5.0 release is, essentially, a complete rewrite of the perl source -code from the ground up. It has been modularized, object-oriented, -tweaked, trimmed, and optimized until it almost doesn't look like the -old code. However, the interface is mostly the same, and compatibility -with previous releases is very high. +The 5.0 release is, essentially, a ground-up rewrite of the original +perl source code from releases 1 through 4. It has been modularized, +object-oriented, tweaked, trimmed, and optimized until it almost doesn't +look like the old code. However, the interface is mostly the same, and +compatibility with previous releases is very high. See L. To avoid the "what language is perl5?" confusion, some people prefer to simply use "perl" to refer to the latest version of perl and avoid using @@ -80,6 +87,27 @@ simply use "perl" to refer to the latest version of perl and avoid using See L for a history of Perl revisions. +=head2 What is perl6? + +Perl6 is a semi-jocular reference to the Topaz project. Headed by Chip +Salzenberg, Topaz is yet-another ground-up rewrite of the current release +of Perl, one whose major goal is to create a more maintainable core than +found in release 5. Written in nominally portable C++, Topaz hopes to +maintain 100% source-compatibility with previous releases of Perl but to +run significantly faster and smaller. The Topaz team hopes to provide +an XS compatibility interface to allow most XS modules to work unchanged, +albeit perhaps without the efficiency that the new interface uowld allow. +New features in Topaz are as yet undetermined, and will be addressed +once compatibility and performance goals are met. + +If you are a hard-working C++ wizard with a firm command of Perl's +internals, and you would like to work on the project, send a request to +perl6-porters-request@perl.org to subscribe to the Topaz mailing list. + +There is no ETA for Topaz. It is expected to be several years before it +achieves enough robustness, compatibility, portability, and performance +to replace perl5 for ordinary use by mere mortals. + =head2 How stable is Perl? Production releases, which incorporate bug fixes and new functionality, @@ -106,18 +134,18 @@ to do it" (TMTOWTDI, sometimes pronounced "tim toady"). Perl's learning curve is therefore shallow (easy to learn) and long (there's a whole lot you can do if you really want). -Finally, Perl is (frequently) an interpreted language. This means -that you can write your programs and test them without an intermediate -compilation step, allowing you to experiment and test/debug quickly -and easily. This ease of experimentation flattens the learning curve -even more. +Finally, because Perl is frequently (but not always, and certainly not by +definition) an interpreted language, you can write your programs and test +them without an intermediate compilation step, allowing you to experiment +and test/debug quickly and easily. This ease of experimentation flattens +the learning curve even more. Things that make Perl easier to learn: Unix experience, almost any kind of programming experience, an understanding of regular expressions, and the ability to understand other people's code. If there's something you need to do, then it's probably already been done, and a working example is usually available for free. Don't forget the new perl modules, either. -They're discussed in Part 3 of this FAQ, along with the CPAN, which is +They're discussed in Part 3 of this FAQ, along with CPAN, which is discussed in Part 2. =head2 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl? @@ -130,22 +158,25 @@ Probably the best thing to do is try to write equivalent code to do a set of tasks. These languages have their own newsgroups in which you can learn about (but hopefully not argue about) them. +Some comparison documents can be found at http://language.perl.com/versus/ +if you really can't stop yourself. + =head2 Can I do [task] in Perl? -Perl is flexible and extensible enough for you to use on almost any -task, from one-line file-processing tasks to complex systems. For -many people, Perl serves as a great replacement for shell scripting. -For others, it serves as a convenient, high-level replacement for most -of what they'd program in low-level languages like C or C++. It's -ultimately up to you (and possibly your management ...) which tasks -you'll use Perl for and which you won't. +Perl is flexible and extensible enough for you to use on virtually any +task, from one-line file-processing tasks to large, elaborate systems. +For many people, Perl serves as a great replacement for shell scripting. +For others, it serves as a convenient, high-level replacement for most of +what they'd program in low-level languages like C or C++. It's ultimately +up to you (and possibly your management) which tasks you'll use Perl +for and which you won't. If you have a library that provides an API, you can make any component of it available as just another Perl function or variable using a Perl extension written in C or C++ and dynamically linked into your main perl interpreter. You can also go the other direction, and write your main program in C or C++, and then link in some Perl code on the fly, -to create a powerful application. +to create a powerful application. See L. That said, there will always be small, focused, special-purpose languages dedicated to a specific problem domain that are simply more @@ -164,17 +195,16 @@ certain task (e.g. prolog, make). For various reasons, Perl is probably not well-suited for real-time embedded systems, low-level operating systems development work like -device drivers or context-switching code, complex multithreaded +device drivers or context-switching code, complex multi-threaded shared-memory applications, or extremely large applications. You'll notice that perl is not itself written in Perl. -The new native-code compiler for Perl may reduce the limitations given -in the previous statement to some degree, but understand that Perl -remains fundamentally a dynamically typed language, and not a -statically typed one. You certainly won't be chastized if you don't -trust nuclear-plant or brain-surgery monitoring code to it. And -Larry will sleep easier, too -- Wall Street programs not -withstanding. :-) +The new, native-code compiler for Perl may eventually reduce the +limitations given in the previous statement to some degree, but understand +that Perl remains fundamentally a dynamically typed language, not +a statically typed one. You certainly won't be chastised if you don't +trust nuclear-plant or brain-surgery monitoring code to it. And Larry +will sleep easier, too -- Wall Street programs not withstanding. :-) =head2 What's the difference between "perl" and "Perl"? @@ -183,33 +213,58 @@ signify the language proper and "perl" the implementation of it, i.e. the current interpreter. Hence Tom's quip that "Nothing but perl can parse Perl." You may or may not choose to follow this usage. For example, parallelism means "awk and perl" and "Python and Perl" look -ok, while "awk and Perl" and "Python and perl" do not. +ok, while "awk and Perl" and "Python and perl" do not. But never +write "PERL", because perl isn't really an acronym, aprocryphal +folklore and post-facto expansions notwithstanding. =head2 Is it a Perl program or a Perl script? -It doesn't matter. - -In "standard terminology" a I has been compiled to physical -machine code once, and can then be be run multiple times, whereas a -I