# This is a patch for perl5.004_04 to update it to perl5.004_05 # # To apply this patch: # STEP 1: Chdir to the source directory. # STEP 2: Run the 'applypatch' program with this patch file as input. # # If you do not have 'applypatch', it is part of the 'makepatch' package # that you can fetch from the Comprehensive Perl Archive Network: # http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz # In the above URL, 'x' should be 2 or higher. # # To apply this patch without the use of 'applypatch': # STEP 1: Chdir to the source directory. # If you have a decent Bourne-type shell: # STEP 2: Run the shell with this file as input. # If you don't have such a shell, you may need to manually create/delete # the files/directories as shown below. # STEP 3: Run the command 'patch -p0' with this file as input. # # These are the commands needed to create/delete files/directories: # mkdir 'beos' chmod 0755 'beos' mkdir 'lib/File/Spec' chmod 0755 'lib/File/Spec' rm -f 'win32/win32io.h' rm -f 'win32/win32io.c' rm -f 'win32/bin/www.pl' rm -f 'win32/bin/webget.pl' rm -f 'win32/bin/network.pl' rm -f 'ext/DynaLoader/DynaLoader.pm' touch 'Porting/Contract' chmod 0444 'Porting/Contract' touch 'Porting/genlog' chmod 0555 'Porting/genlog' touch 'Porting/p4d2p' chmod 0555 'Porting/p4d2p' touch 'Porting/p4desc' chmod 0555 'Porting/p4desc' touch 'Porting/patching.pod' chmod 0444 'Porting/patching.pod' touch 'README.beos' chmod 0444 'README.beos' touch 'beos/nm.c' chmod 0444 'beos/nm.c' touch 'eg/cgi/caution.xbm' chmod 0444 'eg/cgi/caution.xbm' touch 'eg/cgi/dna.small.gif.uu' chmod 0444 'eg/cgi/dna.small.gif.uu' touch 'eg/cgi/nph-multipart.cgi' chmod 0444 'eg/cgi/nph-multipart.cgi' touch 'emacs/e2ctags.pl' chmod 0444 'emacs/e2ctags.pl' touch 'emacs/ptags' chmod 0555 'emacs/ptags' touch 'ext/DynaLoader/DynaLoader_pm.PL' chmod 0444 'ext/DynaLoader/DynaLoader_pm.PL' touch 'ext/POSIX/hints/bsdos.pl' chmod 0444 'ext/POSIX/hints/bsdos.pl' touch 'ext/POSIX/hints/freebsd.pl' chmod 0444 'ext/POSIX/hints/freebsd.pl' touch 'ext/POSIX/hints/linux.pl' chmod 0444 'ext/POSIX/hints/linux.pl' touch 'ext/POSIX/hints/netbsd.pl' chmod 0444 'ext/POSIX/hints/netbsd.pl' touch 'ext/POSIX/hints/openbsd.pl' chmod 0444 'ext/POSIX/hints/openbsd.pl' touch 'ext/POSIX/hints/sunos_4.pl' chmod 0444 'ext/POSIX/hints/sunos_4.pl' touch 'hints/beos.sh' chmod 0444 'hints/beos.sh' touch 'hints/openbsd.sh' chmod 0444 'hints/openbsd.sh' touch 'lib/CGI/Cookie.pm' chmod 0444 'lib/CGI/Cookie.pm' touch 'lib/File/Spec.pm' chmod 0444 'lib/File/Spec.pm' touch 'lib/File/Spec/Mac.pm' chmod 0444 'lib/File/Spec/Mac.pm' touch 'lib/File/Spec/OS2.pm' chmod 0444 'lib/File/Spec/OS2.pm' touch 'lib/File/Spec/Unix.pm' chmod 0444 'lib/File/Spec/Unix.pm' touch 'lib/File/Spec/VMS.pm' chmod 0444 'lib/File/Spec/VMS.pm' touch 'lib/File/Spec/Win32.pm' chmod 0444 'lib/File/Spec/Win32.pm' touch 'lib/Test.pm' chmod 0444 'lib/Test.pm' touch 'lib/Tie/Handle.pm' chmod 0444 'lib/Tie/Handle.pm' touch 'lib/attrs.pm' chmod 0444 'lib/attrs.pm' touch 'lib/re.pm' chmod 0444 'lib/re.pm' touch 'pod/perlhist.pod' chmod 0444 'pod/perlhist.pod' touch 'pod/perlmodinstall.pod' chmod 0444 'pod/perlmodinstall.pod' touch 'pod/perlport.pod' chmod 0444 'pod/perlport.pod' touch 't/comp/require.t' chmod 0555 't/comp/require.t' touch 't/lib/filespec.t' chmod 0555 't/lib/filespec.t' touch 't/lib/h2ph.h' chmod 0444 't/lib/h2ph.h' touch 't/lib/h2ph.pht' chmod 0444 't/lib/h2ph.pht' touch 't/lib/h2ph.t' chmod 0555 't/lib/h2ph.t' touch 't/lib/ph.t' chmod 0555 't/lib/ph.t' touch 't/op/defins.t' chmod 0555 't/op/defins.t' touch 't/op/die.t' chmod 0555 't/op/die.t' touch 't/op/die_exit.t' chmod 0555 't/op/die_exit.t' touch 't/op/goto_xs.t' chmod 0555 't/op/goto_xs.t' touch 't/op/hashwarn.t' chmod 0555 't/op/hashwarn.t' touch 't/op/pos.t' chmod 0555 't/op/pos.t' touch 't/op/tiehandle.t' chmod 0555 't/op/tiehandle.t' touch 'win32/bin/perlglob.pl' chmod 0444 'win32/bin/perlglob.pl' touch 'win32/des_fcrypt.patch' chmod 0444 'win32/des_fcrypt.patch' # # Permissions changes to existing files # chmod 0555 'lib/diagnostics.pm' chmod 0444 'minimod.pl' chmod 0444 't/harness' # # This command terminates the shell and need not be executed manually. exit # #### End of Preamble #### #### Patch data follows #### diff -c 'perl5.004_04/patchlevel.h' 'perl5.004_05/patchlevel.h' Index: ./patchlevel.h *** ./patchlevel.h Wed Oct 15 05:55:19 1997 --- ./patchlevel.h Thu Apr 29 10:54:58 1999 *************** *** 1,5 **** #define PATCHLEVEL 4 ! #define SUBVERSION 4 /* local_patches -- list of locally applied less-than-subversion patches. --- 1,5 ---- #define PATCHLEVEL 4 ! #define SUBVERSION 5 /* local_patches -- list of locally applied less-than-subversion patches. diff -c 'perl5.004_04/Changes' 'perl5.004_05/Changes' Index: ./Changes *** ./Changes Wed Oct 15 09:43:40 1997 --- ./Changes Thu Apr 29 11:43:52 1999 *************** *** 5,11 **** release of Perl is based. (Patches can be found on any CPAN site, in the .../src/5.0 directory for full version releases, or in the .../src/5/0/unsupported directory for sub-version ! releases.) --------------- --- 5,11 ---- release of Perl is based. (Patches can be found on any CPAN site, in the .../src/5.0 directory for full version releases, or in the .../src/5/0/unsupported directory for sub-version ! development releases.) --------------- *************** *** 44,51 **** Charles Bailey Tim Bunce Andy Dougherty ! Chip Salzenberg ---------------- Version 5.004_04 Maintenance release 4 for 5.004 --- 44,4095 ---- Charles Bailey Tim Bunce Andy Dougherty ! Gurusamy Sarathy ! Chip Salzenberg ! ! And, of course, the Author of Perl: ! ! Larry Wall ! ! ! ! ---------------- ! Version 5.004_05 Maintenance release 5 for 5.004 ! ---------------- ! ! "I said to my soul, be still, and wait without hope ! For hope would hope for the wrong thing; wait without love ! For love would be love of the wrong thing; there is yet faith ! But the faith and the love and the hope are all in the waiting. ! Wait without thought, for you are not ready for thought: ! So the darkness shall be light, and the stillness the dancing." ! -- T.S.Eliot, East Coker ! ! ! HEADLINES FOR THIS MAINTENANCE RELEASE + Better security + - Tainting bugs fixed. + - Mount options that disallow set[ug]id honored. + - Temporary file not created for "perl -e". + Better documentation + - Many significant updates and clarifications. + Better performance + - Many improvements including a very fast/safe built-in qsort. + Better perl portability + - Easier builds on more systems. + Better script portability + - Scripts with CR LF line endings (Win32) work on UNIX. + Better version portability + - Some 5.005 script features added such as "STMT foreach LIST", + stub attrs pragma, foo:: package bearword. + - Some 5.005 internals/XS features added such as + new ERRSV, ERRHV, DEFSV, SAVE_DEFSV and dTHR macros. + Better utilities + - Many enhancements for h2ph, perldoc, perlbug etc. + Better warnings / fewer warnings + - No more warnings on $x{shift}, ne => 1, or -f => 1. + - Implicit defined() added in while($x=<>). + Better code + - Almost all known run-time memory leaks fixed. + - Many other bugs fixed. + + + Change 3296 by chip@perlsupport.com on 1999/04/29 19:01:36 + + Fix a few scripts' permissions. + Update MANIFEST and, yet again, Changes. + + Change 3295 by chip@perlsupport.com on 1999/04/29 18:53:45 + + Final release: Update patchlevel.h and Changes. + + Change 3294 by chip@perlsupport.com on 1999/04/29 18:52:16 + + Refresh emacs/*. + + Change 3293 by chip@perlsupport.com on 1999/04/29 18:50:49 + + Fix shebang lines. + + Change 3290 by chip@perlsupport.com on 1999/04/29 18:16:45 + + Eliminate SysV IPC tests that don't work reliably. + Maybe the next patch will include IPC::SysV. + + Change 3288 by chip@perlsupport.com on 1999/04/27 17:12:38 + + Fix non-core-XS bug in MM_VMS.pm. + (from Dan Sugalski ) + + Change 3287 by chip@perlsupport.com on 1999/04/27 13:36:27 + + Fix SysV IPC tests to allow for ids of zero. + + Change 3286 by chip@perlsupport.com on 1999/04/27 13:16:07 + + Update Solaris 2.x hints. + (from Andy Dougherty ) + + Change 3285 by chip@perlsupport.com on 1999/04/27 13:02:43 + + Add 'okfile' target to makefile. + (from Hugo van der Sanden ) + + Change 3283 by chip@perlsupport.com on 1999/04/26 23:20:47 + + Tweak ordering of Porting/makerel. + Update MANIFEST and, yet again, Changes. + + Change 3282 by chip@perlsupport.com on 1999/04/26 23:13:39 + + Update Changes again for last few patches. + + Change 3281 by chip@perlsupport.com on 1999/04/26 23:12:28 + + Update OpenBSD hints. + (from Todd Miller ) + + Change 3280 by chip@perlsupport.com on 1999/04/26 23:11:10 + + Allow AIX to use Perl's malloc if user insists on it. + (from Kurt Starsinic) + + Change 3279 by chip@perlsupport.com on 1999/04/26 23:09:26 + + Make &AutoLoad::AUTOLOAD reentrant. + + Change 3278 by chip@perlsupport.com on 1999/04/26 23:08:29 + + Refresh AutoLoader to 5.55. + + Change 3277 by chip@perlsupport.com on 1999/04/26 22:54:27 + + Update Changes and patchlevel.h for maint trial 9. + + Change 3276 by chip@perlsupport.com on 1999/04/26 22:34:36 + + Make porting scripts executable. + + Change 3275 by chip@perlsupport.com on 1999/04/26 22:21:43 + + Merge most of Porting directory from mainline. + + Change 3253 by chip@perlsupport.com on 1999/04/13 04:57:52 + + Explain next/last/redo a bit more in perlfunc. + (from M.J.T. Guy ) + + Change 3252 by chip@perlsupport.com on 1999/04/13 04:33:25 + + Rebuild embed.h. (Forgot.) + + Change 3251 by chip@perlsupport.com on 1999/04/13 04:31:50 + + Eliminate false Configure warning about LD_LIBRARY_PATH. + (It's now set automatically during the build process.) + + Change 3250 by chip@perlsupport.com on 1999/04/13 04:30:57 + + Fix check for glibc, so it'll work with 2.1. + (back-formation from 5.006-to-be) + + Change 3249 by chip@perlsupport.com on 1999/04/13 04:30:22 + + Refresh hints for FreeBSD. + + Change 3248 by chip@perlsupport.com on 1999/04/13 04:29:59 + + Automatically set LD_LIBRARY_PATH (or equivalent) during the + build process. (back-formation from 5.006-to-be) + + Change 3247 by chip@perlsupport.com on 1999/04/13 04:29:08 + + New config variable $ignore_versioned_solibs, for Linux. + + Change 3246 by chip@perlsupport.com on 1999/04/13 04:28:17 + + Don't use 'nm' under AIX. + + Change 3245 by chip@perlsupport.com on 1999/04/13 04:27:49 + + Make AutoSplit harder to fool. + + Change 3244 by chip@perlsupport.com on 1999/04/13 04:27:17 + + Fix some broken document links. (from Tom Christiansen) + + Change 3243 by chip@perlsupport.com on 1999/04/13 04:26:21 + + Refresh Text::Wrap to 98.112902. + + Change 3242 by chip@perlsupport.com on 1999/04/13 04:25:10 + + Use locale in Pod::Html and Pod::Text. + Fix typos in Pod::Text. + + Change 3241 by chip@perlsupport.com on 1999/04/13 04:21:49 + + Revert argument list change in export_to_level. + + Change 3240 by chip@perlsupport.com on 1999/04/13 04:21:18 + + Add 'no_modify' to list of variables in 5.005. + + Change 3239 by chip@perlsupport.com on 1999/04/13 04:20:23 + + Refresh perlport to 1.39. (from Chris Nandor) + + Change 3238 by chip@perlsupport.com on 1999/04/13 04:19:38 + + Fix typo in perlxstut. + + Change 3237 by chip@perlsupport.com on 1999/04/13 04:19:10 + + Clear errno on successful C. + + Change 3236 by chip@perlsupport.com on 1999/04/13 04:17:50 + + Add test of C interaction with AUTOLOAD. + + Change 3235 by chip@perlsupport.com on 1999/04/13 04:15:51 + + Make Text::ParseWords handle some delimiters with spaces. + (The full fix, using /(?-x:$foo)/, can't work in 5.004.) + + Change 3234 by chip@perlsupport.com on 1999/04/13 04:14:22 + + Properly handle tainted operations when -U is set. + + Change 3233 by chip@perlsupport.com on 1999/04/13 04:13:02 + + New config variable $installusrbinperl, defaulting 'undef' + for NetBSD. (from Jarkko) + + Change 3232 by chip@perlsupport.com on 1999/04/13 04:09:05 + + Update NetBSD hints. + + Change 3231 by chip@perlsupport.com on 1999/04/13 04:07:41 + + Refresh Getopt::Long to 2.19. + + Change 3230 by chip@perlsupport.com on 1999/04/13 04:06:19 + + Properly diagnose missing roots in rmtree(). + + Change 3229 by chip@perlsupport.com on 1999/04/13 04:04:14 + + Preserve errno from importunities of sfio. + + Change 3228 by chip@perlsupport.com on 1999/04/13 04:02:33 + + Fix longstanding bug: searches for lexicals originating within + eval'' weren't stopping at the subroutine boundary correctly. + (back-formation from change 3037) + + Change 3227 by chip@perlsupport.com on 1999/04/13 04:00:47 + + Record Linux libc version. + + Change 3222 by chip@perlsupport.com on 1999/04/06 19:32:40 + + Disable setuid execution if 'nosuid' mount option specified. + (Original fix from Jarkko; hand-hackery of Configure by Chip.) + + Change 3221 by chip@perlsupport.com on 1999/04/06 19:27:50 + + Set CDPATH="." only if it's already set to something else. + + Change 2447 by gsar@aatma on 1998/12/04 03:47:42 + + Update README.win32 in maint-5.004. + + Change 2446 by TimBunce@ig.co.uk on 1998/12/03 15:52:59 + + Update MANIFEST for dna.small.gif.uu (change 2445) + + Change 2445 by TimBunce@ig.co.uk on 1998/12/03 15:49:32 + + Ship dna.small.gif uuencoded. + Update Changes and patchlevel.h for maint trial 8. + + Change 2442 on 1998/12/03 by TimBunce@ig.co.uk + + Configure supplies bad ccflags for Irix/GCC combo + From: "Kurt D. Starsinic" + + Change 2439 on 1998/12/03 by TimBunce@ig.co.uk + + Title: "hints/freebsd.sh signal handler type" + From: Anton Berezin + Msg-ID: <864srhhvcv.fsf@lion.plab.ku.dk> + Files: hints/freebsd.sh + + Change 2438 on 1998/12/03 by TimBunce@ig.co.uk + + Title: "erroneous 'none' in lddlflags" + From: Andy Dougherty + Files: Configure + + Change 2422 on 1998/11/30 by TimBunce@ig.co.uk + + Title: "defined and tie'ed hashes" + From: Gurusamy Sarathy + Msg-ID: <199811281759.MAA11474@aatma.engin.umich.edu> + Files: pp.c + + Change 2421 on 1998/11/30 by TimBunce@ig.co.uk + + Title: "Problems with ExtUtils::Liblist on Win32: -L -> -libpath -> -l(ibpath)" + From: Gurusamy Sarathy , Swen Thuemmler + Msg-ID: <199811280515.AAA18658@aatma.engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm + + Change 2420 on 1998/11/30 by TimBunce@ig.co.uk + + Apply MachTen malloc allignment work-around to NeXT. + + Change 2419 on 1998/11/30 by TimBunce@ig.co.uk + + Add Configure config.msg warning mechanism from 5.005. Use it to warn + about LD_LIBRARY_PATH if appropriate (eg Digital UNIX aka DEC OSF/1) + From: Jarkko Hietaniemi + + Change 2418 on 1998/11/30 by TimBunce@ig.co.uk + + Copied change 2353 by Jarkko Hietaniemi. + Locale collation, ctype, and numeric, were initialized wrong + (if LC_ALL or LANG were unset, so were the collation/ctype/numeric), + as reported by Ilya.Sandler@etak.com (Ilya Sandler) + + Change 2331 on 1998/11/27 by TimBunce@ig.co.uk + + Title: "Fix noises from the VC linker on RunPerl()" + From: Gurusamy Sarathy + Msg-ID: <199811210900.EAA07670@aatma.engin.umich.edu> + Files: win32/perllib.c + + Change 2330 on 1998/11/27 by TimBunce@ig.co.uk + + win32 portability fix: make sysread() and syswrite() work on sockets + win32_recvfrom() compatibility fix + [Changes 2254 and 2255 by gsar] + + Change 2329 on 1998/11/27 by TimBunce@ig.co.uk + + fix C misoptimization that fails + to set the package for the block properly + [Change 2299 by gsar@aatma on 1998/11/26 06:51:16] + + Change 2328 on 1998/11/27 by TimBunce@ig.co.uk + + Assorted (5.004 specific) fixes: + + Title: "Improve test for failed csh glob (-w warn on core dump)" + From: Gurusamy Sarathy + Msg-ID: <199811230134.UAA07516@aatma.engin.umich.edu> + Files: pp_hot.c + + Title: "Fix K&R compiler error on pad_findlex 'prototype'" + From: Paul Marquess + Msg-ID: <199811231209.MAA23125@zog.bfsec.bt.co.uk> + Files: op.c + + Title: "Reversed embedvar (PL_foo) required for 5.004_0x" + From: Nick Ing-Simmons + Msg-ID: <199810171143.MAA11663@ni-s.u-net.com> + Files: embed.pl + + Change 2291 on 1998/11/22 by TimBunce@ig.co.uk + + Updated Porting/patchls utility. + + Change 2290 on 1998/11/22 by TimBunce@ig.co.uk + + Fix "<-l>" typo reported by pod2man warning. + + Change 2289 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "pod2man bug in date generated line" + From: "Kurt D. Starsinic" , Albert Dvornik + + Msg-ID: <19981120131523.A464@O2.chapin.edu>, + + Files: pod/pod2man.PL + + Change 2288 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "Buglet in Sys::Syslog.pm (with fix)" + From: Henrik Tougaard + Msg-ID: + Files: lib/Sys/Syslog.pm + + Change 2287 on 1998/11/22 by TimBunce@ig.co.uk + + Updated CPAN and CGI versions to CPAN-1.40 and CGI-2.42. + + Change 2283 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "(5.005_02) a2p should use `chomp' instead of `chop'" + From: Mark-Jason Dominus + Msg-ID: <19981030192423.27276.qmail@plover.com> + Files: x2p/walk.c + + Change 2282 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "the 4_05-MT6 UNICOS 9.0.1ai C90 miniperl crash" + From: Jarkko Hietaniemi + Msg-ID: <199810121203.PAA26999@alpha.hut.fi> + Files: hints/unicos.sh + + Change 2281 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "groups test needs to use id command on some systems" + From: Jarkko Hietaniemi + Msg-ID: + Files: t/op/groups.t + + Change 2280 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "die with a reference should use overload "" operator" + From: Graham Barr + Msg-ID: <19981024214550.C508@pobox.com> + Files: pp_ctl.c + + Change 2279 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "bugfix: hv_delete and ~ magic" + From: Alan Burlison , Albert Dvornik + + Msg-ID: <363A0850.293FFE13@uk.sun.com>, + + Files: hv.c + + Change 2278 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "Auto-incrementing tied scalar causes SEGV" + From: Graham Barr + Msg-ID: <19981024124521.C512@pobox.com> + Files: sv.c + + Change 2277 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "[PATCH 5.005_02, 5.004_04] hints/sco.sh update" + From: Andy Dougherty + Msg-ID: + Files: hints/sco.sh + + Change 2276 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "Remove spurious /* dTHR; */" + From: Andy Dougherty , Gurusamy Sarathy + , Nick Ing-Simmons + Msg-ID: + Files: mg.c sv.c + + Change 2275 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "[PATCH 5.004/5.005/5.006]Doc patch to VMS::Stdio module" + From: Dan Sugalski + Msg-ID: <3.0.6.32.19981013151057.00a947a0@ous.edu> + Files: vms/ext/Stdio/Stdio.pm + + Change 2274 on 1998/11/22 by TimBunce@ig.co.uk + + Preserve errno around fcntl(fd,F_SETFD,fd > maxsysfd) in do_open() + + Change 2273 on 1998/11/22 by TimBunce@ig.co.uk + + Improve op/die_exit.t test for implicit close changing $! + + Change 2272 on 1998/11/22 by TimBunce@ig.co.uk + + Update perlhit.pod to 1.53 + + Change 2271 on 1998/11/22 by TimBunce@ig.co.uk + + Title: "Complete.pm patch (version 1.1)" + From: Brian Callaghan + Msg-ID: <3654CA96.B64FCAEB@itginc.com> + Files: lib/Term/Complete.pm + + Change 2270 on 1998/11/22 by TimBunce@ig.co.uk + + Revert to 5.004_04 glob error check (too many csh's give bad status) + + Change 2269 on 1998/11/22 by TimBunce@ig.co.uk + + Jumbo patch from Sarathy based on the following changes + (together with a few other assorted fixes) + + Parent change 1072 by gsar@aatma on 1998/06/04 01:49:24 + + [win32] document CORE::GLOBAL:: and global overriding, fix up + File::DosGlob, testsuited and all + + Parent change 1131 by gsar@aatma on 1998/06/14 19:33:36 + + Message-ID: + From: Roderick Schertler + Subject: [PATCH] Re: Exceptions in IPC::Open2 + Date: 12 Jun 1998 13:24:15 -0400 + + Parent change 1134 by gsar@aatma on 1998/06/15 04:07:18 + + various win32 odds and ends + - added support for waitpid(), open2/open3, and a bugfix for kill() + from Ronald Schmidt + - tweak testsuite mods of above + - regenerate win32/config_H.?c + - change kill() to win32_kill() and export it + - coalesce common code in win32.c + - add PerlProc_waitpid() and export win32_waitpid() + result builds and passes on the three win32 compilers + + Parent change 1226 by gsar@aatma on 1998/06/28 17:12:56 + + Date: Tue, 23 Jun 1998 05:37:09 -0700 (PDT) + From: Tom Phoenix + Subject: Better diags for vars.pm + Message-ID: + + Parent change 1678 by gsar@aatma on 1998/08/02 03:24:29 + + fix MM_Win32::maybe_command() + + Parent change 1679 by gsar@aatma on 1998/08/02 03:29:41 + + MM_Win32::maybe_command() case-insesitivity tweak + + Parent change 1738 by gsar@aatma on 1998/08/05 09:08:33 + + support :nosearch in ExtUtils::Liblist for win32, and make -lfoo + processing (somewhat) compiler-specific + + Parent change 1740 by gsar@aatma on 1998/08/05 10:05:46 + + update Changes, patchlevel, tweak Liblist.pm + + Parent change 1746 by gsar@aatma on 1998/08/05 22:55:59 + + MM_Win32.pm and Liblist.pm tweaks + + Parent change 1750 by gsar@aatma on 1998/08/07 21:51:52 + + allow more compatible interpretation of spaces File::DosGlob::glob() + patterns + + Parent change 1796 by gsar@aatma on 1998/09/23 01:31:32 + + perl.pod tweak + + Parent change 1806 by gsar@aatma on 1998/09/23 03:36:08 + + support make written in perl (aka "pmake") on win32 + + Parent change 1831 by gsar@aatma on 1998/09/23 07:19:30 + + document 'U' magic with examples + From: Alan Burlison + Date: Tue, 1 Sep 1998 15:54:06 +0100 (BST) + Message-Id: <199809011455.PAA00631@sale-wts> + Subject: Re: Looking for some XS MAGIC examples... + + Parent change 1848 by gsar@aatma on 1998/09/23 10:25:24 + + From: Roderick Schertler + Date: 11 Sep 1998 16:19:21 -0400 + Message-ID: + Subject: Re: Open2 and memory leaks + + Parent change 1853 by gsar@aatma on 1998/09/23 10:46:06 + + make Pod/Html.pm handle the --title option properly (as suggested + by gml4410@ggr.co.uk) + + Parent change 1857 by gsar@aatma on 1998/09/23 10:58:36 + + 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] + + Parent change 1871 by gsar@aatma on 1998/09/24 07:26:37 + + correct FSF address in various places + + Parent change 1886 by gsar@aatma on 1998/09/25 04:47:32 + + s/MAKEMAKEROPT/PERL_MM_OPT/ + + Parent change 1914 by gsar@aatma on 1998/10/02 04:05:36 + + 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 + + Parent change 1943 by gsar@aatma on 1998/10/13 02:06:09 + + ensure recursive attempts to findlex()icals know enough about where + the last eval'' context was encountered + + Parent change 1944 by gsar@aatma on 1998/10/13 03:15:50 + + 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'' + + Parent change 1945 by gsar@aatma on 1998/10/13 03:32:02 + + defer "deep recursion" warnings until CXt_SUB context is properly + set up + + Parent change 1948 by gsar@aatma on 1998/10/14 05:38:01 + + two typos + + Parent change 1966 by gsar@aatma on 1998/10/15 02:19:03 + + tweak to make fix in change#1944 behave correctly for closures + created within eval'' + + Parent change 1974 by gsar@aatma on 1998/10/15 23:53:25 + + s/last/first/ typo in append_list() + + Parent change 1988 by gsar@aatma on 1998/10/17 01:49:05 + + stray typo found by Hugo van der Sanden + + Parent change 1998 by gsar@aatma on 1998/10/17 03:00:40 + + skip readonly vars and unref references when doing a reset() + + Parent change 2003 by gsar@aatma on 1998/10/17 04:11:40 + + silence -w noises (suggested by Greg Bacon) + + Parent change 2014 by gbarr@monty on 1998/10/17 20:31:42 + + Fix POSIX::sigprocmask not to check type of $old parameter + as it is output only + + Parent change 2030 by gsar@aatma on 1998/10/21 04:22:53 + + fix handling of mayhaps-extended @_ in goto &sub + (including later followup fix) + + Parent change 2057 by gsar@aatma on 1998/10/25 05:40:40 + + integrate change#2053 from maint-5.005 + + Parent change 2060 by gsar@aatma on 1998/10/25 06:37:34 + + 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 + + Parent change 2067 by gsar@aatma on 1998/10/25 06:50:19 + + 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 + + Parent change 2068 by gsar@aatma on 1998/10/25 06:54:43 + + 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 + + Parent change 2069 by gsar@aatma on 1998/10/25 06:59:03 + + 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 + + Parent change 2149 by gsar@aatma on 1998/10/30 19:38:15 + + From: Roderick Schertler + Date: Thu, 29 Oct 1998 14:50:18 -0500 + Message-ID: <17625.909690618@eeyore.ibcinc.com> + Subject: patch for daemonization docs in perlipc + + Parent change 2152 by gsar@aatma on 1998/10/30 21:08:11 + + mention the C<$SIG{CHLD} = 'IGNORE'> special case + + Parent change 2210 by gsar@aatma on 1998/11/06 20:36:50 + + fix AvREALISH bogusness + + Parent change 2224 by gsar@aatma on 1998/11/09 03:13:14 + + avoid endless loops in Text::Wrap (from a suggestion by Lupe + Christoph ) + + Parent change 2233 by gsar@aatma on 1998/11/13 09:43:03 + + doc tweak + + Title: "v5.4.6.2b odds and ends" + From: Gurusamy Sarathy + Msg-ID: <199811142210.RAA12455@aatma.engin.umich.edu> + Files: perl.c win32/Makefile win32/config.bc win32/config.vc + win32/makefile.mk + + Change 1938 on 1998/10/09 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "glob with non-existent directory -> make warning non-mandatory" + From: Gurusamy Sarathy , Jim Avera + Msg-ID: <199810012224.PAA29890@membrane.ssd.hal.com>, + <199810020402.AAA11686@aatma.engin.umich.edu> + Files: pod/perldiag.pod pp_hot.c + + Title: "perl does not build on Cray T90" + From: Mark P Lutz + Msg-ID: <199808312113.VAA53356@triton.ca.boeing.com> + Files: toke.c + + Title: "pp_require clobbers compiling.cop_line" + From: larry@wall.org (Larry Wall) + Msg-ID: <199808300005.RAA23473@wall.org> + Files: pp_ctl.c + + ------ DOCUMENTATION ------ + + Title: "Update perlform.pod to clarify \n\t\f and \r in formats" + From: Colin Kuskie + Msg-ID: + Files: pod/perlform.pod + + ------ LIBRARY ------ + + Title: "Fix File::Find to work in tainted mode" + From: Ed Jordan , Jochen Wiedmann , Randal + Schwartz + Msg-ID: <35F3DF42.CCEA269D@ispsoft.de>, <8cemtmkwgb.fsf@gadget.cscaper.com>, + + Files: lib/File/Find.pm + + Title: "Make File::Find work when wanted() is autoloaded or a symbolic ref" + From: Gurusamy Sarathy + Msg-ID: <199810020248.WAA10478@aatma.engin.umich.edu> + Files: lib/File/Find.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Further refine hint/hpux.sh fix for cppstdin and cpprun" + From: Jeff Okamoto + Msg-ID: <199809021706.KAA26349@xfiles.intercon.hp.com> + Files: hints/hpux.sh + + Title: "Allow dlerror to be a macro when HAS_DLERROR is undefined", "broken + wait.ph causes problems for Test::Harness" + From: Tim Bunce + Files: ext/DynaLoader/dl_dlopen.xs lib/Test/Harness.pm + + Change 1894 on 1998/09/25 by TimBunce@ig.co.uk + + Major docs update to 5.005_02 (where appropriate) + + Change 1893 on 1998/09/25 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "ensure implicit close on local(*FH) doesn't affect $! and thence $?" + From: Gurusamy Sarathy + Msg-ID: <199807312350.TAA17104@aatma.engin.umich.edu> + Files: sv.c t/op/die_exit.t + + Title: "Fixes for pre-ANSI compilers (eg SunOS 4)" + From: Andy Dougherty + Msg-ID: + Files: mg.c op.c pp_ctl.c sv.c + + ------ DOCUMENTATION ------ + + Title: "Update pod/perlhist.pod" + From: Jarkko Hietaniemi + Msg-ID: <199808030850.LAA04656@alpha.hut.fi> + Files: pod/perlhist.pod + + ------ EXTENSIONS ------ + + Title: "use $ENV{MAKEMAKEROPT} to set default command line args" + From: Gurusamy Sarathy + Msg-ID: <199809240804.EAA17332@aatma.engin.umich.edu> + Files: lib/ExtUtils/MakeMaker.pm + + Title: "Fix POSIX::ELOOP and _POSIX_STREAM_MAX" + From: Nicholas Clark + Msg-ID: <199807281540.QAA04640@flirble.org> + Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs + + ------ PORTABILITY - GENERAL ------ + + Title: "Fixup patches for VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980727114541.00af5730@ous.edu> + Files: t/lib/filecopy.t t/op/defins.t vms/descrip.mms + + ------ TESTS ------ + + Title: "Add tests for C" + From: Gurusamy Sarathy + Msg-ID: <199809181818.OAA09898@aatma.engin.umich.edu> + Files: t/cmd/for.t + + ------ UTILITIES ------ + + Title: "h2ph misquotes #error directives" + From: "Kurt D. Starsinic" + Msg-ID: <19980820205903.A12908@O2.chapin.edu> + Files: t/lib/h2ph.pht utils/h2ph.PL + + Change 1892 on 1998/09/25 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Fix off-by-one in change#623 that broke lexical lookups in eval''" + From: Gurusamy Sarathy + Msg-ID: <199807211951.PAA01022@aatma.engin.umich.edu> + Files: pp_ctl.c + + Title: "NetBSD patches" + From: Hubert Feyrer , Jarkko Hietaniemi + + Msg-ID: , + + Files: hints/netbsd.sh makedepend.SH pod/perldiag.pod perl.h perl.c + + Title: "Fix memory corruption in select" + From: Gurusamy Sarathy , Lupe Christoph + + Msg-ID: <199807251749.TAA22347@alanya.m.isar.de>, + <199807251928.PAA03667@aatma.engin.umich.edu> + Files: pp_sys.c + + Title: "Better CR-handling on shebang line and in formats" + From: Gurusamy Sarathy , Igor Sysoev + Msg-ID: <199808191352.RAA23006@mail.nitek.ru>, + <199809232221.SAA08153@aatma.engin.umich.edu> + Files: perl.c toke.c + + Title: "make C AUTOLOAD-aware" + From: Gurusamy Sarathy + Msg-ID: <199809240701.DAA16223@aatma.engin.umich.edu> + Files: pp_ctl.c + + Title: "check ferror() only if read() returned 0" + From: Gurusamy Sarathy + Msg-ID: <199807180224.WAA23107@aatma.engin.umich.edu> + Files: pp_sys.c + + Title: "fix memory leak in C" + From: Gurusamy Sarathy + Msg-ID: <199807210049.UAA27342@aatma.engin.umich.edu> + Files: scope.c + + Title: "no csh, no globbing, no error - fixed" + From: Gurusamy Sarathy + Msg-ID: <199808011809.OAA00528@aatma.engin.umich.edu> + Files: pp_hot.c + + Title: "warn on C" + From: Gurusamy Sarathy + Msg-ID: <199809230824.EAA27936@aatma.engin.umich.edu> + Files: pod/perldiag.pod op.c + + Title: "end pod processing when source file is closed" + From: Gurusamy Sarathy + Msg-ID: <199808050106.VAA08668@aatma.engin.umich.edu> + Files: t/comp/require.t toke.c + + Title: "fix small memory leak when mess_sv happens to be touched by magic" + From: Gurusamy Sarathy + Msg-ID: <199807210053.UAA27374@aatma.engin.umich.edu> + Files: perl.c t/op/local.t t/op/pat.t t/op/regexp.t + + Title: "Fix problems with unpack u, q and Q formats. Add tests." + From: "M.J.T. Guy" , Jarkko Hietaniemi + Msg-ID: <199808030826.LAA12262@alpha.hut.fi>, + + Files: pp.c t/op/pack.t + + ------ DOCUMENTATION ------ + + Title: "Doc bug in perldelta.pod for "Explicit blessing to ''"" + From: Christopher Masto , Tom Christiansen + + Msg-ID: <199809181852.OAA08231@tinky-winky.netmonger.net>, + <199809182017.OAA22781@jhereg.perl.com> + Files: pod/perldiag.pod + + Title: "Doc fix for split." + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlfunc.pod + + Title: "Remove duplicate diagnostic" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perldiag.pod + + Title: "Clarify sub return context" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlsub.pod + + ------ PORTABILITY - GENERAL ------ + + Title: "Update hints/README.hints" + From: Andy Dougherty + Msg-ID: + Files: hints/README.hints + + Change 1858 on 1998/09/23 by TimBunce@ig.co.uk + + Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Fix AIX pwgecos glitch" + From: Jarkko Hietaniemi + Msg-ID: <199807281243.PAA88818@vipunen.hut.fi> + Files: Configure + + ------ CORE LANGUAGE ------ + + Title: "Minor nit in glob notation" + From: Stephen McCamant + Msg-ID: <13764.54929.60137.104838@alias-2.pr.mcs.net> + Files: op.c + + Title: "Fix for command line use of source filters" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9808070959.AA28190@claudius.bfsec.bt.co.uk> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "perlfunc.pod: improve umask entry" + From: Nathan Torkington + Msg-ID: <199808131659.KAA06179@prometheus.frii.com> + Files: pod/perlfunc.pod + + Title: "Add some XS MAGIC examples to perlguts.pod" + From: Alan Burlison + Msg-ID: <199809011455.PAA00631@sale-wts> + Files: pod/perlguts.pod + + ------ EXTENSIONS ------ + + Title: "Fixes for localeconv and improved locale documentation" + From: Jarkko Hietaniemi + Msg-ID: <199807292202.BAA32156@alpha.hut.fi> + Files: pod/perllocale.pod ext/POSIX/POSIX.xs + + Title: "Fix Liblist.pm to find entries that are plain pathnames on win32" + From: Gurusamy Sarathy + Msg-ID: <199807220613.CAA05655@aatma.engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm + + Title: "Make MakeMaker handle EXE_FILES before 'test'" + From: andreas.koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/ExtUtils/MM_Unix.pm + + ------ LIBRARY ------ + + Title: "Remove commented version number in Getopt::Long" + From: Johan Vromans + Msg-ID: <13748.55168.397720.564438@phoenix.squirrel.nl> + Files: lib/Getopt/Long.pm + + Title: "Math::BigInt <=> op is not correct." + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Math/BigInt.pm t/lib/bigintpm.t + + Title: "Upgraded assorted files to 5.005_02 versions" + Files: Porting/pumpkin.pod lib/AutoLoader.pm lib/Benchmark.pm + lib/SelfLoader.pm lib/Test.pm lib/File/Spec.pm + lib/Getopt/Std.pm lib/Pod/Html.pm lib/Sys/Syslog.pm + lib/Term/ReadLine.pm lib/Test/Harness.pm + lib/Text/ParseWords.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "issues with sort in 'make test' on IRIX 6.3 IP32" + From: Andy Dougherty + Msg-ID: + Files: hints/irix_6.sh + + Title: "Update hints, Configure for MachTen 4.1.1" + From: Dominic Dunlop + Msg-ID: + Files: Configure hints/machten.sh + + Title: "Updated patchls utility" + Files: Porting/patchls + + ------ TESTS ------ + + Title: "t/op/eval.t test for eval & scoping of lexicals" + From: Anton Berezin + Msg-ID: <199807211946.VAA01301@lion.plab.ku.dk> + Files: t/op/eval.t + + Change 1580 on 1998/07/20 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Clean up hash array allocation" + From: Gurusamy Sarathy + Msg-ID: <199807201052.GAA13336@aatma.engin.umich.edu> + Files: hv.c + + Title: "Further fixes for cppstdin on HP-UX 11" + From: Andy Dougherty + Msg-ID: + Files: hints/hpux.sh + + Change 1579 on 1998/07/20 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Fix C<$1 .. $2> coredump under debugger" + From: Gurusamy Sarathy + Msg-ID: <199807200042.UAA23288@aatma.engin.umich.edu> + Files: pp_ctl.c + + Title: "Fix lvalue leaks stemming from failure to free LvTARG(sv)" + From: Gurusamy Sarathy + Msg-ID: <199807191829.OAA12433@aatma.engin.umich.edu> + Files: embed.h perl.h proto.h global.sym mg.c sv.c t/op/substr.t t/op/vec.t + + Title: "fix major bug (from 5.003_96); void contexts were using the context + of the enclosing sub!" + From: Francois Desarmenien , Gurusamy Sarathy + + Msg-ID: <199807180927.FAA08032@aatma.engin.umich.edu>, + <35B1CA51.A606AD27@club-internet.fr> + Files: op.h + + Title: "Update lib/Getopt/Long.pm (from perl5.005 beta 1)" + From: Johan Vromans + Msg-ID: <13745.47704.943964.34613@phoenix.squirrel.nl> + Files: lib/Getopt/Long.pm + + Title: "Add Porting/p4d2p utility for converting perforce diffs" + From: Gurusamy Sarathy + Msg-ID: <199807200002.UAA21398@aatma.engin.umich.edu> + Files: MANIFEST Porting/p4d2p + + Change 1577 on 1998/07/20 by TimBunce@ig.co.uk + + Title: "Make failed matches return empty list in list context" + From: "Paul E. Maisano" , Gurusamy Sarathy + , Paul Maisano + Msg-ID: <199807200002.UAA21398@aatma.engin.umich.edu>, + <199807200027.KAA27815@ironbark-ridge.aaii.oz.au>, + <35B156FB.504E66E@aaii.oz.au> + Files: pod/perlop.pod pp_hot.c t/op/pat.t + + Change 1576 on 1998/07/20 by TimBunce@ig.co.uk + + Title: "win32 update from 5.005 beta 2 for 5.004_05" + From: Gurusamy Sarathy + Msg-ID: <199807192332.TAA20905@aatma.engin.umich.edu> + Files: win32/include/dirent.h win32/include/sys/socket.h proto.h + lib/ExtUtils/Liblist.pm lib/ExtUtils/Mksymlists.pm + win32/win32.h win32/win32iop.h README.win32 installperl + pp_ctl.c win32/Makefile win32/config.bc win32/config.vc + win32/config_H.bc win32/config_H.vc win32/config_h.PL + win32/config_sh.PL win32/dl_win32.xs win32/makedef.pl + win32/makefile.mk win32/pod.mak win32/win32.c + win32/win32sck.c win32/bin/pl2bat.pl + + Change 1539 on 1998/07/18 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Minor fixes to MakeMaker docs re ExtUtils::Embed" + From: Paul Johnson + Msg-ID: <19980718155847.D903@west-tip.transeda.com> + Files: lib/ExtUtils/MakeMaker.pm + + Title: "Update t/op/array.t (from 5.005 beta 1)" + Files: t/op/array.t + + Change 1538 on 1998/07/18 by TimBunce@ig.co.uk + + Title: "Remove flawed '// with parens or $&' performance patch (Change 662)" + From: "M.J.T. Guy" , Tim Bunce , + larry@wall.org (Larry Wall) + Msg-ID: <19980717015308.E6244@ig.co.uk>, <199807171819.LAA13771@wall.org>, + + Files: cop.h embed.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c + pp_ctl.c pp_hot.c regexec.c scope.c + + Change 1525 on 1998/07/18 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Fix @a=@a=qw(...) properly" + From: Stephen McCamant + Msg-ID: <13742.49404.367751.437966@alias-2.pr.mcs.net> + Files: opcode.h + + Title: "Larry's patch to support CR LF in scripts (updated)" + From: Gisle Aas , larry@wall.org (Larry Wall) + Msg-ID: <199807120054.RAA19550@wall.org>, + Files: t/comp/multiline.t toke.c + + Title: "Change getc() docs to match behaviour. Make read() return undef on + error." + From: Gurusamy Sarathy + Msg-ID: <199807052257.SAA10004@aatma.engin.umich.edu> + Files: pod/perlfunc.pod pp_sys.c + + Title: "Update patchls utility" + Files: Porting/patchls + + Change 1521 on 1998/07/16 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Allow $SIG{CHLD}='IGNORE' to work (reap zombies) on Solaris" + From: Albert Dvornik , + Chip Salzenberg + Msg-ID: <19980708181055.A8005@perlsupport.com>, + + Files: util.c + + Title: "Document perltrap on precedence of keys/values/each" + From: Gurusamy Sarathy + Msg-ID: <199807151857.OAA04704@aatma.engin.umich.edu> + Files: pod/perltrap.pod + + Title: "perlbook.pod patch" + From: Tom Christiansen + Msg-ID: <199807140037.SAA04556@chthon.perl.com> + Files: pod/perlbook.pod + + Title: "perlmod.pod patch" + From: Tom Christiansen + Msg-ID: <199807140109.TAA04678@chthon.perl.com> + Files: pod/perlmod.pod + + Title: "Fix bug in IO::Handle->input_record_separator" + From: Robin Barker , Swen Thuemmler + + Msg-ID: <199807161400.PAA25532@tempest.cise.npl.co.uk>, + + Files: ext/IO/lib/IO/Handle.pm + + Title: "update h2ph, Math::Complex and Math::Trig (from 5.005 beta 1)" + Files: lib/Math/Complex.pm lib/Math/Trig.pm t/lib/complex.t t/lib/h2ph.t + t/lib/trig.t utils/h2ph.PL + + Title: "Update hints/irix_6.sh" + From: Scott Henry + Msg-ID: + Files: hints/irix_6.sh + + Title: "Configure misses preprocessor on HP-UX (further fix)" + From: Andy Dougherty + Msg-ID: + Files: hints/hpux.sh + + Title: "update perlbug to v1.26 (from 5.005 beta 1)" + Files: utils/perlbug.PL + + Change 1520 on 1998/07/15 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Add stub attrs.pm" + From: Graham Barr , Gurusamy Sarathy + Msg-ID: <19980713163312.A18222@asic.sc.ti.com>, + <199807132140.RAA09583@aatma.engin.umich.edu> + Files: MANIFEST lib/attrs.pm + + Title: "Fix @a=@a=qw(...)" + From: Gurusamy Sarathy , Stephen McCamant + + Msg-ID: <13737.12300.950886.821143@alias-2.pr.mcs.net>, + <199807122351.TAA05649@aatma.engin.umich.edu> + Files: op.c opcode.pl t/op/array.t + + Title: "Fix 'PERL_DESTRUCT_LEVEL=2 ./perl -DD -e 1' loop" + From: Gisle Aas , Stephen McCamant + Msg-ID: <13739.55551.205810.338648@alias-2.pr.mcs.net>, + + Files: sv.c + + Title: "Make Power MachTen use vfork() and system malloc()" + From: Dominic Dunlop , Jarkko Hietaniemi + Msg-ID: + Files: hints/machten.sh malloc.c + + Title: "Use REG_INFTY in place of hardwired constant" + From: Dominic Dunlop + Msg-ID: + Files: regcomp.h regcomp.c regexec.c + + Title: "Minor debugger fix (history adds an extra newline)" + From: Tye McQueen + Msg-ID: <199807151846.AA12653@metronet.com> + Files: lib/perl5db.pl + + Title: "Protect Term::ReadLine against non-default $/ value" + From: Ilya Zakharevich , + kstar@chapin.edu@ig.co.uk () + Msg-ID: <19980713151749.G8596@O2.chapin.edu>, + <199807132139.RAA11270@monk.mps.ohio-state.edu> + Files: lib/Term/ReadLine.pm + + Title: "Fix HP-UX 11 build (cppstdin)" + From: Andy Dougherty + Msg-ID: + Files: Configure hints/hpux.sh + + Title: "VMS filetest operator fixup (SS$_ACCONFLICT)" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980702135255.00a6ad90@ous.edu> + Files: vms/vms.c + + Change 1465 on 1998/07/13 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "Fix string substitution returncode problem" + From: Dominic Dunlop , Gurusamy Sarathy + Msg-ID: <199805271236.IAA28213@aatma.engin.umich.edu>, + + Files: pp_hot.c + + Title: "umask EXPR is fatal only if (EXPR & 0700) > 0" + From: Gurusamy Sarathy + Msg-ID: <199807111656.MAA03310@aatma.engin.umich.edu> + Files: pod/perldiag.pod pp_sys.c + + Title: "Remove reference to qsort from perlfunc.pod" + From: Gurusamy Sarathy + Msg-ID: <199807111923.PAA05124@aatma.engin.umich.edu> + Files: pod/perlfunc.pod + + Title: "Deprecate AvFILL in favor of av_len()" + From: Gurusamy Sarathy + Msg-ID: <199807111945.PAA05489@aatma.engin.umich.edu> + Files: pod/perlguts.pod + + Title: "Further clarify effects of using quotes with m operator" + From: Gurusamy Sarathy + Msg-ID: <199806201921.PAA03829@aatma.engin.umich.edu> + Files: pod/perlop.pod + + Title: "Add PERL_DESTRUCT_LEVEL=2 to test suite" + From: Tim Bunce + Files: t/TEST t/op/local.t t/op/pat.t t/op/regexp.t t/op/substr.t t/op/vec.t + + Change 1430 on 1998/07/11 by TimBunce@ig.co.uk + + Title: "Fix string substitution returncode problem" + From: Dominic Dunlop , Gurusamy Sarathy + Msg-ID: <199805271236.IAA28213@aatma.engin.umich.edu>, + + Files: pp_hot.c + + Change 1428 on 1998/07/11 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "makerel now reads local patch list from patchlevel.h" + Files: patchlevel.h Porting/makerel + + Title: "pod/pod2man.PL" + From: abigail@fnx.com + Msg-ID: <19980711080957.2106.qmail@betelgeuse.wayne.fnx.com> + Files: pod/pod2man.PL + + Title: "Clarify taint example in re.pm" + From: Tom Phoenix + Msg-ID: + Files: lib/re.pm + + Title: "Anohter ptags improvement" + From: Ilya Zakharevich + Msg-ID: <199807070059.UAA28815@monk.mps.ohio-state.edu> + Files: emacs/ptags + + Title: "_71 & _04 - Make AIX hints preserve ccflags as per docs" + From: "John L. Allen" + Msg-ID: + Files: hints/aix.sh + + Change 1425 on 1998/07/11 by TimBunce@ig.co.uk + + Title: "Add newCONSTSUB (from 5.005_70)" + Files: embed.h proto.h global.sym op.c + + Change 1424 on 1998/07/11 by TimBunce@ig.co.uk + + Title: "Assorted fixes for Sys::Syslog.pm" + From: "M.J.T. Guy" , Sean Robinson + , Tim.Bunce@ig.co.uk + Msg-ID: <01IXGLISWJ7Q0001B6@sc.maricopa.edu>, + <199805270939.KAA08453@toad.ig.co.uk>, + + Files: lib/Sys/Syslog.pm + + Change 1423 on 1998/07/11 by TimBunce@ig.co.uk + + Assorted patches: + + Title: "umask: die if EXPR & 0700 else return undef" + From: Chip Salzenberg , Jarkko Hietaniemi , + Jarkko Hietaniemi , Malcolm Beattie + , Tim.Bunce@ig.co.uk (Tim Bunce), + kstar@chapin.ed, kstar@chapin.edu@ig.co.uk () + Msg-ID: <199805291520.QAA01615@sable.ox.ac.uk>, + <199805291549.SAA01439@alpha.hut.fi>, + <199805291608.RAA29283@toad.ig.co.uk>, + <19980530105129.A24006@O2.chapin.edu>, + <19980608133037.A8793@perlsupport.com> + Files: pod/perldiag.pod pod/perlfunc.pod pp_sys.c + + Title: "File name DynaLoader.pm.PL is 8.3 unfriendly" + From: Laszlo Molnar + Msg-ID: <19980610005417.G162@cdata.tvnet.hu> + Files: MANIFEST ext/DynaLoader/Makefile.PL + + Change 1356 on 1998/07/07 by TimBunce@ig.co.uk + + Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Add Test.pm (from perl 5.004_70)" + Files: MANIFEST lib/Test.pm + + ------ EXTENSIONS ------ + + Title: "Add CR LF CRLF to Socket.pm" + From: Chris Nandor + Msg-ID: + Files: ext/Socket/Socket.pm + + ------ LIBRARY ------ + + Title: "AutoSplit upgrade (AutoSplit 1.0302 from 5.004_70)" + Files: lib/AutoSplit.pm + + Title: "Upgrade base.pm (from perl 5.004_70)" + Files: lib/base.pm + + Title: "Add File::Spec modules (from 5.004_70)" + Files: lib/File/Spec.pm lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + lib/File/Spec/Win32.pm + + ------ TESTS ------ + + Title: "fixup test for method call on undefined value" + Files: t/op/misc.t + + ------ UTILITIES ------ + + Title: "perlbug upgrade (from 5.004_70)" + Files: utils/perlbug.PL + + Title: "Upgrade perldoc (from 5.004_70)" + Files: utils/perldoc.PL + + Change 1355 on 1998/07/07 by TimBunce@ig.co.uk + + Title: "Fix memory leak in Safe module" + From: Gurusamy Sarathy + Msg-ID: <199806290544.BAA18463@aatma.engin.umich.edu> + Files: ext/Opcode/Opcode.xs ext/Opcode/Safe.pm + + Change 1354 on 1998/07/07 by TimBunce@ig.co.uk + + Title: "Better error message for $undef->method call" + From: Tim Bunce , Graham Barr , + joshua.pritikin@db.com + Msg-ID: <19980615171027.U4120@asic.sc.ti.com>, + Files: pod/perldiag.pod pp_hot.c + + Change 1349 on 1998/07/06 by TimBunce@ig.co.uk + + Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Configure: Workaround bash CDPATH oddity" + From: Andy Dougherty + Msg-ID: + Files: Configure + + Title: "Don't suppress display of Makefile recipes that invoke perl" + From: Gurusamy Sarathy + Msg-ID: <199806252213.SAA08545@aatma.engin.umich.edu> + Files: Makefile.SH + + ------ CORE LANGUAGE ------ + + Title: "one more^Wless quad unpack bug" + From: Jarkko Hietaniemi + Msg-ID: <199806301132.OAA27353@alpha.hut.fi> + Files: pp.c + + Title: "minor fixups to bring maint closer to devel for patching" + From: Gurusamy Sarathy + Msg-ID: <199805200046.UAA19284@aatma.engin.umich.edu> + Files: pod/perldiag.pod deb.c dump.c t/op/ref.t t/op/split.t taint.c util.c + + Title: "-Pw switches used together report bogus error" + From: Gurusamy Sarathy + Msg-ID: <199806252331.TAA10160@aatma.engin.umich.edu> + Files: perl.c + + Title: "Add doc and perl home page info to -v output" + From: Tom Christiansen + Msg-ID: <199802172229.PAA29309@jhereg.perl.com> + Files: perl.c + + Title: "Fix C<@a = (%a = 1)> bizarreness" + From: Gurusamy Sarathy , Tom Christiansen + + Msg-ID: <199807012026.OAA31507@jhereg.perl.com>, + <199807012339.TAA26024@aatma.engin.umich.edu> + Files: pp_hot.c + + Title: "make find_script() return saved string, reenable missing + diagnostics" + From: Gurusamy Sarathy + Msg-ID: <199806262224.SAA00422@aatma.engin.umich.edu> + Files: perl.c util.c + + Title: "minor e_script optimization" + From: Gurusamy Sarathy + Msg-ID: <199807060704.DAA25988@aatma.engin.umich.edu> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "Insecure $ENV{} message out of step with perldiag" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perldiag.pod pod/perlsec.pod + + Title: "documenting close without arguments" + From: Tom Phoenix + Msg-ID: + Files: pod/perlfunc.pod + + Title: "pod for scalar .. op" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlop.pod + + ------ EXTENSIONS ------ + + Title: "Fcntl: add few constants, enhance maintainability" + From: Jarkko Hietaniemi + Msg-ID: <199806221558.SAA18626@alpha.hut.fi> + Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs + + ------ LIBRARY ------ + + Title: "Fix undef warnings in Text::Parsewords" + From: Jarkko Hietaniemi + Msg-ID: <199806300842.LAA26409@alpha.hut.fi> + Files: lib/Text/ParseWords.pm + + Title: "Add Symbol::delete_package()" + From: Gurusamy Sarathy + Msg-ID: <199807060702.DAA25976@aatma.engin.umich.edu> + Files: pod/perlembed.pod lib/Symbol.pm + + Change 1344 on 1998/07/06 by TimBunce@ig.co.uk + + Title: "Fix for broken goto &xsub" + From: Albert Dvornik , + Msg-ID: + Files: MANIFEST pp_ctl.c t/op/goto_xs.t + + Change 1343 on 1998/07/06 by TimBunce@ig.co.uk + + Title: "Undo sub stub optimization and add comments on GV_FOO constants" + From: Gurusamy Sarathy + Msg-ID: <199807050841.EAA25114@aatma.engin.umich.edu> + Files: gv.h gv.c op.c toke.c + + Change 1310 on 1998/07/04 by TimBunce@ig.co.uk + + Remove old RE //t flag from scan_subst(). + + Change 1270 on 1998/06/30 by TimBunce@ig.co.uk + + Added lib/re.pm missing from change 1210 + + Change 1211 on 1998/06/23 by TimBunce@ig.co.uk + + Update test count in t/lib/basename.t (see change 1210) + + Change 1210 on 1998/06/23 by TimBunce@ig.co.uk + + Title: "Add C pragma to propagate tainting in m// and s///" + From: Chip Salzenberg , Gurusamy Sarathy + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <19980525155222.A18445@perlsupport.com>, + <199805261143.MAA04260@toad.ig.co.uk>, + <199805261235.IAA10371@aatma.engin.umich.edu>, + Files: MANIFEST pod/perlmodlib.pod pod/perlop.pod op.h perl.h dump.c + installperl lib/re.pm lib/File/Basename.pm mg.c op.c + pp_ctl.c pp_hot.c t/lib/basename.t t/op/taint.t toke.c + + Change 1155 on 1998/06/19 by TimBunce@ig.co.uk + + Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Clarify varargs issues in INSTALL docs" + From: Andy Dougherty + Msg-ID: + Files: INSTALL + + ------ CORE LANGUAGE ------ + + Title: "Further fixes for updated SysV IPC support" + From: Jarkko Hietaniemi + Msg-ID: <199805211644.TAA15139@alpha.hut.fi> + Files: Configure perl.h doio.c + + Title: "Fixed SEGV caused by bug in pp_hot.c:pp_sassign()" + From: Andrew Bettison + Msg-ID: + Files: pp_hot.c + + Title: "Invalidate method cache on C" + From: Chip Salzenberg + Msg-ID: <19980604134731.D24343@perlsupport.com> + Files: scope.c t/op/method.t + + Title: "fix uninitialized cv variable in op.c" + From: joshua.pritikin@db.com + Msg-ID: + Files: op.c + + Title: "fix for undef as last arg to setsockopt" + From: Graham Barr + Msg-ID: <19980603112219.B7638@asic.sc.ti.com> + Files: pp_sys.c + + Title: "Fix -i when @ARGV is empty" + From: Chip Salzenberg , Gurusamy Sarathy + , Ilya Zakharevich + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <19980606184942.A4583@perlsupport.com>, + <199806070029.UAA18709@monk.mps.ohio-state.edu>, + <199806071817.OAA28141@aatma.engin.umich.edu>, + <199806191549.QAA16376@toad.ig.co.uk> + Files: pp_hot.c + + ------ DOCUMENTATION ------ + + Title: "Discrepancy between perlop.pod and m// operator docs" + From: Tom Phoenix + Msg-ID: + Files: pod/perlop.pod + + Title: "Doc addition for perlfunc entry for system()" + From: Ilya Zakharevich , Mike Fletcher + + Msg-ID: <199806011908.PAA31069@dewdrop2.mindspring.com>, + <199806012057.QAA26830@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod + + Title: "Clarify effects of using quotes with m operator" + From: Daniel Grisinger + Msg-ID: + Files: pod/perlop.pod + + Title: "Document -i with STDIN" + From: joshua.pritikin@db.com + Msg-ID: + Files: pod/perlrun.pod + + ------ EXTENSIONS ------ + + Title: "Fix Liblist.pm to tolerate backslashen in paths" + From: Gurusamy Sarathy + Msg-ID: <199806011954.PAA10900@aatma.engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm + + ------ LIBRARY ------ + + Title: "Typo fix for Math::BogFloat" + From: Mike Stok + Msg-ID: + Files: lib/Math/BigFloat.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Add docs about types of diff to Porting/patching.pod" + From: Gurusamy Sarathy + Msg-ID: <199806090105.VAA20005@aatma.engin.umich.edu> + Files: Porting/patching.pod + + Title: "Set dont_use_nlink for PowerMAX OS 4.2" + From: Tom Horsley + Msg-ID: <199806161354.NAA21316@cleo.ssd.hcsc.com> + Files: hints/powerux.sh + + Title: "Assorted improvements to hints/solaris_2.sh" + From: Andy Dougherty + Msg-ID: + Files: hints/solaris_2.sh + + Change 1152 on 1998/06/19 by TimBunce@ig.co.uk + + Title: Tom's jumbo doc patch + From: Tom Christiansen + Msg-Id: <199806140419.WAA20549@chthon.perl.com> + Files: pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod + 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 pod/perlform.pod pod/perlfunc.pod + pod/perlipc.pod pod/perllocale.pod pod/perllol.pod + pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod + pod/perlop.pod pod/perlre.pod pod/perlref.pod + pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod + pod/perlsyn.pod pod/perltie.pod pod/perltoot.pod + pod/perlvar.pod + + Change 1038 on 1998/05/27 by TimBunce@ig.co.uk + + Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "add utilities to make test dependencies" + From: Robin Barker + Msg-ID: <2607.9805211303@tempest.cise.npl.co.uk> + Files: Makefile.SH + + Title: "Add 'make nok' complement to 'make ok'" + From: "M.J.T. Guy" + Msg-ID: + Files: Makefile.SH + + Title: "further h2ph patches (add enum support)" + From: Billy + Msg-ID: + Files: MANIFEST t/lib/h2ph.pht t/lib/h2ph.t utils/h2ph.PL + + ------ CORE LANGUAGE ------ + + Title: "Fix %! error spelling and add perldiag.pod entry" + From: Graham Barr , Tim Bunce + Msg-ID: <19980524193101.A573@pobox.com> + Files: pod/perldiag.pod gv.c + + Title: "Remove obsolete Win32 uppercasing ENV code" + From: Gurusamy Sarathy + Msg-ID: <199805201510.LAA28676@aatma.engin.umich.edu> + Files: perl.c + + Title: "Don't mung $! on implicit close" + From: Chip Salzenberg + Msg-ID: <19980525113309.A15845@perlsupport.com> + Files: doio.c + + Title: "Maint trial 3 fails on SunOS 4.1.3 with Sun cc" + From: Andy Dougherty + Msg-ID: + Files: doio.c + + ------ DOCUMENTATION ------ + + Title: "doc patch: you canna return an array ( list context: || vs or)" + From: Jarkko Hietaniemi + Msg-ID: + Files: pod/perldebug.pod pod/perlfunc.pod pod/perltie.pod pod/perltrap.pod + + Title: "doc patch: @ needs escaping in m/\Q\E/ environment" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlop.pod pod/perlre.pod + + Title: "Discrepancy between perlop.pod and m// operator", "Doc fix: Only + with /g does list context get matches without parens" + From: Greg Chapman , Tom Christiansen + , Tom Phoenix + + Msg-ID: <000201bd865e$f3bf72e0$1f04400c@assigned.well.com>, + <199805231559.JAA21316@jhereg.perl.com>, + + Files: pod/perlop.pod + + Title: "Documenting last/next/redo even further" + From: "M.J.T. Guy" , Tom Phoenix + + Msg-ID: , + + Files: pod/perlfunc.pod + + Title: "Documenting last/next/redo within continue block" + From: Tom Phoenix + Msg-ID: + Files: pod/perlfunc.pod + + Title: "Document stat return in scalar context" + From: Mark-Jason Dominus + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "Better LD_RUN_PATH handling on IRIX" + From: "W. Phillip Moore" + Msg-ID: <199805212206.SAA07504@zappa.morgan.com> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Dealing with in POSIX and SunOS" + From: Andy Dougherty + Msg-ID: + Files: ext/POSIX/hints/sunos_4.pl hints/sunos_4_1.sh ext/POSIX/POSIX.xs + + ------ LIBRARY ------ + + Title: "Fix FileHandle.pm example bug" + From: Daniel Grisinger + Msg-ID: + Files: lib/FileHandle.pm + + Title: "Add zero/negative $count docs for Benchmark.pm" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Benchmark.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Add test suite recommendations to Porting/patching.pod" + From: Daniel Grisinger + Msg-ID: + Files: Porting/patching.pod + + ------ TESTS ------ + + Title: "Fix looping bug in t/io/pipe.t" + From: "M.J.T. Guy" + Msg-ID: + Files: t/io/pipe.t + + Change 1020 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "fix up descrepancy in h2ph test" + From: Tim Bunce + Files: t/lib/h2ph.pht + + Change 1019 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "add a test to check return value from successful s/// (there was none!)" + From: Gurusamy Sarathy + Msg-ID: <199805161759.NAA12995@aatma.engin.umich.edu> + Files: t/op/subst.t + + Title: "fix up descrepancy in h2ph test" + From: Tim Bunce + Files: t/lib/h2ph.t + + Change 1018 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "fix mem leak and core dump from change 1016" + From: Tim Bunce + Files: pp_sys.c + + Change 1017 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "qsort, Win32 "POSIX" plus other devel changes for patch-compatibility" + From: Gurusamy Sarathy + Files: MANIFEST cflags.SH pod/perlembed.pod pod/perlfunc.pod + pod/perlguts.pod pod/perlref.pod pod/perlrun.pod + pod/perlxstut.pod av.h embed.h hv.h op.h perl.h pp.h + proto.h Todo av.c cygwin32/perlgcc cygwin32/perlld deb.c + doio.c doop.c ext/ODBM_File/ODBM_File.xs + ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs + gv.c hv.c interp.sym lib/AutoSplit.pm lib/Cwd.pm + lib/FindBin.pm lib/strict.pm lib/ExtUtils/Command.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm + lib/ExtUtils/Manifest.pm lib/File/Basename.pm + lib/File/Find.pm lib/File/Path.pm lib/Getopt/Long.pm + lib/Getopt/Std.pm lib/Net/Ping.pm lib/Pod/Html.pm + lib/Pod/Text.pm lib/Term/Cap.pm lib/Test/Harness.pm mg.c + op.c perl.c pod/pod2latex.PL pod/pod2man.PL pp.c pp_ctl.c + pp_hot.c pp_sys.c scope.c sv.c t/lib/posix.t + t/pragma/locale.t utils/perldoc.PL win32/win32.h toke.c + universal.c util.c win32/Makefile win32/config_H.bc + win32/config_H.vc win32/dl_win32.xs win32/makedef.pl + win32/makefile.mk win32/perlglob.c win32/runperl.c + win32/win32.c win32/win32sck.c x2p/s2p.PL + + Change 1016 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "eval { die $obj }; die; calls $obj->PROPAGATE" + From: Graham Barr + Msg-ID: <3561D147.7F3E0C88@ti.com> + Files: pp_sys.c t/op/die.t + + Change 1015 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "loosen const sub re-defined warnings" + From: Doug MacEachern + Msg-ID: <355F713B.6A4C0F04@pobox.com> + Files: proto.h global.sym op.c pp.c sv.c + + Change 1014 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "s/FORMLINE/FORMAT/ in sv.c" + From: Hugo van der Sanden + Msg-ID: + Files: sv.c + + Title: "Further h2ph patches (including a test suite)" + From: Billy + Msg-ID: + Files: MANIFEST t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t utils/h2ph.PL + + Change 1013 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "Remove change 673 (Allow empty BLOCK in code)" + From: Gurusamy Sarathy , Ilya Zakharevich + + Msg-ID: <199805151857.OAA29586@monk.mps.ohio-state.edu>, + <199805151931.PAA23086@aatma.engin.umich.edu>, + <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca> + Files: toke.c + + Change 1012 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "Further SysV sem/msg fixes and removal of non-portable tests" + From: Andy Dougherty , Jarkko Hietaniemi + + Msg-ID: <199805182028.XAA15717@alpha.hut.fi>, + + Files: MANIFEST Configure config_h.SH perl.h doio.c t/op/ipcmsg.t + t/op/ipcsem.t + + Change 1011 on 1998/05/19 by TimBunce@ig.co.uk + + Title: "interp.sym is missing C after -e fix" + From: jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <355d460d.7621669@smtp1.ibm.net> + Files: embed.h interp.sym + + Title: "Undo changed error message which breaks Tk" + From: Gurusamy Sarathy + Msg-ID: <199805161557.LAA08106@aatma.engin.umich.edu> + Files: pp_ctl.c + + Title: "Minor fixups to new -e script code" + From: Tim Bunce + Files: perl.c + + Title: "Remove old diags not relevant after -e fix" + From: Andy Dougherty , Gurusamy Sarathy + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199805172143.RAA07896@aatma.engin.umich.edu>, + <199805181335.OAA07008@toad.ig.co.uk>, + + Files: pod/perldiag.pod + + Title: "more examples for vec()" + From: Tom Phoenix + Msg-ID: + Files: pod/perlfunc.pod + + Title: ""make ok" (perlbug -ok) should not be interactive" + From: Hugo van der Sanden , Jarkko Hietaniemi + + Msg-ID: <199805160942.MAA20171@alpha.hut.fi>, + + Files: utils/perlbug.PL + + Change 999 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Update Porting/makerel script for perforce dir structure" + From: Tim Bunce + Files: Porting/makerel + + Change 996 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Negative array subscript unrecognized in regex" + From: Mark-Jason Dominus , + h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <19980425040819.13828.qmail@plover.com>, + <199805151514.RAA04121@dorlas.elsevier.nl> + Files: t/base/lex.t toke.c + + Title: "Remove e_fp from toke.c after change 955" + From: Tim Bunce + Files: toke.c + + Change 995 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Fix -e security hole (no longer uses temp file)" + From: Tim Bunce + Files: embed.h perl.h perl.c + + Change 992 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "install non-backwards compatible .pm files into archlib" + From: Tim Bunce + Files: installperl + + Title: "revert "Can't locate" message to original for maintenance" + From: Tim Bunce + Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com> + Files: pod/perldiag.pod pp_ctl.c + + Change 990 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Add tests for die $ref" + From: Graham Barr + Msg-ID: <355C6297.121B576B@ti.com> + Files: MANIFEST t/op/die.t + + Change 989 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Fix t/op/ipcmsg.t for Digital UNIX" + From: Jarkko Hietaniemi + Msg-ID: <199805151337.QAA01174@alpha.hut.fi> + Files: t/op/ipcmsg.t + + Change 986 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Patches for BeOS port of Perl, courtesy of Tom Spindler" + From: Jarkko Hietaniemi , Tom Spindler + Msg-ID: <199805042312.CAA09025@alpha.hut.fi> + Files: MANIFEST Configure config_h.SH hints/beos.sh pod/perlfunc.pod + Porting/Glossary README.beos beos/nm.c lib/Term/ReadLine.pm + plan9/config.plan9 pp_sys.c t/io/pipe.t vms/config.vms + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc + + Change 985 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "allow die $ref" + From: Graham Barr , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199805151351.OAA01985@toad.ig.co.uk>, <355C3E67.AF25B9F7@ti.com> + Files: pp_ctl.c pp_sys.c util.c + + Title: "ExtUtils::Manifest could truncate files during "make dist"" + From: "James E Jurach Jr." , + koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: <199805111048.MAA02573@arrakis.int.ein.cz>, + + Files: lib/ExtUtils/Manifest.pm + + Title: "Autosplit doesn't like upper case letters in sub names on VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980330152332.009cb130@osshe.edu> + Files: lib/AutoSplit.pm + + Title: "AutoSplit/AutoLoaded subs: give useful line numbers in warnings etc" + From: "Jesse N. Glick" , koenig@anna.mind.de (Andreas + J. Koenig), larry@wall.org (Larry Wall) + Msg-ID: <199709292015.NAA09627@wall.org>, <342FCDDF.23534195@sig.bsh.com>, + , + + Files: lib/AutoSplit.pm + + Change 984 on 1998/05/15 by TimBunce@ig.co.uk + + ------ CORE LANGUAGE ------ + + Title: "Fix close pipe returning status from wrong child" + From: "M.J.T. Guy" , kstar@chapin.edu@ig.co.uk () + Msg-ID: <199805142313.TAA02684@chapin.edu>, + + Files: t/io/pipe.t util.c + + Title: "Avoid English.pm triggering load of Errno.pm" + From: Tim Bunce + Files: gv.c lib/English.pm + + ------ DOCUMENTATION ------ + + Title: "Document child exit cause a parent sleep to end early" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "BSD Platforms need STRUCT_TM_HASZONE for POSIX" + From: Andy Dougherty + Msg-ID: + Files: MANIFEST ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl + + Title: "MM_VMS.pm fixes for building external library" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980511160542.009dd480@ous.edu> + Files: lib/ExtUtils/MM_VMS.pm + + Title: "Appease picky DEC compiler in POSIX.xs" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980511161434.009f8bb0@ous.edu> + Files: ext/POSIX/POSIX.xs + + ------ TESTS ------ + + Title: "Fix constant detection in t/op/ipcsem.t for Digit UNIX" + From: Jarkko Hietaniemi + Msg-ID: <199805121212.PAA15351@alpha.hut.fi> + Files: t/op/ipcsem.t + + Title: "Fix doc bug for system() return value" + From: Daniel Grisinger + Msg-ID: + Files: pod/perlfunc.pod t/op/exec.t + + ------ UTILITIES ------ + + Title: "Avoid possible constant autoload loop" + From: "M.J.T. Guy" , Graham Barr , Ilya + Zakharevich + Msg-ID: <199805141910.PAA26994@monk.mps.ohio-state.edu>, + <355B475A.C5AD4B90@ti.com>, + + Files: utils/h2xs.PL + + Title: "Further improvements to h2ph.PL" + From: kstar@chapin.edu + Msg-ID: <199805130241.WAA25459@chapin.edu> + Files: utils/h2ph.PL + + Change 982 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "comment init_postdump_symbols issues" + From: Tim Bunce + Files: perl.c + + Title: "Improve sort docs re SUBNAME" + From: circle@azstarnet.com + Msg-ID: <199804281828.LAA22737@andromeda.azstarnet.com> + Files: pod/perlfunc.pod + + Change 981 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Add hook to tie %! to external Errno.pm module (not included)" + From: Graham Barr + Msg-ID: <355080CD.1111BC81@ti.com> + Files: gv.c + + Change 971 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "fix C (pp_refgen fumbles when G_SCALAR, no args)" + From: Gurusamy Sarathy + Msg-ID: <199805070402.AAA02858@aatma.engin.umich.edu> + Files: pp.c + + Change 970 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "perlbug reformatted" + From: Dominic Dunlop , Hugo van der Sanden + + Msg-ID: <199805110954.LAA20367@dorlas.elsevier.nl>, + , + + Files: utils/perlbug.PL + + Change 965 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "Sub declaration cost reduced from ~500 to ~100 bytes" + From: Ilya Zakharevich + Msg-ID: <199805050607.CAA02050@monk.mps.ohio-state.edu> + Files: gv.h gv.c op.c + + Change 949 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "while($x=<>) no longer warns (implicit defined added)" + From: Nick Ing-Simmons + Msg-ID: <199805051035.LAA27365@pluto.tiuk.ti.com> + Files: MANIFEST op.c t/op/defins.t + + Change 946 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "Fix PERL_DESTRUCT_LEVEL core dumps" + From: Gurusamy Sarathy + Msg-ID: <199805062301.TAA24599@aatma.engin.umich.edu> + Files: perl.c sv.c t/op/misc.t + + Change 944 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "5.004_04-m2 Cleanup of test failures" + From: Gurusamy Sarathy + Msg-ID: <199805070416.AAA03082@aatma.engin.umich.edu> + Files: t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/taint.t + win32/config.bc win32/config.vc + + Change 922 on 1998/05/11 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "incorrect return value for hv_iterinit" + From: Gurusamy Sarathy + Msg-ID: <199805031848.OAA20618@aatma.engin.umich.edu> + Files: pod/perlguts.pod hv.c + + ------ DOCUMENTATION ------ + + Title: "perlvar.pod buglet E" + From: Achim Bohnet + Msg-ID: <9805041415.AA22185@o09.xray.mpe.mpg.de> + Files: pod/perlvar.pod + + Title: "Improve docs for warning about code after an exec()" + From: "M.J.T. Guy" , Chaim Frenkel + + Msg-ID: , + + Files: pod/perlfunc.pod + + Title: "Remove dead code from pod2man" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/pod2man.PL + + Title: "tweak doc for C" + From: Gurusamy Sarathy + Msg-ID: <199805090017.UAA06888@aatma.engin.umich.edu> + Files: pod/perlfunc.pod + + Title: "Document integer pragma effect on % operator" + From: Gisle Aas + Msg-ID: + Files: pod/perlop.pod + + Title: "Reduce rm command line length in pod/Makefile" + From: Hugo van der Sanden + Msg-ID: <199805041423.QAA13199@dorlas.elsevier.nl> + Files: pod/Makefile + + ------ EXTENSIONS ------ + + Title: "Clarify Termios usage in POSIX.pod" + From: Rocco Caputo + Msg-ID: <199805101952.PAA12738@ns.netrus.net> + Files: ext/POSIX/POSIX.pod + + ------ LIBRARY ------ + + Title: "Fix File::Find::finddepth typo in trial 2 release" + From: koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/File/Find.pm t/lib/filefind.t + + ------ PORTABILITY - GENERAL ------ + + Title: "Add Porting/patching.pod document" + From: Daniel Grisinger + Msg-ID: <199805030305.XAA16147@relay.pair.com> + Files: MANIFEST Porting/patching.pod + + Title: "hints/machten.sh: disable semctl(), align with devel version" + From: Dominic Dunlop + Msg-ID: + Files: hints/machten.sh + + Title: "Add VMS specifics to Porting/makerel" + From: Charles Bailey + Msg-ID: <01IWDK1LONRQ0026P0@cor.newman.upenn.edu>, + <199804271732.SAA13762@toad.ig.co.uk>, + <9804250212.AA27695@forte.com> + Files: Porting/makerel + + Change 913 on 1998/05/01 by TimBunce@ig.co.uk + + Update MANIFEST for trial 2. + (Porting/Contract lib/Tie/Handle.pm t/op/tiehandle.t) + + Change 912 on 1998/05/01 by TimBunce@ig.co.uk + + Add t/op/tiehandle.t as xtext to repository (see change 911) + + Change 911 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Add ERRSV, ERRHV, DEFSV and SAVE_DEFSV for XS 5.005 compatibility" + From: timbo@ig.co.uk (Tim Bunce) + Msg-ID: <199804200854.JAA01482@toad.ig.co.uk> + Files: perl.h + + Title: "Add WRITE & CLOSE to TIEHANDLE" + From: Graham Barr + Msg-ID: <34F63DC8.CA95670F@pobox.com> + Files: pod/perltie.pod lib/Tie/Handle.pm pp_sys.c t/op/tiehandle.t + + Change 910 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Add warning for Illegal hex digit" + From: Stephen P Potter , Stephen Potter + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199804232219.SAA02267@spp.users.ds.net>, + <199804271409.PAA12819@toad.ig.co.uk>, + <199804280307.WAA12332@psasolar.psa.pencom.com> + Files: pod/perldiag.pod util.c + + Title: "perl_call_method() bug fix (corrupt op pointer)" + From: "Alterman, Eugene" + Msg-ID: <510415F72ECFD111A31700A0C9B3CCDE3098@efx98digmasa.bremer-inc.com> + Files: perl.c + + Title: "Fix printf segmentation fault" + From: Hugo van der Sanden + Msg-ID: + Files: pp_hot.c + + Title: "Document changed local($a[$i],$b{$j}) behaviour re delete/splice" + From: Charles Bailey + Msg-ID: <01IVMVIHNZ36001NKH@cor.newman.upenn.edu> + Files: pod/perlsub.pod + + Change 909 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Change Ilya's do_binmode to K&R prototype and move to doio.c" + Files: doio.c util.c + + Change 907 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Runtime Carp verbosity without aliasing" + From: Joshua.Pritikin@NewYork2.dmg.deuba.com, Tim Bunce + Msg-ID: + Files: lib/Carp.pm + + Title: "Fix File::Basename to not untaint results (using new //t flag)" + From: Eric Hammond , Tom Phoenix + + Msg-ID: <199710070515.WAA00682@finity.citysearch.com>, + + Files: lib/File/Basename.pm + + Change 906 on 1998/04/28 by TimBunce@ig.co.uk + + ------ CORE LANGUAGE ------ + + Title: "5.004_04m5t1: Fix dangling references in LVs", "Fix dangling + references in LVs" + From: Spider Boardman + Msg-ID: <199804010541.AAA32615@Orb.Nashua.NH.US>, + <19980422164037.D29222@perl.org> + Files: embed.h keywords.h opcode.h perl.h proto.h doop.c global.sym mg.c + pp.c sv.c + + Title: "Fix SvGMAGIC typo in change 904" + Files: doop.c + + Change 905 on 1998/04/28 by TimBunce@ig.co.uk + + Regexp patches + + Title: "New regex flag //t to leave $1 etc. tainted" + From: Chip Salzenberg , + Tim Bunce + Msg-ID: <19980310192640.37826@cyprus> + Files: pod/perlop.pod pod/perlre.pod op.h dump.c mg.c pp_hot.c sv.c + t/op/taint.t toke.c + + Title: "Don't accidentally untaint target of s///" + From: Chip Salzenberg + Msg-ID: <19980310151756.24767@cyprus> + Files: pp_ctl.c pp_hot.c t/op/taint.t + + Title: "Allow but ignore embedded /...(?o).../ in regexp" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199804201243.OAA08244@dorlas.elsevier.nl> + Files: regcomp.c + + Change 904 on 1998/04/27 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Protect join() against double reads on undef and SvGMAGICALs" + From: Chip Salzenberg , Tim Bunce + + Msg-ID: <19980424080630.D13985@perl.org> + Files: doop.c + + Title: "Better error message for require failure" + From: epeschko@den-mdev1 (Ed Peschko) + Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com> + Files: pod/perldiag.pod pp_ctl.c + + Title: "fixes for various noises under PERL_DESTRUCT_LEVEL" + From: Gurusamy Sarathy + Msg-ID: <199804231926.PAA23969@aatma.engin.umich.edu> + Files: perl.c + + Title: "Fix nice_chunk memory leak" + From: Gurusamy Sarathy + Msg-ID: <199804052347.TAA15699@aatma.engin.umich.edu> + Files: sv.c + + Title: "-2.0 vs. -2 (was Number representations)" + From: Chip Salzenberg + Msg-ID: <19980309185652.11231@cyprus> + Files: op.c + + Title: "perl.c fixes for -DUNEXEC" + From: Matt Wette , Matthew R Wette + + Msg-ID: <199710152146.OAA07283@mr-ed.jpl.nasa.gov> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "perlcall is Perl from C, not C from Perl" + From: Steve A Fink + Files: pod/perlembed.pod + + Title: "Clarify require "Foo::Bar" non-bareword issue" + From: Dominique Dumont + Msg-ID: <199804231527.AA153445256@ss7serv.grenoble.hp.com> + Files: pod/perlfunc.pod + + Title: "(repost) new text for perlsec", "new text for perlsec" + From: Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + ------ EXTENSIONS ------ + + Title: "IO::Socket->socketpair broken (typo)" + From: Olaf Titz + Msg-ID: <19980425224535.2807.qmail@bigred.inka.de> + Files: ext/IO/lib/IO/Socket.pm + + Title: "NDBM_File man page needs Fcntl" + From: "Danny R. Faught" + Msg-ID: <199707011500.IAA00601@palrel3.hp.com> + Files: ext/NDBM_File/NDBM_File.pm + + ------ LIBRARY ------ + + Title: "Documentation discrepancy: pragmatic modules" + From: "M.J.T. Guy" , h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199804221525.RAA12695@dorlas.elsevier.nl>, + + Files: lib/strict.pm lib/subs.pm lib/vars.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Updated hints file for svr4" + From: Andy Dougherty + Msg-ID: + Files: hints/svr4.sh + + Title: "Pumpkin update -- shared libperl.so location" + From: Andy Dougherty + Msg-ID: + Files: Porting/pumpkin.pod + + Title: "perl compile fix for AIX 4.3" + From: Jens-Uwe Mager + Msg-ID: <199804261611.SAA34728@ans.helios.de> + Files: ext/DynaLoader/dl_aix.xs + + Title: "Dynaloader build on VMS", + From: pvhp@forte.com (Peter Prymmer), timbo@ig.co.uk (Tim Bunce) + Msg-ID: <199804271732.SAA13762@toad.ig.co.uk>, <9804250212.AA27695@forte.com> + Files: vms/descrip.mms + + ------ UTILITIES ------ + + Title: "Major update to h2ph.PL" + From: Billy + Msg-ID: + Files: utils/h2ph.PL + + Change 897 on 1998/04/23 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "fix for "Unbalanced string table refcount"" + From: Gurusamy Sarathy + Msg-ID: <199804042251.RAA25527@aatma.engin.umich.edu> + Files: sv.c + + Title: "Allow more lenient switch processing" + From: "John L. Allen" + Msg-ID: <199803251638.LAA22664@gateway.grumman.com> + Files: perl.c + + Title: "Add fourth arg to substr: substr EXPR,OFFSET,LEN,REPLACEMENT" + From: Gisle Aas + Msg-ID: + Files: pod/perlfunc.pod Todo opcode.pl pp.c t/op/substr.t + + Title: "Odd number of elements in hash list." + From: Tom Phoenix + Msg-ID: + Files: MANIFEST pod/perldiag.pod pp.c pp_hot.c t/op/hashwarn.t + + Title: "another destruct_level fix" + From: Gurusamy Sarathy + Msg-ID: <199804030105.UAA04400@aatma.engin.umich.edu> + Files: hv.c + + Title: "bidirectional pipe warning blues" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9804082151.AA20399@claudius.bfsec.bt.co.uk> + Files: doio.c + + Title: "stale pointers after realloc (MEXTEND in pp_print and pp_prtf)" + From: Malcolm Beattie + Msg-ID: <199801191107.LAA17979@sable.ox.ac.uk> + Files: pp_hot.c pp_sys.c + + Title: "unimplemented umask() should return undef not die" + From: kstar@chapin.edu (Kurt D. Starsinic) + Msg-ID: <199803120515.VAA08660@chapin.edu> + Files: pod/perlfunc.pod pp_sys.c + + Title: "warning for: bless $foo, """ + From: Joshua.Pritikin@NewYork2.dmg.deuba.com + Msg-ID: + Files: pod/perldiag.pod pp.c + + ------ DOCUMENTATION ------ + + Title: "Mention SWIG in perlxs.pod" + From: Steve A Fink + Msg-ID: + Files: pod/perlxs.pod + + Title: "fix-up of previous perlre.pod patch" + From: Ted Ashton + Msg-ID: <199803031540.KAA09388@ns.southern.edu> + Files: pod/perlre.pod + + Title: "long list of man page nitpicks" + From: Greg Bacon , Tom Christiansen + + Msg-ID: <199804221844.NAA08338@pluto.cs.uah.edu>, + <199804222204.QAA20805@jhereg.perl.com> + Files: pod/perlapio.pod pod/perlcall.pod pod/perldebug.pod pod/perldelta.pod + pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod + pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod + pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod + pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod + pod/perlre.pod pod/perlref.pod pod/perlrun.pod + pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod + pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod + pod/pod2man.PL + + Title: "document that system() does not set $! when it fails" + From: "Mark R. Levinson" + Msg-ID: <199803011946.OAA31942@anaximander.dccs.upenn.edu> + Files: pod/perlfunc.pod + + Title: "Fix pod/roffitall execute permission" + From: lvirden@cas.org + Msg-ID: <1997Nov17.132031.2589892@cor.newman> + Files: pod/roffitall + + Title: "document when split ignores trailing empty fields" + From: Hugo van der Sanden + Msg-ID: + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "Buglet in Opcode.pm documentation" + From: Horst von Brand + Msg-ID: <199804170349.XAA32445@sleipnir.valparaiso.cl> + Files: ext/Opcode/Opcode.pm + + Title: "Failure to append to perllocal.pod should not be fatal" + From: koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Document that IO.pm does not load IO::Select etc" + From: Graham Barr + Msg-ID: <353B48F1.64E35A63@ti.com> + Files: ext/IO/IO.pm + + Title: "Install extensions with bootstrap (again) in $archlib" + From: Achim Bohnet , koenig@kulturbox.de (Andreas J. + Koenig) + Msg-ID: <9804061909.AA12675@o09.xray.mpe.mpg.de>, + + Files: lib/ExtUtils/Install.pm + + Title: "glibc2.0.6 missing MSG_* defines." + From: Andy Dougherty + Msg-ID: + Files: ext/Socket/Socket.xs + + ------ LIBRARY ------ + + Title: "Benchmark.pm: add run-for-some-time mode" + From: Jarkko Hietaniemi + Msg-ID: <199804080647.JAA15136@alpha.hut.fi> + Files: lib/Benchmark.pm + + Title: "Comments added to Carp.pm" + From: Andy Wardley , Chip Salzenberg + , Tom Christiansen + + Msg-ID: <19980422164242.E29222@perl.org>, + <199804222033.OAA17959@jhereg.perl.com>, + <980409182357.ZM21638@bandanna> + Files: lib/Carp.pm + + Title: "chat2.pl fix" + From: Charles Bailey + Msg-ID: <01IVMVF507PO001NKH@cor.newman.upenn.edu> + Files: lib/chat2.pl + + Title: "lib/Pod/Html.pm" + From: d-lewart@uiuc.edu (Daniel S. Lewart) + Msg-ID: <199710170718.DAA25472@staff1.cso.uiuc.edu>, + <199710180417.AAA19778@staff2.cso.uiuc.edu> + Files: lib/Pod/Html.pm + + Title: "ormaments method in Term/ReadLine.pm causes warning with string + arg." + From: hiroo.hayashi@computer.org + Msg-ID: <199804061519.AAA21907@mail.fb3.so-net.ne.jp> + Files: lib/Term/ReadLine.pm + + ------ OTHER CHANGES ------ + + Title: "ptags broken" + From: Ilya Zakharevich + Msg-ID: <199804120208.WAA29264@monk.mps.ohio-state.edu> + Files: emacs/ptags + + ------ PORTABILITY - WIN32 ------ + + Title: "win32 tweaks (signals and crypt support)" + From: Gurusamy Sarathy + Msg-ID: <199804170505.BAA06413@aatma.engin.umich.edu> + Files: perl.h win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/win32.c + + ------ PORTABILITY - GENERAL ------ + + Title: "Add Social Contract (2nd Draft) as Porting/Contract" + From: Russ Allbery + Msg-ID: + Files: Porting/Contract + + Title: "Config: Irix 5 hints" + From: kstar@O2.chapin.edu + Msg-ID: <199804061712.NAA22823@O2.chapin.edu> + Files: hints/irix_5.sh + + Title: "VMS patches to 5.004_03" + From: Charles Bailey + Msg-ID: <01IVYJS0L8D200209B@cor.newman.upenn.edu> + Files: vms/vms.c + + Title: "hints/netbsd.sh - enable vfork" + From: Andy Dougherty + Msg-ID: + Files: hints/netbsd.sh + + ------ UTILITIES ------ + + Title: "support find2perl -follow" + From: Billy + Msg-ID: + Files: x2p/find2perl.PL + + Change 896 on 1998/04/22 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Additional regex-cache patch" + From: Chip Salzenberg + Msg-ID: <19980305104831.38100@cyprus> + Files: pp_ctl.c + + Title: "Conservative C<*x = undef> patch" + From: Chip Salzenberg + Msg-ID: <19980310163310.48509@cyprus> + Files: pod/perldiag.pod pod/perlfunc.pod pp.c sv.c t/op/gv.t + + Title: "Consider @ARGV to be plain files if inplace (-i)" + From: Chip Salzenberg + Msg-ID: <199802042106.QAA04082@nielsenmedia.com> + Files: doio.c + + Title: "Fix semctl for Linux, Sun and SVR4" + From: Graham Barr , lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <3484247D.BB036D39@ti.com>, <9712021313.AA11495@cas.org> + Files: doio.c + + Title: "C entails using C, not C" + From: Gurusamy Sarathy + Msg-ID: <199803070149.UAA12217@aatma.engin.umich.edu> + Files: pod/perlcall.pod pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod + doio.c doop.c ext/DB_File/DB_File.xs + ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs + ext/POSIX/POSIX.xs ext/Socket/Socket.xs gv.c + lib/ExtUtils/typemap mg.c os2/OS2/REXX/REXX.xs + win32/win32.c + + Title: "Make autouse -w-safe" + From: Ilya Zakharevich + Msg-ID: <199803030236.VAA13244@monk.mps.ohio-state.edu> + Files: lib/autouse.pm op.c sv.c + + Title: "Misleading error on close of unopened handle" + From: "M.J.T. Guy" + Msg-ID: + Files: doio.c + + Title: "Confusing error from perl -e "x'"" + From: Hans Mulder + Msg-ID: <1998Mar25.174320.2866352@cor.newman.upenn.edu> + Files: toke.c + + Title: "Add HAS_GNULIBC define" + From: Andy Dougherty + Msg-ID: + Files: config_H config_h.SH + + Title: "h_errno might not be an int" + From: Andy Dougherty + Msg-ID: + Files: pp_sys.c + + Title: "Revised taint hole closer", "Revised taint hole closer" + From: Chip Salzenberg , Ilya Zakharevich + + Msg-ID: <19980310222127.09350@cyprus>, + <199803110554.AAA29157@monk.mps.ohio-state.edu> + Files: doio.c + + Title: "SEGV compiling localised lexical in perl5.004_05t1" + From: Gurusamy Sarathy , h.sanden@elsevier.nl (Hugo + van der Sanden) + Msg-ID: <199803171530.QAA24053@dorlas.elsevier.nl>, + <199803171727.MAA05234@aatma.engin.umich.edu> + Files: op.c t/op/misc.t + + Title: "Stale SP in pp_substr" + From: Stephen McCamant + Msg-ID: + Files: pp.c + + Title: "Statement unlikely to be reached warning" + From: Hans Mulder + Msg-ID: <1997Dec24.171511.2683516@cor.newman> + Files: op.c + + Title: "Tainting propagates from nowhere" + From: Gurusamy Sarathy + Msg-ID: <199803140411.XAA09343@aatma.engin.umich.edu> + Files: pp.c + + Title: "two trivial tweaks to 5.004m5t1" + From: Gurusamy Sarathy + Msg-ID: <199803060553.AAA28461@aatma.engin.umich.edu> + Files: proto.h win32/Makefile + + Title: "unpacking negatives on Alpha" + From: Achim Bohnet + Msg-ID: <9710201503.AA24797@o09.xray.mpe.mpg.de> + Files: pp.c t/op/pack.t + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "Cwd.pm: abs_path() and fast_abs_path() plus code merge" + From: Graham Barr + Msg-ID: <3482F365.4A0486BA@ti.com> + Files: lib/Cwd.pm + + Title: "Math/BigInt.pm, fixed use of undefined value." + From: abigail@fnx.com + Msg-ID: <19980313052452.27365.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Math/BigInt.pm + + Title: "File::Find rewrite" + From: Ilya Zakharevich + Msg-ID: <199803052344.SAA01008@monk.mps.ohio-state.edu> + Files: lib/File/Find.pm + + Title: "efficient version of strict.pm" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: lib/strict.pm + + Title: "Socket occasional SEGV in pack_sockaddr_un" + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + + Title: "Warning on mis-use of 'use lib'" + From: "M.J.T. Guy" , + Tom Phoenix , + Chip Salzenberg + Msg-ID: <199801270435.XAA14147@cyprus.atlantic.net>, + , + + Files: lib/lib.pm + + Title: "bug in Class::Struct" + From: Tom Christiansen + Msg-ID: <199803290814.KAA05699@toy.perl.com> + Files: lib/Class/Struct.pm + + Title: "Allow POSIX to export nice()" + From: bkeelerx@iwa.dp.intel.com (Bruce J. Keeler) + Msg-ID: + Files: ext/POSIX/POSIX.pm + + Title: "'use Env' on WinNT/95 fails" + From: Gurusamy Sarathy + Msg-ID: <199803280511.AAA15933@aatma.engin.umich.edu> + Files: lib/Env.pm + + ------ OTHER CHANGES ------ + + Title: "mv-if-diff" + From: Robin Barker + Msg-ID: <14572.9803271806@tempest.cise.npl.co.uk> + Files: mv-if-diff + + ------ PORTABILITY - WIN32 ------ + + Title: "fix various problems with backticks on win32" + From: Gurusamy Sarathy + Msg-ID: <199803070705.CAA15945@aatma.engin.umich.edu> + Files: win32/config_h.PL win32/win32.c + + ------ TESTS ------ + + Title: "Fix bug in locale.t" + From: Jarkko Hietaniemi + Msg-ID: <199801042148.XAA08599@alpha.hut.fi> + Files: t/pragma/locale.t + + Change 887 on 1998/04/10 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Re: die exits with 0" + From: Robin Barker + Files: perl.c t/op/die_exit.t + + Title: "More toke.c commentary; fix oddity" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199803251022.LAA01308@dorlas.elsevier.nl> + Files: toke.c + + Title: "for semctl on solaris" + From: Graham Barr + Msg-ID: <34624B80.C014E841@ti.com> + Files: doio.c t/op/ipcmsg.t t/op/ipcsem.t + + ------ DOCUMENTATION ------ + + Title: "Add more 'see also's to perlre.pod.", "Perl regexp /g modifier bug" + From: Ilya Zakharevich , epeschko@den-mdev1 (Ed + Peschko), pjr@watcher.telstra.com.au (Peter Richardson) + Msg-ID: <199803050000.LAA11476@watcher.telecom.com.au>, + <199803050231.VAA19128@monk.mps.ohio-state.edu>, + <199803050605.XAA09785@den-mdev1.co.csgsystems.com> + Files: pod/perlre.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "BigFloat - small neagtive numbers cause panic" + From: Hugo van der Sanden + Msg-ID: <199711201325.NAA09732@crypt.compulink.co.uk> + Files: lib/Math/BigFloat.pm + + Title: "Update Getopt::Long to 2.16" + From: JVromans@Squirrel.nl (Johan Vromans), Johan Vromans + + Msg-ID: <13571.48089.726787.147769@plume.nl.compuware.com>, + <13572.6847.863219.973795@phoenix.squirrel.nl> + Files: lib/Getopt/Long.pm + + Title: "New Text::ParseWords" + From: pomeranz@netcom.com (Hal Pomeranz) + Msg-ID: <199710162118.OAA06275@netcom7.netcom.com> + Files: lib/Text/ParseWords.pm t/lib/parsewords.t + + Title: "Fixed Text/Wrap.pm bugs (2)" + From: Jacqui Caren + Msg-ID: <199709291548.QAA08645@toad.ig.co.uk> + Files: lib/Text/Wrap.pm + + Title: "Very *evil* File::CheckTree behavior! (now uses warn/die not + print/exit)" + From: Eryq , Randal Schwartz + Msg-ID: <34B542FD.190A@zeegee.com>, <8cen2i9k6f.fsf@gadget.cscaper.com> + Files: lib/File/CheckTree.pm + + ------ OTHER CHANGES ------ + + Title: "Add ./emacs/ptags" + From: Ilya Zakharevich + Msg-ID: <199803150847.DAA08196@monk.mps.ohio-state.edu> + Files: emacs/ptags + + ------ TESTS ------ + + Title: "Avoid stat test failure from build in /tmp (tmpfs)", "Build in /tmp" + From: Andy Dougherty , Greg Bacon + , pudge@pobox.com (Chris Nandor) + Msg-ID: <199710171616.LAA13435@crp-201.adtran.com>, + , + + Files: t/op/stat.t + + Title: "for failure with lib/timelocal" + From: "M.J.T. Guy" , jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <34c78f61.2529827@smtp1.ibm.net>, + + Files: t/lib/timelocal.t + + Title: "Make "localhost" related failures more clear" + From: Paul Hoffman + Msg-ID: <199801201859.KAA05686@mail.proper.com> + Files: t/lib/io_sock.t t/lib/io_udp.t + + ------ UTILITIES ------ + + Title: "Let h2xs read multiple header files" + From: Andy Dougherty , Benjamin Sugars + + Msg-ID: , + + Files: utils/h2xs.PL + + Change 886 on 1998/04/10 by TimBunce@ig.co.uk + + Changes relating primarily to portability. + + ------ CORE LANGUAGE ------ + + Title: "5.004_55: Another round of OS/2 patches" + From: Ilya Zakharevich + Msg-ID: <199803050945.EAA20153@monk.mps.ohio-state.edu> + Files: hints/os2.sh pod/perlguts.pod cop.h perl.h proto.h README.os2 + global.sym lib/ExtUtils/MM_OS2.pm lib/File/Path.pm op.c + os2/Changes os2/Makefile.SHs os2/os2.c os2/perl2cmd.pl + perl.c pod/pod2man.PL pp_ctl.c pp_hot.c pp_sys.c + t/lib/filecopy.t util.c utils/perldoc.PL + + Title: "VMS: chdir() with empty arg list" + From: lane@duphy4.drexel.edu (Charles Lane) + Msg-ID: <980317125556.222041c7@DUPHY4.Physics.Drexel.Edu> + Files: pp_sys.c + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "ExtUtils/MM_Unix.pm changed to use ld -rpath on IRIX" + From: "W. Phillip Moore" + Msg-ID: <199712011738.MAA21139@zappa.morgan.com> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "[Linux] POSIX::_[PS]C_.+ bug (add HINT_SC_EXIST)" + From: Yutaka OIWA + Msg-ID: <199712251923.EAA08260@tjms1f.is.s.u-tokyo.ac.jp> + Files: ext/POSIX/hints/linux.pl ext/POSIX/POSIX.xs + + Title: "5.004_04-m1] Use HAS_GNULIBC in POSIX.xs" + From: Andy Dougherty + Msg-ID: + Files: ext/POSIX/POSIX.xs + + Title: ""ODBM_File.c", line 275: NULL undefined" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9803091310.AA23264@claudius.bfsec.bt.co.uk> + Files: ext/ODBM_File/ODBM_File.xs + + ------ PORTABILITY - GENERAL ------ + + Title: "5.004_04 QNX getcwd" + From: Norton Allen + Msg-ID: <199802121838.NAA20452@dolores.harvard.edu>, + <199803061511.KAA22346@bottesini.harvard.edu> + Files: hints/qnx.sh lib/Cwd.pm t/op/magic.t + + Title: "hints/netbsd.sh d_setrgid d_setruid" + From: Jarkko Hietaniemi + Msg-ID: <199802281435.QAA10866@alpha.hut.fi> + Files: hints/netbsd.sh + + Title: "osname=unixware, osvers=2.03, archname=i386-unixware + d_casti32=undef" + From: Tom Hughes + Msg-ID: <465398da47%tom@compton.demon.co.uk> + Files: hints/svr4.sh + + Title: "hints/bsdos.sh patch for BSDI 3.1" + From: Jan-Pieter Cornet + Msg-ID: <6fbip6$3cp$1@xs1.xs4all.nl> + Files: hints/bsdos.sh + + Title: "Remove BIND_NOSTART from DynaLoader for HP" + From: Keong Lim + Msg-ID: <01BD1D03.53B65E90@sieplan2.sr.com.au> + Files: ext/DynaLoader/dl_hpux.xs + + Title: "Building Perl on AIX 4+ with shared libraries and dynamic loading" + From: Juan Gallego + Msg-ID: + Files: hints/aix.sh + + Title: "alpha-dec_osf 5.0" + From: Spider Boardman + Msg-ID: <199712232305.SAA08359@Orb.Nashua.NH.US> + Files: hints/dec_osf.sh + + Title: "Off-by-one error with OS2::PrfDB" + From: Ilya Zakharevich + Msg-ID: <199710170920.FAA00390@monk.mps.ohio-state.edu> + Files: os2/OS2/PrfDB/PrfDB.xs + + Title: "5.004_04-m1] Allow overrides in hints/openbsd.sh" + From: Andy Dougherty + Msg-ID: + Files: hints/openbsd.sh + + Title: "5.004_04-m1] Linux shouldn't use -lnet" + From: Andy Dougherty + Msg-ID: + Files: hints/linux.sh + + Title: "5.004_(04|63)] Close VMS security hole" + From: Charles Bailey + Msg-ID: <01IV6LRJCSSC0009C4@cor.newman.upenn.edu> + Files: vms/vms.c + + Title: "Re: Perl online documentation on OpenVMS" + From: pvhp@forte.com (Peter Prymmer) + Msg-ID: <9803192143.AA28120@forte.com> + Files: README.vms + + Title: "Perl5.004_04m4t4 *almost* makes it for VMS", "Updated + vms/perly_c.vms and vms/perly_h.vms" + From: Andy Dougherty , Dan Sugalski + , larry@wall.org (Larry Wall) + Msg-ID: <199710151650.JAA29185@wall.org>, + <3.0.3.32.19971014150404.02fdef78@osshe.edu>, + + Files: vms/perly_c.vms + + Title: "Updated, non-wordwrapped, patch to README.VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980213133828.0092c870@osshe.edu> + Files: README.vms + + Title: "VMS patches to 5.004_03 (excluding installperl and timelocal.t)" + From: Charles Bailey + Msg-ID: <01INZT9G2LZS0006YW@cor.newman.upenn.edu> + Files: lib/File/Basename.pm lib/File/Path.pm vms/config.vms vms/descrip.mms + vms/genconfig.pl vms/test.com vms/vms.c vms/ext/Filespec.pm + vms/ext/filespec.t + + Title: "Re: VMSperl crashes on -Mblib argument" + From: bailey@newman.upenn.edu (Charles Bailey) + Msg-ID: <1997Dec10.004439.2635060@cor.newman> + Files: lib/blib.pm vms/vms.c + + Title: "hints/linux.sh (MkLinux / PPC)" + From: pudge@pobox.com (Chris Nandor) + Msg-ID: + Files: hints/linux.sh + + Title: "hpux.sh hints file clarification suggestion" + From: root@qad.com + Msg-ID: <199802192351.QAA09096@jhereg.perl.com> + Files: hints/hpux.sh + + Title: "new hints/solaris_2.sh" + From: "M.J.T. Guy" + Msg-ID: + Files: hints/solaris_2.sh + + Change 873 on 1998/04/03 by TimBunce@ig.co.uk + + Title: "FileHandle Documentation patch" + From: "Darren/Torin/Who Ever..." + Msg-ID: <87emzqo49g.fsf@perv.daft.com> + Files: lib/FileHandle.pm + + Change 872 on 1998/04/03 by TimBunce@ig.co.uk + + Documentation and documentation related patches: + + ------ BUILD PROCESS ------ + + Title: "Docs re /usr/bin/perl quasi-standard location" + From: Tom Phoenix + Msg-ID: + Files: INSTALL pod/perlrun.pod + + ------ DOCUMENTATION ------ + + Title: "/RFC|RFC-1305/ non-greedy" + From: Jan-Pieter Cornet + Msg-ID: <6epo02$c4r$1@xs1.xs4all.nl> + Files: pod/perlre.pod + + Title: "5.004_04: perlhist.pod, buildtoc, perltoc.pod" + From: Jarkko Hietaniemi + Msg-ID: <199802191543.RAA29231@alpha.hut.fi> + Files: pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + + Title: "5.004_04: pod/perlfunc.pod: i18n example for localtime()" + From: Jarkko Hietaniemi + Msg-ID: <199711141555.RAA18875@alpha.hut.fi> + Files: pod/perlfunc.pod + + Title: "typo-fix and suggestion for perlguts.pod" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199803051543.QAA03097@dorlas.elsevier.nl> + Files: pod/perlguts.pod + + Title: "perlfunc/syscall curiosity" + From: Roderick Schertler , Tkil + + Msg-ID: <199711302259.PAA02134@reptile.scrye.com>, + + Files: pod/perlfunc.pod + + Title: "Document sprintf %#x behaviour for zero value" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Nov5.185959.2539604@cor.newman> + Files: pod/perlfunc.pod + + Title: "NUL termination (was Re: STOP THE PRESSES)" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlguts.pod + + Title: "Typo fix." + From: abigail@fnx.com + Msg-ID: <19971101120114.1030.qmail@betelgeuse.wayne.fnx.com> + Files: pod/perlop.pod pod/perlvar.pod + + Title: "5.004_63 perlrun.pod: _DEBUG_MSTATS" + From: Achim Bohnet + Msg-ID: <9803181940.AA22587@o09.xray.mpe.mpg.de> + Files: pod/perlrun.pod + + Title: "Re: Conservative C<*x = undef> patch" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perltrap.pod + + Title: "perlfunc.pod for flock()" + From: "Jeremy D. Zawodny" + Msg-ID: <3.0.5.32.19971118203119.00a723e0@woody.wcnet.org> + Files: pod/perlfunc.pod + + Title: "buglet: 'perltoc' not mentioned in perl.pod" + From: Tkil + Msg-ID: <19971127035036.17668.qmail@scrye.com> + Files: pod/perl.pod + + Title: "for() and map() peculiarity" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlsyn.pod + + Title: "Re: new text for perlsec" + From: Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + Title: "perldsc's debugger x command" + From: Roderick Schertler + Msg-ID: <10669.878352893@eeyore.ibcinc.com> + Files: pod/perldsc.pod + + Title: "perlre.pod" + From: Ted Ashton + Msg-ID: <199802271501.KAA09279@ns.southern.edu> + Files: pod/perlre.pod + + Title: "Re: printf and $\", "printf and $\" + From: Roderick Schertler , Tom Phoenix + , nag + Msg-ID: <199711141918.TAA08096@flirble.org>, + , + Files: pod/perlfunc.pod + + Title: "recv() typo" + From: Roderick Schertler + Msg-ID: <12064.877012073@eeyore.ibcinc.com> + Files: pod/perlfunc.pod + + Title: "truncate return value" + From: Roderick Schertler + Msg-ID: <5490.878337883@eeyore.ibcinc.com> + Files: pod/perlfunc.pod + + Title: "update to perlbook.pod" + From: "Nathan V. Patwardhan" , Randal Schwartz + , Stephen Potter + , Tom Phoenix + + Msg-ID: <199803241354.HAA23938@psasolar.psa.pencom.com>, + <199803241441.OAA01261@mediaone.net>, + <8clnu0i05k.fsf@gadget.cscaper.com>, + + Files: pod/perlbook.pod + + Title: "utime documentation" + From: "Brandon S. Allbery KF8NH" , "M.J.T. Guy" + + Msg-ID: <199802180256.VAA11369@speaker.kf8nh.apk.net>, + + Files: pod/perlfunc.pod + + Title: "(well, doc patch) use of // requires successful match" + From: Roderick Schertler + Msg-ID: + Files: pod/perlop.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "MakeMaker PM doc patch and a DIR buglet" + From: Achim Bohnet + Msg-ID: <9711101050.AA13868@o09.xray.mpe.mpg.de> + Files: lib/ExtUtils/MakeMaker.pm + + Title: "bareword clarification for constant.pm" + From: Roderick Schertler + Msg-ID: <6460.878143077@eeyore.ibcinc.com> + Files: lib/constant.pm + + Title: "integer rand - bug or feature?" + From: Roderick Schertler + Msg-ID: + Files: lib/integer.pm + + ------ OTHER CHANGES ------ + + Title: "FileHandle Documentation patch" + From: "Darren/Torin/Who Ever..." + Msg-ID: <87emzqo49g.fsf@perv.daft.com> + + Title: "perl5.004_61 myconfig updates" + From: Andy Dougherty + Msg-ID: + Files: myconfig + + Title: "small fixups in pod2latex.PL" + From: "Darren/Torin/Who Ever..." + Msg-ID: <873eg6o3v2.fsf@perv.daft.com> + + ------ PORTABILITY - GENERAL ------ + + Title: "Misc doc fixes for README.VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980121113134.00924a20@osshe.edu> + Files: README.vms + + Title: "moved DynaLib" + From: John Tobey + Msg-ID: <199710182332.XAA21630@remote212> + Files: ext/DynaLoader/DynaLoader.pm.PL + + ------ UTILITIES ------ + + Title: "Searching for FAQs (patch to perldoc)" + From: Piers Cawley , Russ Allbery + Msg-ID: , + + Files: utils/perldoc.PL + + Title: "perldoc" + From: Ted Ashton + Msg-ID: <199802271510.KAA10506@ns.southern.edu> + Files: utils/perldoc.PL + + Title: "perldoc -f not using pod2man" + From: Russ Allbery + Msg-ID: + Files: utils/perldoc.PL + + Title: "perldoc -m should not require pod" + From: Robin Houston + Msg-ID: <199803241319.NAA24777@stringfellow.guardian.co.uk> + Files: utils/perldoc.PL + + Title: "small fix for perldoc in perl 5.004_04" + From: Julian Yip + Msg-ID: + Files: utils/perldoc.PL + + Change 764 on 1998/03/05 by TimBunce@ig.co.uk + + APPLLIB_EXP now has arch and version dirs added to @INC + + Change 761 on 1998/03/05 by TimBunce@ig.co.uk + + Title: "properly refcount localization, fix C" + From: Gurusamy Sarathy + Msg-ID: <199802191207.MAA10742@toad.ig.co.uk> + Files: av.c hv.c scope.c t/op/local.t + + Change 758 on 1998/03/04 by TimBunce@ig.co.uk + + perldoc -f now uses pager if text is too long for screen + + Change 757 on 1998/03/04 by TimBunce@ig.co.uk + + Added OpenBSD hint file from + Document 'warn with no args' behaviour, from + + Change 756 on 1998/03/04 by TimBunce@ig.co.uk + + Fix for new gnulibc stdio.h when using sfio+perlio + + Change 755 on 1998/03/04 by TimBunce@ig.co.uk + + Fixed typo in vms/ext/Stdio/Stdio.pm AUTOLOAD + Added details of split in scalar context to perlfunc.pod + + Change 754 on 1998/03/04 by TimBunce@ig.co.uk + + Updated perl -v info to include reference to docs and home page. + + Change 753 on 1998/03/04 by TimBunce@ig.co.uk + + Updated hints/bsdos.sh for BSD/OS 3.1 + Fixed typo in pod/perlsyn.pod + Added workaround for old gmake in ext/SDBM_File/sdbm/Makefile.PL + Fixed typo in ext/GDBM_File/GDBM_File.pm + + Change 752 on 1998/03/04 by TimBunce@ig.co.uk + + Changed bug address in README to perlbug@perl.com + Changed Copyright in perl.c to 1998 + Added op/pos.t test from Robin Houston + + Change 751 on 1998/03/04 by TimBunce@ig.co.uk + + Make t/comp/require.t and t/lib/ph.t executable in repository + + Change 750 on 1998/03/04 by TimBunce@ig.co.uk + + Added dTHR definition to ease backwards compatibility for XS + source code from 5.005. + + Change 749 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "rename local 'op' variables to 'o'", #F114 + From: Gurusamy Sarathy + Files: op.h opcode.h proto.h dump.c op.c opcode.pl pp_ctl.c run.c scope.c + toke.c + + Change 748 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "consolidated win32 patch", #F112 + From: Gurusamy Sarathy + Files: MANIFEST pod/perlfaq2.pod pod/perlrun.pod win32/include/sys/socket.h + EXTERN.h INTERN.h dosish.h lib/ExtUtils/Command.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm t/TEST + t/harness win32/win32.h win32/win32iop.h README.win32 + doio.c installhtml installperl pp_sys.c win32/Makefile + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/config_h.PL win32/config_sh.PL + win32/dl_win32.xs win32/makedef.pl win32/makefile.mk + win32/perllib.c win32/runperl.c win32/win32.c + win32/win32sck.c win32/bin/perlglob.pl x2p/a2p.h x2p/a2p.c + x2p/a2py.c + + Change 747 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "initialize @INC in ph.t, and fix up MANIFEST", #F111 + From: Gurusamy Sarathy + Files: MANIFEST t/lib/ph.t + + Change 746 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "properly save STDOUT during system() in debugger", #F110 + From: Jason Smith + Files: lib/perl5db.pl + + Change 745 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "generate DynaLoader.pm at build time", #F109 + From: Achim Bohnet + Msg-ID: <9802111938.AA26224@o09.xray.mpe.mpg.de> + Files: MANIFEST ext/DynaLoader/DynaLoader.pm.PL ext/DynaLoader/Makefile.PL + + Change 744 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Install extensions with bootstrap in $archlib", #F108 + From: koenig@anna.mind.de (Andreas J. Koenig), koenig@kulturbox.de (Andreas + J. Koenig) + Msg-ID: + Files: lib/ExtUtils/Install.pm + + Change 743 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Pod::Html trips over "C<0>"", #F107 + From: Chip Salzenberg + Files: lib/Pod/Html.pm + + Change 742 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "5.004_58 | _04: pod2*,perlpod: L", #F106 + From: Achim Bohnet + Msg-ID: <9802111629.AA00595@o09.xray.mpe.mpg.de> + Files: pod/perlpod.pod lib/Pod/Html.pm lib/Pod/Text.pm pod/pod2man.PL + + Change 741 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "New patch for $^E==GetLastError() under Win32", #F105 + From: Gurusamy Sarathy , Tye McQueen + , ilya@math.ohio-state.edu (Ilya + Zakharevich) + Msg-ID: <199801040630.AA29298@metronet.com>, + <199801041826.NAA11568@aatma.engin.umich.edu>, + <1998Jan4.130412.2719461@cor.newman> + Files: pod/perlfunc.pod pod/perlvar.pod doio.c lib/dumpvar.pl lib/perl5db.pl + win32/win32.h mg.c util.c win32/makedef.pl win32/win32.c + + Change 740 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "5.004_56: Patch to Tie::Hash and docs", #F104 + From: Ilya Zakharevich + Msg-ID: <199801120134.UAA05437@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod lib/Tie/Hash.pm + + Change 739 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "more doc for perldoc", #F103 + From: Gurusamy Sarathy + Files: utils/perldoc.PL + + Change 738 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Make perldoc look for an index file ", #F102 + From: Gisle Aas + Msg-ID: <199801221220.NAA22902@furu.g.aas.no> + Files: utils/perldoc.PL + + Change 737 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "perldoc -F filename", #F101 + From: Ilya Zakharevich + Msg-ID: <199712120037.TAA00176@math.mps.ohio-state.edu> + Files: utils/perldoc.PL + + Change 736 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "sv_grow can fail for HAS_64K_LIMIT systems", #F100 + From: Gisle Aas + Msg-ID: + Files: sv.c + + Change 735 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Benchmark.pm: timethese corrupts $_", #F099 + From: abigail@fnx.com + Msg-ID: <19980201114609.7779.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Benchmark.pm + + Change 734 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "STRANGE_MALLOC should test failed alloc", #F098 + From: Gisle Aas + Msg-ID: <199802021406.PAA03285@furu.g.aas.no> + Files: hv.c + + Change 733 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "support caseless %ENV", #F097 + From: Gurusamy Sarathy + Files: hv.c t/op/magic.t win32/win32.h + + Change 732 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "newer cperl-mode.el (from 5.004_60)", #F096 + From: Ilya Zakharevich + Files: emacs/cperl-mode.el + + Change 731 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Handle set magic on xsub OUTPUT args, add API functions that handle + magic", #F095 + From: Gurusamy Sarathy + Msg-ID: <199801190409.XAA26710@aatma.engin.umich.edu> + Files: pod/perlguts.pod pod/perlxs.pod embed.h proto.h sv.h global.sym + lib/ExtUtils/xsubpp sv.c + + Change 730 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Fix flawed cleanup when signal handlers are not defined", #F094 + From: Gurusamy Sarathy + Msg-ID: <199710290106.UAA11485@aatma.engin.umich.edu> + Files: mg.c + + Change 729 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Tests for C", #F093 + From: Hugo van der Sanden + Msg-ID: <199711021247.MAA01743@crypt.compulink.co.uk> + Files: t/op/sort.t + + Change 728 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Make search.pl work on win32", #F092 + From: Gurusamy Sarathy + Files: win32/bin/search.pl + + Change 721 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix spurious perldoc warnings on DOSISH platforms", #F091 + From: Molnar Laszlo + Msg-ID: <34475659.1AA69855@cdata.tvnet.hu> + Files: utils/perldoc.PL + + Change 720 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make ExtUtils::MM_Unix::fixin() do something meaningful on win32", + #F090 + From: Gurusamy Sarathy + Msg-ID: <199801070016.TAA17766@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm + + Change 719 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix inconsistent case $ENV{Path} (vs $ENV{PATH})", #F089 + From: Gurusamy Sarathy + Files: lib/FindBin.pm + + Change 718 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix File::Find's longstanding confusion about win32 being like VMS", + #F088 + From: Gurusamy Sarathy + Msg-ID: <199802020459.XAA04964@aatma.engin.umich.edu> + Files: lib/File/Find.pm + + Change 717 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "do_postponed breaks with multiple interpreters", #F087 + From: Gurusamy Sarathy + Msg-ID: <199710290316.WAA15888@aatma.engin.umich.edu> + Files: op.c + + Change 716 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make warning on C optional, add to perl{diag,delta}.pod", + #F086 + From: Gurusamy Sarathy + Files: pod/perldelta.pod pod/perldiag.pod toke.c + + Change 715 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Pod::Html bug and fix: missing in index", #F085 + From: Gurusamy Sarathy + Msg-ID: <199802192314.SAA23326@aatma.engin.umich.edu> + Files: lib/Pod/Html.pm + + Change 714 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "New pod: perlhist", #F084 + From: Jarkko Hietaniemi + Msg-ID: <199802191556.RAA09578@alpha.hut.fi> + Files: MANIFEST pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + + Change 713 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix restoration of locals on scope unwinding", #F083 + From: Gurusamy Sarathy + Msg-ID: <199802110515.AAA23700@aatma.engin.umich.edu> + Files: pp_ctl.c t/op/local.t + + Change 712 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "after an eval-ed bad require, requiring a string ref SEGVs", #F082 + From: Gurusamy Sarathy + Msg-ID: <199802102349.SAA16001@aatma.engin.umich.edu> + Files: pp_ctl.c + + Change 711 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix seg fault on eval/require and syntax errors", #F081 + From: Gurusamy Sarathy + Msg-ID: <199802102321.SAA15346@aatma.engin.umich.edu> + Files: MANIFEST scope.h op.c pp_ctl.c scope.c t/comp/require.t toke.c + + Change 710 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "5.004_58: the locale.t problem in IRIX", #F080 + From: Jarkko Hietaniemi + Msg-ID: <199802091747.TAA01735@alpha.hut.fi> + Files: t/pragma/locale.t + + Change 709 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "sv_setnv will upgrade SVt_NV to SVt_PVNV", #F079 + From: Gisle Aas + Msg-ID: + Files: sv.c + + Change 708 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Eliminate double warnings under C", #F077 + From: "M.J.T. Guy" + Msg-ID: + Files: gv.c op.c toke.c + + Change 707 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix infinite loop on unlink() failure in File::Path::rmtree()", + #F076 + From: Murray Nesbitt , Tim Bunce + Msg-ID: <199802061100.LAA16423@toad.ig.co.uk> + Files: lib/File/Path.pm + + Change 706 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Update of h2ph", #F075 + From: kstar@www.chapin.edu (Kurt D. Starsinic) + Msg-ID: <199802051354.FAA11452@www.chapin.edu> + Files: t/lib/ph.t utils/h2ph.PL + + Change 705 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix AutoLoader for deep packages", #F074 + From: Zachary Miller + Msg-ID: <199710092348.SAA02108@zappy.er.usgs.gov> + Files: lib/AutoLoader.pm + + Change 704 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix order of warnings for misplaced subscripts", #F073 + From: Hugo van der Sanden + Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk> + Files: op.c + + Change 703 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make recursive lexical analysis more robust", #F072 + From: Ilya Zakharevich and Chip Salzenberg + Msg-ID: <199710160102.VAA28817@monk.mps.ohio-state.edu> + Files: toke.c + + Change 702 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix random whitespace errors in docs", #F070 + From: Roderick Schertler + Msg-ID: <12726.877706444@eeyore.ibcinc.com> + Files: pod/perlfunc.pod pod/checkpods.PL + + Change 701 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix line numbers after here documents in eval STRING", #F069 + From: Ilya Zakharevich + Msg-ID: <199710241745.NAA08166@monk.mps.ohio-state.edu> + Files: toke.c + + Change 700 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV from combining caller and C", #F068 + From: James Duncan , Nicholas Clark + + Msg-ID: <199710241248.NAA00163@flirble.org>, + + Files: pp_ctl.c sv.c + + Change 699 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't fold string comparison under C", #F067 + From: Jarkko Hietaniemi + Msg-ID: <199711151506.RAA26287@alpha.hut.fi> + Files: op.c + + Change 698 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV on constant at end of sort block", #F066 + From: Administration + Msg-ID: <199711170838.JAA26073@thetis.fi.muni.cz> + Files: op.c + + Change 697 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Allow C to mean C", #F065 + From: Chip Salzenberg + Files: op.c + + Change 696 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix extension version mismatch message", #F064 + From: Chip Salzenberg + Files: XSUB.h + + Change 695 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Better handle and test struct tm of Linux and SunOS", #F063 + From: Andy Dougherty + Msg-ID: + Files: MANIFEST ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t + + Change 694 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix doc bug in getservbyname() examples", #F062 + From: Tom Christiansen + Files: ext/Socket/Socket.pm + + Change 693 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Kill warning about parameter type", #F061 + From: Chip Salzenberg + Files: op.c + + Change 692 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Socket occasional SEGV", #F060 + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + + Change 691 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Avoid SEGV from local($@)", #F059 + From: Gurusamy Sarathy + Msg-ID: <199710290251.VAA14362@aatma.engin.umich.edu> + Files: pp_ctl.c + + Change 690 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 )", #F058 + From: Gurusamy Sarathy + Msg-ID: <199710300036.TAA01004@aatma.engin.umich.edu> + Files: op.c + + Change 689 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Use STMT_{START,END} in XSRETURN", #F057 + From: Gurusamy Sarathy + Msg-ID: <199710300245.VAA04244@aatma.engin.umich.edu> + Files: XSUB.h + + Change 688 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: Sort grammar bug", #F056 + From: Gurusamy Sarathy + Msg-ID: <199711011946.OAA18882@aatma.engin.umich.edu> + Files: toke.c + + Change 687 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Document indirect object cases for exec(), system()", #F055 + From: Dominic Dunlop + Msg-ID: + Files: pod/perlfunc.pod + + Change 686 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Update docs on tr///", #F054 + From: Tom Phoenix + Msg-ID: + Files: pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + pod/perllocale.pod pod/perlmod.pod pod/perlop.pod + pod/perlstyle.pod toke.c + + Change 685 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: perlop bitwise & | ^ documentation", #F053 + From: Tom Phoenix + Msg-ID: + Files: pod/perlop.pod + + Change 684 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV on C<*glob{'SCALAR','ARRAY'}>", #F052 + From: "Joseph N. Hall" + Msg-ID: <199711110552.WAA12613@gadget.cscaper.com> + Files: perly.c perly.c.diff perly.y vms/perly_c.vms + + Change 683 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "for perlguts.pod: document sv_derived_from, sv_vcatpfn and + sv_vsetpfn", #F051 + From: jan.dubois@ibm.net (Jan Dubois) and Chip Salzenberg + Msg-ID: <346ae970.7444534@smtp1.ibm.net> + Files: pod/perlguts.pod + + Change 682 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "5.004_04: locale startup failure (at last) documented", #F050 + From: Jarkko Hietaniemi + Msg-ID: <199711172054.WAA08261@alpha.hut.fi> + Files: INSTALL pod/perldiag.pod pod/perllocale.pod + + Change 681 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Cope with lack of args in Fcntl::AUTOLOAD", #F049 + From: Jerome Abela + Msg-ID: <19971120183248.23588@coredump.hsc.fr> + Files: ext/Fcntl/Fcntl.pm + + Change 680 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Commenting toke.c", #F048 + From: gnat@frii.com + Msg-ID: <199801082138.OAA14186@prometheus.frii.com> + Files: toke.c + + Change 679 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: 5.004_04 vec() fails with 32-bit values", #F047 + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlguts.pod pp.c t/op/vec.t + + Change 678 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "A few perl5.004_03 bugs", #F046 + From: Hugo van der Sanden + Msg-ID: <199801221211.MAA05315@crypt.compulink.co.uk> + Files: mg.c t/op/magic.t + + Change 677 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Faster, cleaner av_unshift() ", #F045 + From: Gisle Aas + Msg-ID: <199801221850.TAA23111@furu.g.aas.no> + Files: av.c + + Change 676 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "New hints/solaris2.sh", #F044 + From: Stephen Zander + Msg-ID: <87oh12y458.fsf@wsuse5.mckesson.com> + Files: hints/solaris_2.sh + + Change 675 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Refresh Complex.pm and test", #F043 + From: Jarkko Hietaniemi + Msg-ID: <199802051608.SAA20262@alpha.hut.fi> + Files: lib/Math/Complex.pm t/lib/complex.t + + Change 674 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix (\@@) proto", #F042 + From: "Joseph N. Hall" + Msg-ID: <199801240132.SAA25111@gadget.cscaper.com> + Files: op.c t/comp/proto.t + + Change 673 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Allow empty BLOCK in code", #F041 + From: Vladimir Alexiev + Msg-ID: <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca> + Files: toke.c + + Change 672 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix name of $Foo::{'Bar::'}: '*Foo::Bar::'", #F040 + From: Chip Salzenberg + Files: gv.c t/op/gv.t + + Change 671 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Keep accurate reference count on globs' stashes", #F038 + From: Gisle Aas + Msg-ID: + Files: gv.c sv.c + + Change 670 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Avoid memory allocation in gv_fetchpv(), for speed", #F037 + From: Chip Salzenberg + Files: gv.c + + Change 669 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make Configure less negative about PerlIO", #F036 + From: Chip Salzenberg + Msg-ID: <199801312323.SAA15237@cyprus.atlantic.net> + Files: Configure + + Change 668 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix (mostly) pseudo-same-REs due to embedded NULs", #F035 + From: Martin Plechsmid + Msg-ID: <199802021217.NAA05230@albert.karlin.mff.cuni.cz> + Files: pp_ctl.c + + Change 667 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make Getopt::Long avoid $&, $`, $'", #F034 + From: Irving Reid + Msg-ID: <98Feb3.005102est.11655@janus.tor.securecomputing.com> + Files: lib/Getopt/Long.pm + + Change 666 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "adding the newSVpvn API function", #F033 + From: Matthias Ulrich Neeracher + Msg-ID: <199801310532.GAA23798@solar.ethz.ch> + Files: pod/perlguts.pod pod/perltoc.pod proto.h global.sym sv.c + + Change 665 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Support C as function-blind bearword", #F032 + From: Chip Salzenberg + Files: toke.c + + Change 664 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re-optimize character classes", #F031 + From: Chip Salzenberg + Files: regcomp.h regcomp.c regexec.c + + Change 663 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C which needed ENTER/LEAVE", #F030 + From: dfh@dwroll.lucent.com (D461-David_F_Haertig(Dave)83040) + Msg-ID: + Files: op.c t/op/local.t + + Change 662 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Dramatically improve performance of // with parens or $&", #F029 + From: Chip Salzenberg + Files: cop.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c pp_ctl.c + pp_hot.c regexec.c scope.c + + Change 661 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't warn on $x{shift}, ne => 1, or -f => 1", #F028 + From: Chip Salzenberg + Files: toke.c + + Change 660 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Protect against weirdness with unreal @_ in C", #F027 + From: Chip Salzenberg + Files: scope.c + + Change 659 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C", #F026 + From: Hugo van der Sanden + Msg-ID: <199711021331.NAA01826@crypt.compulink.co.uk> + Files: sv.c t/op/sprintf.t + + Change 658 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Tiny core patch for source filters", #F025 + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9711202312.AA02937@claudius.bfsec.bt.co.uk> + Files: toke.c + + Change 657 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Here-doc in s///e (was: Bug)", #F024 + From: Hugo van der Sanden + Msg-ID: <199711221445.OAA14153@crypt.compulink.co.uk> + Files: t/base/lex.t toke.c + + Change 656 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix duplicate warnings on C<-e undef>", #F023 + From: Hugo van der Sanden + Msg-ID: <199711221252.MAA14000@crypt.compulink.co.uk> + Files: doio.c t/pragma/warn-1global + + Change 655 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix '*' prototype", #F022 + From: Ilya Zakharevich + Msg-ID: <199711212225.RAA00755@monk.mps.ohio-state.edu> + Files: toke.c + + Change 654 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "File::Find bugs (and patches)", "File::Find bugs & patches", #F021 + From: "Conrad E. Kimball" + Msg-ID: <199711260703.XAA21257@mailgate2.boeing.com> + Files: lib/File/Find.pm + + Change 653 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix typo: FORM{,AT}LINE", #F020 + From: Chip Salzenberg + Files: sv.c + + Change 652 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix use of unref mem when blessed object goes out of scope", #F019 + From: Gurusamy Sarathy + Msg-ID: <199711282326.SAA15090@aatma.engin.umich.edu> + Files: scope.c + + Change 651 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C", #F018 + From: Stephane Payrard + Msg-ID: <199712040054.BAA04612@www.zweig.com> + Files: op.c t/op/my.t + + Change 650 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "enhanced "use strict" warning", #F017 + From: Tkil + Msg-ID: <199712040938.CAA07628@reptile.scrye.com> + Files: gv.c t/pragma/strict-subs t/pragma/strict-vars + + Change 649 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "eval of sub gives spurious "uninitialised" warning", #F016 + From: Gurusamy Sarathy + Msg-ID: <199712061025.FAA14396@aatma.engin.umich.edu> + Files: pod/perldelta.pod pod/perlfunc.pod op.c t/op/eval.t + + Change 648 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "[PERL] Assigning result of pop scrambles unrelated reference", #F015 + From: Gurusamy Sarathy + Msg-ID: <199712061100.GAA14864@aatma.engin.umich.edu> + Files: sv.c + + Change 647 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "[PERL] Filedescriptor leak in 5.004_55 (and earlier)", #F014 + From: Ilya Zakharevich + Msg-ID: <199712151922.OAA06410@monk.mps.ohio-state.edu> + Files: os2/os2.c util.c + + Change 646 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix fdopen() on STD{IN,OUT,ERR}", #F013 + From: Roderick Schertler + Msg-ID: + Files: doio.c t/op/misc.t + + Change 645 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix local $a[0] and local $h{a}", #F012 + From: Stephen McCamant + Msg-ID: + Files: embed.h scope.h global.sym pp.c pp_hot.c scope.c t/op/local.t + + Change 644 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Eliminate redundant mg_get() in SvTRUE()", #F011 + From: Spider Boardman + Msg-ID: <199712251839.NAA14800@Orb.Nashua.NH.US> + Files: sv.c + + Change 643 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't force scalar context on C or C", #F010 + From: Chip Salzenberg + Files: op.c t/op/my.t + + Change 642 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix assignment to $_[0] in DESTROY", #F009 + From: Gurusamy Sarathy + Msg-ID: <199801010030.TAA14274@aatma.engin.umich.edu> + Files: pod/perlobj.pod sv.c t/op/ref.t + + Change 627 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix inefficient checks for TIEHANDLE", #F008 + From: Gurusamy Sarathy + Msg-ID: <199801080106.UAA05048@aatma.engin.umich.edu> + Files: pp_hot.c pp_sys.c + + Change 626 on 1998/03/02 by TimBunce@ig.co.uk + + This is the change description for change 625 + Title: "Fix tr///s option", #F007 + From: Inaba Hiroto + Msg-ID: <19980110155333D.inaba@st.rim.or.jp> + Files: doop.c + + Change 623 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix lexical lookup in eval-sub-eval", #F006 + From: Chip Salzenberg + Files: pp_ctl.c + + Change 622 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Don't upgrade target of assignment from LVALUE", #F005 + From: Chip Salzenberg + Files: sv.c + + Change 621 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix compile-time warning line in while ()", #F004 + From: Chip Salzenberg + Files: op.c + + Change 620 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "STMT foreach LIST;", #F002 + From: Chip Salzenberg + Files: pod/perlsyn.pod perly.c perly.c.diff perly.y t/cmd/mod.t toke.c + vms/perly_c.vms + + Change 619 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix SIGSEGV on C<42 until forever>", #F001 + From: Chip Salzenberg + Files: op.c ---------------- Version 5.004_04 Maintenance release 4 for 5.004 *************** *** 79,85 **** Files: MANIFEST lib/ExtUtils/Liblist.pm Title: "Set LD_RUN_PATH when building suidperl" ! From: Chip Salzenberg , Tony Sanders Msg-ID: <199708272226.QAA10206@austin.bsdi.com> Files: Makefile.SH --- 4123,4129 ---- Files: MANIFEST lib/ExtUtils/Liblist.pm Title: "Set LD_RUN_PATH when building suidperl" ! From: Chip Salzenberg , Tony Sanders Msg-ID: <199708272226.QAA10206@austin.bsdi.com> Files: Makefile.SH *************** *** 150,181 **** Files: scope.c t/op/ref.t Title: "Avoid assumption that STRLEN == I32" ! From: Chip Salzenberg , Hallvard B Furuseth Msg-ID: <199708242310.BAA05497@bombur2.uio.no> Files: hv.c Title: "Fix memory leak in splice(@_)" From: "Tuomas J. Lukka" , Chip Salzenberg ! Msg-ID: Files: proto.h av.c global.sym pp.c Title: "Fix line number of warnings in while() conditional", "misleading uninit value warning" ! From: Chip Salzenberg , Greg Bacon Msg-ID: <199708271607.LAA01403@crp-201.adtran.com> Files: proto.h op.c perly.c perly.y Title: "-t and POSIX::isatty on IO::Handle objects", "Fix C<-t $handle>" ! From: Chip Salzenberg , Greg Ward Msg-ID: <199708261754.NAA24826@bottom.bic.mni.mcgill.ca> Files: pp_sys.c Title: "Fix output of invalid printf formats" ! From: Chip Salzenberg , Hugo van der Sanden Msg-ID: <199708241529.QAA02457@crypt.compulink.co.uk> Files: sv.c t/op/sprintf.t --- 4194,4225 ---- Files: scope.c t/op/ref.t Title: "Avoid assumption that STRLEN == I32" ! From: Chip Salzenberg , Hallvard B Furuseth Msg-ID: <199708242310.BAA05497@bombur2.uio.no> Files: hv.c Title: "Fix memory leak in splice(@_)" From: "Tuomas J. Lukka" , Chip Salzenberg ! Msg-ID: Files: proto.h av.c global.sym pp.c Title: "Fix line number of warnings in while() conditional", "misleading uninit value warning" ! From: Chip Salzenberg , Greg Bacon Msg-ID: <199708271607.LAA01403@crp-201.adtran.com> Files: proto.h op.c perly.c perly.y Title: "-t and POSIX::isatty on IO::Handle objects", "Fix C<-t $handle>" ! From: Chip Salzenberg , Greg Ward Msg-ID: <199708261754.NAA24826@bottom.bic.mni.mcgill.ca> Files: pp_sys.c Title: "Fix output of invalid printf formats" ! From: Chip Salzenberg , Hugo van der Sanden Msg-ID: <199708241529.QAA02457@crypt.compulink.co.uk> Files: sv.c t/op/sprintf.t *************** *** 219,225 **** toke.c Title: "Reverse previous "Fix C" patch" ! From: Chip Salzenberg , Kenneth Albanowski , Tom Christiansen Msg-ID: <199707050155.VAA27394@rio.atlantic.net>, --- 4263,4269 ---- toke.c Title: "Reverse previous "Fix C" patch" ! From: Chip Salzenberg , Kenneth Albanowski , Tom Christiansen Msg-ID: <199707050155.VAA27394@rio.atlantic.net>, *************** *** 243,249 **** Title: "unpack now allows commas but -w warns", "unpack() difference 5.003->5.004" From: "John L. Allen" , Chip Salzenberg ! , Jarkko Hietaniemi , Jim Esten , Jim Esten , timbo (Tim Bunce) Msg-ID: <199709031632.LAA29584@wepco.com>, --- 4287,4293 ---- Title: "unpack now allows commas but -w warns", "unpack() difference 5.003->5.004" From: "John L. Allen" , Chip Salzenberg ! , Jarkko Hietaniemi , Jim Esten , Jim Esten , timbo (Tim Bunce) Msg-ID: <199709031632.LAA29584@wepco.com>, *************** *** 304,310 **** Files: op.c t/comp/proto.t Title: "Fix bugs with magical arrays and hashes (@ISA)" ! From: Chip Salzenberg Msg-ID: <199709232148.RAA29967@rio.atlantic.net> Files: perl.h proto.h av.c global.sym gv.c mg.c pp.c pp_hot.c scope.c t/op/method.t --- 4348,4354 ---- Files: op.c t/comp/proto.t Title: "Fix bugs with magical arrays and hashes (@ISA)" ! From: Chip Salzenberg Msg-ID: <199709232148.RAA29967@rio.atlantic.net> Files: perl.h proto.h av.c global.sym gv.c mg.c pp.c pp_hot.c scope.c t/op/method.t *************** *** 315,321 **** Files: perl.c taint.c util.c Title: "Tainting bitwise vector ops" ! From: Chip Salzenberg Msg-ID: <199710061726.NAA16438@rio.atlantic.net> Files: doop.c t/op/taint.t --- 4359,4365 ---- Files: perl.c taint.c util.c Title: "Tainting bitwise vector ops" ! From: Chip Salzenberg Msg-ID: <199710061726.NAA16438@rio.atlantic.net> Files: doop.c t/op/taint.t *************** *** 344,350 **** Files: pp.c pp_hot.c Title: "Fix defined() bug in m4t3 affecting LWP" ! From: chip@atlantic.net@ig.co.uk () Msg-ID: <199710101822.OAA14249@cyprus.atlantic.net> Files: pp.c --- 4388,4394 ---- Files: pp.c pp_hot.c Title: "Fix defined() bug in m4t3 affecting LWP" ! From: Chip Salzenberg Msg-ID: <199710101822.OAA14249@cyprus.atlantic.net> Files: pp.c *************** *** 468,474 **** Files: pod/perlop.pod Title: "repeating #! switches" ! From: Chip Salzenberg , Robin Barker Msg-ID: <199709241736.NAA25855@rio.atlantic.net>, <24778.9709241501@tempest.cise.npl.co.uk> --- 4512,4518 ---- Files: pod/perlop.pod Title: "repeating #! switches" ! From: Chip Salzenberg , Robin Barker Msg-ID: <199709241736.NAA25855@rio.atlantic.net>, <24778.9709241501@tempest.cise.npl.co.uk> *************** *** 1145,1151 **** Files: t/comp/term.t toke.c Title: "Fix memory leak on eval 'sub {}'" ! From: Chip Salzenberg Files: pp_ctl.c Title: "stringify looses integerness" --- 5189,5195 ---- Files: t/comp/term.t toke.c Title: "Fix memory leak on eval 'sub {}'" ! From: Chip Salzenberg Files: pp_ctl.c Title: "stringify looses integerness" *************** *** 1177,1192 **** Title: "Forbid negative splice offset beyond array start" From: "John L. Allen" , Chip Salzenberg ! Msg-ID: Files: pp.c Title: "Forbid "goto" into middle of foreach loop" ! From: Chip Salzenberg Files: pod/perldiag.pod pp_ctl.c Title: "Fix C" ! From: Chip Salzenberg Files: toke.c Title: "bless file handles as FileHandle if loaded else IO::Handle" --- 5221,5236 ---- Title: "Forbid negative splice offset beyond array start" From: "John L. Allen" , Chip Salzenberg ! Msg-ID: Files: pp.c Title: "Forbid "goto" into middle of foreach loop" ! From: Chip Salzenberg Files: pod/perldiag.pod pp_ctl.c Title: "Fix C" ! From: Chip Salzenberg Files: toke.c Title: "bless file handles as FileHandle if loaded else IO::Handle" *************** *** 1205,1240 **** Files: sv.c Title: "Fix '-' flag on sprintf() of floats" ! From: Chip Salzenberg , Jarkko Hietaniemi Msg-ID: <199705270646.JAA02510@alpha.hut.fi> Files: sv.c Title: "Free temps before calling END blocks", "Too late destruction" ! From: Chip Salzenberg Msg-ID: Files: perl.c Title: "Fix C parsing" From: "Chuck D. Phillips (NON-HP Employee)" , Chip ! Salzenberg Msg-ID: <199706121737.KAA00503@palrel3.hp.com> Files: toke.c Title: "Fix lockf_emulate_flock() positioning" ! From: Chip Salzenberg , gen@atd.rdc.ricoh.co.jp Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp> Files: pp_sys.c Title: "Don't use atol() for unsigned values", "signedness problem in pack("N", "value");" ! From: Chip Salzenberg , Roger Espel Llima Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr> Files: sv.c Title: "Don't warn about "${foo}" in string, even if &foo exists" ! From: Chip Salzenberg Files: toke.c Title: "[PATCH] -p does not check for failure of implicit print" --- 5249,5284 ---- Files: sv.c Title: "Fix '-' flag on sprintf() of floats" ! From: Chip Salzenberg , Jarkko Hietaniemi Msg-ID: <199705270646.JAA02510@alpha.hut.fi> Files: sv.c Title: "Free temps before calling END blocks", "Too late destruction" ! From: Chip Salzenberg Msg-ID: Files: perl.c Title: "Fix C parsing" From: "Chuck D. Phillips (NON-HP Employee)" , Chip ! Salzenberg Msg-ID: <199706121737.KAA00503@palrel3.hp.com> Files: toke.c Title: "Fix lockf_emulate_flock() positioning" ! From: Chip Salzenberg , gen@atd.rdc.ricoh.co.jp Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp> Files: pp_sys.c Title: "Don't use atol() for unsigned values", "signedness problem in pack("N", "value");" ! From: Chip Salzenberg , Roger Espel Llima Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr> Files: sv.c Title: "Don't warn about "${foo}" in string, even if &foo exists" ! From: Chip Salzenberg Files: toke.c Title: "[PATCH] -p does not check for failure of implicit print" *************** *** 1297,1303 **** Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer safety code" ! From: Chip Salzenberg , Hugo van der Sanden , Tim Bunce Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>, <199707142050.QAA20976@rio.atlantic.net>, --- 5341,5347 ---- Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer safety code" ! From: Chip Salzenberg , Hugo van der Sanden , Tim Bunce Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>, <199707142050.QAA20976@rio.atlantic.net>, *************** *** 1482,1488 **** Files: lib/Shell.pm Title: "confessing a carp" ! From: Chip Salzenberg , Hugo van der Sanden , Nick Ing-Simmons , Tim Bunce Msg-ID: <199708052155.WAA25393@crypt.compulink.co.uk>, --- 5526,5532 ---- Files: lib/Shell.pm Title: "confessing a carp" ! From: Chip Salzenberg , Hugo van der Sanden , Nick Ing-Simmons , Tim Bunce Msg-ID: <199708052155.WAA25393@crypt.compulink.co.uk>, *************** *** 1927,1933 **** Title: "Regex Bug in 5.003_26 thru 003_99a" From: Andreas Karrer , Chip Salzenberg ! Msg-ID: <199705152303.BAA08890@kuru.ee.ethz.ch>, <199705161915.PAA18721@rio.atlantic.net> Files: regcomp.h regcomp.c regexec.c --- 5971,5977 ---- Title: "Regex Bug in 5.003_26 thru 003_99a" From: Andreas Karrer , Chip Salzenberg ! Msg-ID: <199705152303.BAA08890@kuru.ee.ethz.ch>, <199705161915.PAA18721@rio.atlantic.net> Files: regcomp.h regcomp.c regexec.c diff -c 'perl5.004_04/Configure' 'perl5.004_05/Configure' Index: ./Configure Prereq: 3.0.1.8 *** ./Configure Fri Oct 3 13:57:39 1997 --- ./Configure Tue Apr 13 00:39:07 1999 *************** *** 87,94 **** : This should not matter in scripts, but apparently it does, sometimes case "$CDPATH" in ! '') ;; ! *) CDPATH='' ;; esac : Sanity checks --- 87,94 ---- : This should not matter in scripts, but apparently it does, sometimes case "$CDPATH" in ! '') ;; ! *) CDPATH='.' ;; esac : Sanity checks *************** *** 371,376 **** --- 371,379 ---- d_semctl='' d_semget='' d_semop='' + d_union_semun='' + d_semctl_semun='' + d_semctl_semid_ds='' d_setegid='' d_seteuid='' d_setlinebuf='' *************** *** 405,410 **** --- 408,420 ---- sockethdr='' socketlib='' d_statblks='' + d_fstatfs='' + d_statfs='' + d_statfsflags='' + d_fstatvfs='' + d_statvfs='' + d_getmntent='' + d_hasmntopt='' d_stdio_cnt_lval='' d_stdio_ptr_lval='' d_stdiobase='' *************** *** 480,485 **** --- 490,496 ---- i_malloc='' i_math='' i_memory='' + i_mntent='' i_ndbm='' i_neterrno='' i_niin='' *************** *** 489,494 **** --- 500,506 ---- d_pwclass='' d_pwcomment='' d_pwexpire='' + d_pwgecos='' d_pwquota='' i_pwd='' i_sfio='' *************** *** 503,513 **** --- 515,527 ---- i_sysfilio='' i_sysioctl='' i_syssockio='' + i_sysmount='' i_sysndir='' i_sysparam='' i_sysresrc='' i_sysselct='' i_sysstat='' + i_sysstatvfs='' i_systimes='' i_systypes='' i_sysun='' *************** *** 538,543 **** --- 552,558 ---- loclibpth='' plibpth='' xlibpth='' + ignore_versioned_solibs='' libs='' lns='' lseektype='' *************** *** 637,642 **** --- 652,659 ---- smallmach='pdp11 i8086 z8000 i80286 iAPX286' rmlist='' + installusrbinperl='' + : We must find out about Eunice early eunicefix=':' if test -f /etc/unixtovms; then *************** *** 715,720 **** --- 732,739 ---- i_whoami='' : default library list libswanted='' + : some systems want only to use the non-versioned libso:s + ignore_versioned_solibs='' : set useposix=false in your hint file to disable the POSIX extension. useposix=true : set useopcode=false in your hint file to disable the Opcode extension. *************** *** 1469,1474 **** --- 1488,1494 ---- perl pg sendmail + tee test uname zip *************** *** 1681,1687 **** $test -d /usr/include/minix && osname=minix if $test -d /MachTen; then osname=machten ! if $test -x /sbin/version; then osvers=`/sbin/version | $awk '{print $2}' | $sed -e 's/[A-Za-z]$//'` elif $test -x /usr/etc/version; then --- 1701,1707 ---- $test -d /usr/include/minix && osname=minix if $test -d /MachTen; then osname=machten ! if $test -x /sbin/version -o -d /MachTen_Folder; then osvers=`/sbin/version | $awk '{print $2}' | $sed -e 's/[A-Za-z]$//'` elif $test -x /usr/etc/version; then *************** *** 1748,1759 **** osvers="$3" ;; genix) osname=genix ;; hp*) osname=hpux ! case "$3" in ! *.08.*) osvers=9 ;; ! *.09.*) osvers=9 ;; ! *.10.*) osvers=10 ;; ! *) osvers="$3" ;; ! esac ;; irix*) osname=irix case "$3" in --- 1768,1774 ---- osvers="$3" ;; genix) osname=genix ;; hp*) osname=hpux ! osvers=`echo "$3" | $sed 's,.*\.\([0-9]*\.[0-9]*\),\1,'` ;; irix*) osname=irix case "$3" in *************** *** 2979,2984 **** --- 2994,3024 ---- installbin="$binexp" fi + echo " " + case "$installusrbinperl" in + '') if test -d /usr/bin -a "X$installbin" != X/usr/bin; then + $cat <&4 cat >gnulibc.c </dev/null 2>&1 && \ ! ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then val="$define" echo "You are using the GNU C Library" else --- 3886,3903 ---- echo " " echo "Checking for GNU C Library..." >&4 cat >gnulibc.c < ! int main() { ! #ifdef __GLIBC__ ! exit(0); ! #else ! exit(1); ! #endif } EOM if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs >/dev/null 2>&1 && \ ! ./gnulibc ; then val="$define" echo "You are using the GNU C Library" else *************** *** 4519,4524 **** --- 4564,4573 ---- 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*) *************** *** 4625,4648 **** . ./myread case "$ans" in true|$define|[Yy]*) ! useshrplib='true' ! # Why does next4 have to be so different? ! case "${osname}${osvers}" in ! next4*) xxx='DYLD_LIBRARY_PATH' ;; ! *) xxx='LD_LIBRARY_PATH' ;; ! esac ! $cat <&4 ! ! To build perl, you must add the current working directory to your ! $xxx environtment 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 ! ;; *) useshrplib='false' ;; esac ;; --- 4674,4680 ---- . ./myread case "$ans" in true|$define|[Yy]*) ! useshrplib='true' ;; *) useshrplib='false' ;; esac ;; *************** *** 5459,5471 **** cat <. Versions 5.003_02 and later of perl allow alternate IO mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still ! the default and is the only supported mechanism. This abstraction ! layer can use AT&T's sfio (if you already have sfio installed) or ! fall back on standard IO. This PerlIO abstraction layer is ! experimental and may cause problems with some extension modules. If this doesn't make any sense to you, just accept the default 'n'. EOM --- 5491,5503 ---- cat <. Versions 5.003_02 and later of perl allow alternate IO mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still ! the default. This abstraction layer can use AT&T's sfio (if you ! already have sfio installed) or regular stdio, although sfio may cause ! problems with some extension modules. Using PerlIO with stdio is safe, ! but it is slower than plain stdio and therefore is not the default. If this doesn't make any sense to you, just accept the default 'n'. EOM *************** *** 6062,6067 **** --- 6094,6116 ---- set chsize d_chsize eval $inlibc + 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' + : check for const keyword echo " " echo 'Checking to see if your C compiler knows about "const"...' >&4 *************** *** 7033,7038 **** --- 7082,7095 ---- set d_pwcomment eval $setvar + if $contains 'pw_gecos' $$.h >/dev/null 2>&1; then + val="$define" + else + val="$undef" + fi + set d_pwgecos + eval $setvar + $rm -f $$.h ;; *) *************** *** 7043,7048 **** --- 7100,7106 ---- set d_pwclass; eval $setvar set d_pwexpire; eval $setvar set d_pwcomment; eval $setvar + set d_pwgecos; eval $setvar ;; esac *************** *** 7338,7343 **** --- 7396,7557 ---- set d_sem eval $setvar + : see how to do semctl IPC_STAT + case "$h_sem$d_sem$d_semctl" in + true$define$define) + : see whether sys/sem.h defines union semun + $cat > try.c <<'END' + #include + #include + #include + int main () { union semun semun; semun.buf = 0; } + END + if $cc $ccflags -o try try.c > /dev/null 2>&1; then + echo "You have union semun in ." >&4 + val="$define" + else + echo "You do not have union semun in ." >&4 + val="$undef" + fi + $rm -f try try.c + set d_union_semun + eval $setvar + + : see whether semctl IPC_STAT can use union semun + $cat > try.c < + #include + #include + #include + #include + #include + #ifndef errno + extern int errno; + #endif + #$d_union_semun HAS_UNION_SEMUN + int main() { + union semun + #ifndef HAS_UNION_SEMUN + { + int val; + struct semid_ds *buf; + unsigned short *array; + } + #endif + arg; + int sem, st; + + #if defined(IPC_PRIVATE) && defined(S_IRWXU) && defined(S_IRWXG) && \ + defined(S_IRWXO) && defined(IPC_CREAT) + sem = semget(IPC_PRIVATE, 1, S_IRWXU|S_IRWXG|S_IRWXO|IPC_CREAT); + if (sem > -1) { + struct semid_ds argbuf; + arg.buf = &argbuf; + # ifdef IPC_STAT + st = semctl(sem, 0, IPC_STAT, arg); + if (st == 0) + printf("semun\n"); + else + # endif /* IPC_STAT */ + printf("semctl IPC_STAT failed: errno = %d\n", errno); + # ifdef IPC_RMID + if (semctl(sem, 0, IPC_RMID, arg) != 0) + # endif /* IPC_RMID */ + printf("semctl IPC_RMID failed: errno = %d\n", errno); + } else + #endif /* IPC_PRIVATE && ... */ + printf("semget failed: errno = %d\n", errno); + + return 0; + } + END + val="$undef" + if $cc $ccflags -o try try.c > /dev/null 2>&1; then + d_semctl_semun=`./try` + case "$d_semctl_semun" in + semun) val="$define" ;; + esac + fi + $rm -f try try.c + set d_semctl_semun + eval $setvar + case "$d_semctl_semun" in + $define|true) + echo "You can use union semun for semctl IPC_STAT." >&4 + ;; + *) echo "You cannot use union semun for semctl IPC_STAT." >&4 + ;; + esac + + : see whether semctl IPC_STAT can use struct semid_ds pointer + + $cat > try.c <<'END' + #include + #include + #include + #include + #include + #include + #ifndef errno + extern int errno; + #endif + int main() { + struct semid_ds arg; + int sem, st; + + #if defined(IPC_PRIVATE) && defined(S_IRWXU) && defined(S_IRWXG) && \ + defined(S_IRWXO) && defined(IPC_CREAT) + sem = semget(IPC_PRIVATE, 1, S_IRWXU|S_IRWXG|S_IRWXO|IPC_CREAT); + if (sem > -1) { + # ifdef IPC_STAT + st = semctl(sem, 0, IPC_STAT, &arg); + if (st == 0) + printf("semid_ds\n"); + else + # endif /* IPC_STAT */ + printf("semctl IPC_STAT failed: errno = %d\n", errno); + # ifdef IPC_RMID + if (semctl(sem, 0, IPC_RMID, &arg) != 0) + # endif /* IPC_RMID */ + printf("semctl IPC_RMID failed: errno = %d\n", errno); + } else + #endif /* IPC_PRIVATE && ... */ + printf("semget failed: errno = %d\n", errno); + + return 0; + } + END + val="$undef" + if $cc $ccflags -o try try.c > /dev/null 2>&1; then + d_semctl_semid_ds=`./try` + case "$d_semctl_semid_ds" in + semid_ds) val="$define" ;; + esac + fi + $rm -f try try.c + set d_semctl_semid_ds + eval $setvar + case "$d_semctl_semid_ds" in + $define|true) + echo "You can use struct semid_ds * for semctl IPC_STAT." >&4 + ;; + *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4 + ;; + esac + ;; + *) val="$undef" + + set d_union_semun + eval $setvar + + set d_semctl_semun + eval $setvar + + set d_semctl_semid_ds + eval $setvar + ;; + esac + : see if setegid exists set setegid d_setegid eval $inlibc *************** *** 9361,9366 **** --- 9575,9584 ---- set math.h i_math eval $inhdr + : see if this is a mntent.h system + set mntent.h i_mntent + eval $inhdr + : see if ndbm.h is available set ndbm.h t_ndbm eval $inhdr *************** *** 9699,9704 **** --- 9917,9954 ---- set sys/param.h i_sysparam eval $inhdr + : see if this is a sys/mount.h system + set sys/mount.h i_sysmount + eval $inhdr + + : see if statfs exists + set statfs d_statfs + eval $inlibc + + : see if fstatfs exists + set fstatfs d_fstatfs + eval $inlibc + + : see if statfs knows about mount flags + set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h + eval $hasfield + + : see if statvfs exists + set statvfs d_statvfs + eval $inlibc + + : see if fstatvfs exists + set fstatvfs d_fstatvfs + eval $inlibc + + : see if getmntent exists + set getmntent d_getmntent + eval $inlibc + + : see if hasmntopt exists + set hasmntopt d_hasmntopt + eval $inlibc + : see if sys/resource.h has to be included set sys/resource.h i_sysresrc eval $inhdr *************** *** 9711,9716 **** --- 9961,9970 ---- set sys/types.h i_systypes eval $inhdr + : see if this is a sys/statvfs.h system + set sys/statvfs.h i_sysstatvfs + eval $inhdr + : see if this is a sys/un.h system set sys/un.h i_sysun eval $inhdr *************** *** 10076,10087 **** --- 10330,10345 ---- d_fork='$d_fork' d_fpathconf='$d_fpathconf' d_fsetpos='$d_fsetpos' + d_fstatfs='$d_fstatfs' + d_fstatvfs='$d_fstatvfs' d_ftime='$d_ftime' d_getgrps='$d_getgrps' d_setgrps='$d_setgrps' d_gethent='$d_gethent' d_gethname='$d_gethname' d_getlogin='$d_getlogin' + d_getmntent='$d_getmntent' + d_hasmntopt='$d_hasmntopt' d_getpgid='$d_getpgid' d_getpgrp2='$d_getpgrp2' d_getpgrp='$d_getpgrp' *************** *** 10129,10134 **** --- 10387,10393 ---- d_pwclass='$d_pwclass' d_pwcomment='$d_pwcomment' d_pwexpire='$d_pwexpire' + d_pwgecos='$d_pwgecos' d_pwquota='$d_pwquota' d_readdir='$d_readdir' d_readlink='$d_readlink' *************** *** 10144,10149 **** --- 10403,10411 ---- d_semctl='$d_semctl' d_semget='$d_semget' d_semop='$d_semop' + d_union_semun='$d_union_semun' + d_semctl_semun='$d_semctl_semun' + d_semctl_semid_ds='$d_semctl_semid_ds' d_setegid='$d_setegid' d_seteuid='$d_seteuid' d_setlinebuf='$d_setlinebuf' *************** *** 10171,10176 **** --- 10433,10441 ---- d_socket='$d_socket' d_sockpair='$d_sockpair' d_statblks='$d_statblks' + d_statfs='$d_statfs' + d_statfsflags='$d_statfsflags' + d_statvfs='$d_statvfs' d_stdio_cnt_lval='$d_stdio_cnt_lval' d_stdio_ptr_lval='$d_stdio_ptr_lval' d_stdiobase='$d_stdiobase' *************** *** 10262,10267 **** --- 10527,10533 ---- i_malloc='$i_malloc' i_math='$i_math' i_memory='$i_memory' + i_mntent='$i_mntent' i_ndbm='$i_ndbm' i_neterrno='$i_neterrno' i_niin='$i_niin' *************** *** 10278,10289 **** --- 10544,10557 ---- 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' *************** *** 10299,10304 **** --- 10567,10573 ---- i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' + ignore_versioned_solibs='$ignore_versioned_solibs' incpath='$incpath' inews='$inews' installarchlib='$installarchlib' *************** *** 10309,10314 **** --- 10578,10584 ---- installscript='$installscript' installsitearch='$installsitearch' installsitelib='$installsitelib' + installusrbinperl='$installusrbinperl' intsize='$intsize' known_extensions='$known_extensions' ksh='$ksh' *************** *** 10565,10570 **** --- 10835,10846 ---- echo "Done." fi + if $test -f config.msg; then + echo "Hmm. I also noted the following information while running:" + echo " " + $cat config.msg >&4 + $rm -f config.msg + fi $rm -f kit*isdone ark*isdone $rm -rf UU diff -c 'perl5.004_04/Copying' 'perl5.004_05/Copying' Index: ./Copying *** ./Copying Tue Oct 18 12:18:02 1994 --- ./Copying Sun Nov 22 10:08:38 1998 *************** *** 2,8 **** Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. ! 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. --- 2,8 ---- Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. ! 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. *************** *** 215,222 **** GNU General Public License for more details. You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. --- 215,222 ---- GNU General Public License for more details. You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software Foundation, ! Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. diff -c 'perl5.004_04/EXTERN.h' 'perl5.004_05/EXTERN.h' Index: ./EXTERN.h *** ./EXTERN.h Fri Jun 6 17:44:08 1997 --- ./EXTERN.h Sun Nov 22 10:08:38 1998 *************** *** 18,29 **** #undef EXTCONST #undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) # define EXT globalref # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else ! # if (defined(_MSC_VER) && defined(_WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__)) # ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT --- 18,33 ---- #undef EXTCONST #undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) + /* Suppress portability warnings from DECC for VMS-specific extensions */ + # ifdef __DECC + # pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT) + # endif # define EXT globalref # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else ! # if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) && !defined(PERL_OBJECT) # ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT diff -c 'perl5.004_04/INSTALL' 'perl5.004_05/INSTALL' Index: ./INSTALL Prereq: 1.28 *** ./INSTALL Tue Oct 14 08:47:06 1997 --- ./INSTALL Fri Jun 19 14:47:57 1998 *************** *** 93,99 **** Configure will figure out various things about your system. Some things Configure will figure out for itself, other things it will ask you about. To accept the default, just press RETURN. The default ! is almost always ok. At any Configure prompt, you can type &-d and Configure will use the defaults from then on. After it runs, Configure will perform variable substitution on all the --- 93,99 ---- Configure will figure out various things about your system. Some things Configure will figure out for itself, other things it will ask you about. To accept the default, just press RETURN. The default ! is almost always okay. At any Configure prompt, you can type &-d and Configure will use the defaults from then on. After it runs, Configure will perform variable substitution on all the *************** *** 130,135 **** --- 130,143 ---- your perl source directory. If you do, installperl will attempt infinite recursion. + It may seem obvious to say, but Perl is useful only when users can + easily find it. When possible, it's good for both /usr/bin/perl and + /usr/local/bin/perl to be symlinks to the actual binary. If that can't + be done, system administrators are strongly encouraged to 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. + 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 *************** *** 719,725 **** This will do two independent things: First, it will force compilation to use cc -g so that you can use your system's debugger on the executable. (Note: Your system may actually require something like ! cc -g2. Check you man pages for cc(1) and also any hint file for your system.) Second, it will add -DDEBUGGING to your ccflags variable in config.sh so that you can use B to access perl's internal state. (Note: Configure will only add -DDEBUGGING by --- 727,733 ---- This will do two independent things: First, it will force compilation to use cc -g so that you can use your system's debugger on the executable. (Note: Your system may actually require something like ! cc -g2. Check your man pages for cc(1) and also any hint file for your system.) Second, it will add -DDEBUGGING to your ccflags variable in config.sh so that you can use B to access perl's internal state. (Note: Configure will only add -DDEBUGGING by *************** *** 941,947 **** If you have any locale-related environment variables set, try unsetting them. I have some reports that some versions of IRIX hang while running B<./miniperl configpm> with locales other than the C ! locale. See the discussion under L below about locales. =item malloc duplicates --- 949,966 ---- If you have any locale-related environment variables set, try unsetting them. I have some reports that some versions of IRIX hang while running B<./miniperl configpm> with locales other than the C ! locale. See the discussion under L<"make test"> below about locales ! and the whole L section in the file pod/perllocale.pod. ! The latter is especially useful if you see something like this ! ! perl: warning: Setting locale failed. ! perl: warning: Please check that your locale settings: ! LC_ALL = "En_US", ! LANG = (unset) ! are supported and installed on your system. ! perl: warning: Falling back to the standard locale ("C"). ! ! at Perl startup. =item malloc duplicates *************** *** 951,971 **** =item varargs If you get varargs problems with gcc, be sure that gcc is installed ! correctly. When using gcc, you should probably have i_stdarg='define' and i_varargs='undef' in config.sh. The problem is usually solved by running fixincludes correctly. If you do change config.sh, don't forget to propagate your changes (see L<"Propagating your changes to config.sh"> below). See also the L<"vsprintf"> item below. ! =item croak If you get error messages such as the following (the exact line numbers will vary in different versions of perl): ! util.c: In function `Perl_croak': ! util.c:962: number of arguments doesn't match prototype ! proto.h:45: prototype declaration it might well be a symptom of the gcc "varargs problem". See the previous L<"varargs"> item. --- 970,991 ---- =item varargs If you get varargs problems with gcc, be sure that gcc is installed ! correctly and that you are not passing -I/usr/include to gcc. ! When using gcc, you should probably have i_stdarg='define' and i_varargs='undef' in config.sh. The problem is usually solved by running fixincludes correctly. If you do change config.sh, don't forget to propagate your changes (see L<"Propagating your changes to config.sh"> below). See also the L<"vsprintf"> item below. ! =item util.c If you get error messages such as the following (the exact line numbers will vary in different versions of perl): ! util.c: In function `Perl_form': ! util.c:1107: number of arguments doesn't match prototype ! proto.h:125: prototype declaration it might well be a symptom of the gcc "varargs problem". See the previous L<"varargs"> item. diff -c 'perl5.004_04/INTERN.h' 'perl5.004_05/INTERN.h' Index: ./INTERN.h *** ./INTERN.h Thu Mar 6 10:46:34 1997 --- ./INTERN.h Sun Nov 22 10:08:38 1998 *************** *** 18,32 **** --- 18,43 ---- #undef EXTCONST #undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) + /* Suppress portability warnings from DECC for VMS-specific extensions */ + # ifdef __DECC + # pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT) + # endif # define EXT globaldef {"$GLOBAL_RW_VARS"} noshare # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare # define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else + # ifdef __cplusplus + # define EXT + # define dEXT + # define EXTCONST extern const + # define dEXTCONST const + #else # define EXT # define dEXT # define EXTCONST const # define dEXTCONST const + #endif #endif #undef INIT diff -c 'perl5.004_04/MANIFEST' 'perl5.004_05/MANIFEST' Index: ./MANIFEST *** ./MANIFEST Wed Oct 8 11:16:23 1997 --- ./MANIFEST Thu Apr 29 11:36:47 1999 *************** *** 13,24 **** --- 13,30 ---- INTERN.h Included before domestic .h files MANIFEST This list of files Makefile.SH A script that generates Makefile + Porting/Contract Social contract for contributed modules in Perl core Porting/Glossary Glossary of config.sh variables + Porting/genlog Generate formatted changelogs by querying p4d Porting/makerel Release making utility + Porting/p4d2p Generate standard patches from p4 diffs + Porting/p4desc Smarter 'p4 describe', outputs diffs for new files + Porting/patching.pod How to report changes made to Perl 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.beos Notes about BeOS port README.cygwin32 Notes about Cygwin32 port README.os2 Notes about OS/2 port README.plan9 Notes about Plan9 port *************** *** 29,34 **** --- 35,41 ---- XSUB.h Include file for extension subroutines av.c Array value code av.h Array value header + beos/nm.c BeOS port cflags.SH A script that emits C compilation flags per file compat3.sym List of symbols for binary-compatibility with 5.003 config_H Sample config.h *************** *** 49,59 **** --- 56,68 ---- eg/ADB An adb wrapper to put in your crash dir eg/README Intro to example perl scripts eg/cgi/RunMeFirst Setup script for CGI examples + eg/cgi/caution.xbm Small image for CGI examples eg/cgi/clickable_image.cgi CGI example eg/cgi/cookie.cgi CGI example eg/cgi/crash.cgi CGI example eg/cgi/customize.cgi CGI example eg/cgi/diff_upload.cgi CGI example + eg/cgi/dna.small.gif.uu Small image for CGI examples eg/cgi/file_upload.cgi CGI example eg/cgi/frameset.cgi CGI example eg/cgi/index.html Index page for CGI examples *************** *** 62,67 **** --- 71,77 ---- eg/cgi/monty.cgi CGI example eg/cgi/multiple_forms.cgi CGI example eg/cgi/nph-clock.cgi CGI example + eg/cgi/nph-multipart.cgi CGI example eg/cgi/popup.cgi CGI example eg/cgi/save_state.cgi CGI example eg/cgi/tryit.cgi CGI example *************** *** 109,114 **** --- 119,126 ---- eg/who A sample who program eg/wrapsuid A setuid script wrapper generator emacs/cperl-mode.el An alternate perl-mode + emacs/e2ctags.pl etags to ctags converter + emacs/ptags Creates smart TAGS file embed.h Maps symbols to safer names embed.pl Produces embed.h ext/DB_File/DB_File.pm Berkeley DB extension Perl module *************** *** 116,122 **** ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder ext/DB_File/Makefile.PL Berkeley DB extension makefile writer ext/DB_File/typemap Berkeley DB extension interface types ! ext/DynaLoader/DynaLoader.pm 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 --- 128,134 ---- ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder ext/DB_File/Makefile.PL Berkeley DB extension makefile writer ext/DB_File/typemap Berkeley DB extension interface types ! 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 *************** *** 172,178 **** --- 184,196 ---- 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/freebsd.pl Hint for POSIX for named architecture + ext/POSIX/hints/linux.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 + ext/POSIX/hints/sunos_4.pl Hint for POSIX for named architecture ext/POSIX/typemap POSIX extension interface types ext/SDBM_File/Makefile.PL SDBM extension makefile writer ext/SDBM_File/SDBM_File.pm SDBM extension Perl module *************** *** 234,239 **** --- 252,258 ---- hints/amigaos.sh Hints for named architecture hints/apollo.sh Hints for named architecture hints/aux_3.sh Hints for named architecture + hints/beos.sh Hints for named architecture hints/broken-db.msg Warning message for systems with broken DB library hints/bsdos.sh Hints for named architecture hints/convexos.sh Hints for named architecture *************** *** 272,277 **** --- 291,297 ---- hints/next_3.sh Hints for named architecture hints/next_3_0.sh Hints for named architecture hints/next_4.sh Hints for named architecture + hints/openbsd.sh Hints for named architecture hints/opus.sh Hints for named architecture hints/os2.sh Hints for named architecture hints/os390.sh Hints for named architecture *************** *** 313,318 **** --- 333,339 ---- lib/CGI.pm Web server interface ("Common Gateway Interface") lib/CGI/Apache.pm Support for Apache's Perl module lib/CGI/Carp.pm Log server errors with helpful context + lib/CGI/Cookie.pm Support for cookies lib/CGI/Fast.pm Support for FastCGI (persistent server process) lib/CGI/Push.pm Support for server push lib/CGI/Switch.pm Simple interface for multiple server types *************** *** 349,354 **** --- 370,381 ---- lib/File/DosGlob.pm Win32 DOS-globbing module lib/File/Find.pm Routines to do a find lib/File/Path.pm Do things like `mkdir -p' and `rm -r' + lib/File/Spec.pm Portable operations on file names + lib/File/Spec/Mac.pm Portable operations on Mac file names + lib/File/Spec/OS2.pm Portable operations on OS2 file names + lib/File/Spec/Unix.pm Portable operations on Unix file names + lib/File/Spec/VMS.pm Portable operations on VMS file names + lib/File/Spec/Win32.pm Portable operations on Win32 file names lib/File/stat.pm By-name interface to Perl's builtin stat lib/FileCache.pm Keep more files open than the system permits lib/FileHandle.pm Backward-compatible front end to IO extension *************** *** 380,391 **** --- 407,420 ---- lib/Term/Cap.pm Perl module supporting termcap usage lib/Term/Complete.pm A command completion subroutine lib/Term/ReadLine.pm Stub readline library + lib/Test.pm A simple framework for writing test scripts lib/Test/Harness.pm A test harness lib/Text/Abbrev.pm An abbreviation table builder lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter lib/Text/Soundex.pm Perl module to implement Soundex lib/Text/Tabs.pm Do expand and unexpand lib/Text/Wrap.pm Paragraph formatter + lib/Tie/Handle.pm Base class for tied handles lib/Tie/Hash.pm Base class for tied hashes lib/Tie/RefHash.pm Base class for tied hashes with references as keys lib/Tie/Scalar.pm Base class for tied scalars *************** *** 399,404 **** --- 428,434 ---- lib/User/pwent.pm By-name interface to Perl's builtin getpw* lib/abbrev.pl An abbreviation table builder lib/assert.pl assertion and panic with stack trace + lib/attrs.pm attrs extension Perl module (stub) lib/autouse.pm Load and call a function only when it's used lib/base.pm Establish IS-A relationship at compile time lib/bigfloat.pl An arbitrary precision floating point package *************** *** 435,440 **** --- 465,471 ---- lib/overload.pm Module for overloading perl operators lib/perl5db.pl Perl debugging routines lib/pwd.pl Routines to keep track of PWD environment variable + lib/re.pm Pragmas for regular expressions lib/shellwords.pl Perl library to split into words with shell quoting lib/sigtrap.pm For trapping an abort and giving traceback lib/stat.pl Perl library supporting stat function *************** *** 560,573 **** --- 591,607 ---- pod/perlform.pod Format info pod/perlfunc.pod Function info pod/perlguts.pod Internals info + pod/perlhist.pod Perl history info pod/perlipc.pod IPC info pod/perllocale.pod Locale support info pod/perllol.pod How to use lists of lists pod/perlmod.pod Module mechanism info + pod/perlmodinstall.pod Installing CPAN Modules pod/perlmodlib.pod Module policy info pod/perlobj.pod Object info pod/perlop.pod Operator info pod/perlpod.pod Pod info + pod/perlport.pod Portability guide pod/perlre.pod Regular expression info pod/perlref.pod References info pod/perlrun.pod Execution info *************** *** 629,634 **** --- 663,669 ---- t/comp/package.t See if packages work t/comp/proto.t See if function prototypes work t/comp/redef.t See if we get correct warnings on redefined subs + t/comp/require.t See if require works t/comp/script.t See if script invokation works t/comp/term.t See if more terms work t/comp/use.t See if pragmas work *************** *** 661,669 **** --- 696,708 ---- t/lib/filefind.t See if File::Find works t/lib/filehand.t See if FileHandle works t/lib/filepath.t See if File::Path works + t/lib/filespec.t See if File::Spec works t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long works + t/lib/h2ph.h Test header file for h2ph + t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison + t/lib/h2ph.t See if h2ph works like it should t/lib/hostname.t See if Sys::Hostname works t/lib/io_dup.t See if dup()-related methods from IO work t/lib/io_pipe.t See if pipe()-related methods from IO work *************** *** 680,685 **** --- 719,725 ---- t/lib/open3.t See if IPC::Open3 works t/lib/ops.t See if Opcode works t/lib/parsewords.t See if Text::ParseWords works + t/lib/ph.t See if h2ph works t/lib/posix.t See if POSIX works t/lib/safe1.t See if Safe works t/lib/safe2.t See if Safe works *************** *** 703,709 **** --- 743,752 ---- t/op/closure.t See if closures work t/op/cmp.t See if the various string and numeric compare work t/op/cond.t See if conditional expressions work + t/op/defins.t See if auto-insert of defined() works t/op/delete.t See if delete works + t/op/die.t See if die works + t/op/die_exit.t See if die and exit status interaction works t/op/do.t See if subroutines work t/op/each.t See if hash iterators work t/op/eval.t See if eval operator works *************** *** 713,720 **** --- 756,765 ---- 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/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 t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works t/op/int.t See if int works *************** *** 730,735 **** --- 775,781 ---- t/op/ord.t See if ord works t/op/pack.t See if pack and unpack work t/op/pat.t See if esoteric patterns work + t/op/pos.t See if pos works t/op/push.t See if push and pop work t/op/quotemeta.t See if quotemeta works t/op/rand.t See if rand works *************** *** 753,758 **** --- 799,805 ---- t/op/sysio.t See if sysread and syswrite work t/op/taint.t See if tainting works t/op/tie.t See if tie/untie functions work + t/op/tiehandle.t See if tie for handles works t/op/time.t See if time functions work t/op/undef.t See if undef works t/op/universal.t See if UNIVERSAL class works *************** *** 820,837 **** win32/Makefile Win32 makefile for NMAKE (Visual C++ build) win32/TEST Win32 port win32/autosplit.pl Win32 port ! win32/bin/network.pl Win32 port win32/bin/pl2bat.pl wrap perl scripts into batch files win32/bin/runperl.pl run perl script via batch file namesake win32/bin/search.pl Win32 port - win32/bin/webget.pl Win32 port - win32/bin/www.pl Win32 port win32/config.bc Win32 base line config.sh (Borland C++ build) win32/config.vc Win32 base line config.sh (Visual C++ build) win32/config_H.bc Win32 config header (Borland C++ build) win32/config_H.vc Win32 config header (Visual C++ build) win32/config_h.PL Perl code to convert Win32 config.sh to config.h win32/config_sh.PL Perl code to update Win32 config.sh from Makefile win32/dl_win32.xs Win32 port win32/genxsdef.pl Win32 port win32/include/arpa/inet.h Win32 port --- 867,883 ---- win32/Makefile Win32 makefile for NMAKE (Visual C++ build) win32/TEST Win32 port win32/autosplit.pl Win32 port ! win32/bin/perlglob.pl Win32 globbing win32/bin/pl2bat.pl wrap perl scripts into batch files win32/bin/runperl.pl run perl script via batch file namesake win32/bin/search.pl Win32 port win32/config.bc Win32 base line config.sh (Borland C++ build) win32/config.vc Win32 base line config.sh (Visual C++ build) win32/config_H.bc Win32 config header (Borland C++ build) win32/config_H.vc Win32 config header (Visual C++ build) win32/config_h.PL Perl code to convert Win32 config.sh to config.h win32/config_sh.PL Perl code to update Win32 config.sh from Makefile + win32/des_fcrypt.patch Win32 port win32/dl_win32.xs Win32 port win32/genxsdef.pl Win32 port win32/include/arpa/inet.h Win32 port *************** *** 849,856 **** win32/splittree.pl Win32 port win32/win32.c Win32 port win32/win32.h Win32 port - win32/win32io.c Win32 port - win32/win32io.h Win32 port win32/win32iop.h Win32 port win32/win32sck.c Win32 port writemain.SH Generate perlmain.c from miniperlmain.c+extensions --- 895,900 ---- diff -c 'perl5.004_04/Makefile.SH' 'perl5.004_05/Makefile.SH' Index: ./Makefile.SH *** ./Makefile.SH Wed Oct 15 05:33:16 1997 --- ./Makefile.SH Tue Apr 27 05:38:22 1999 *************** *** 25,32 **** --- 25,37 ---- linklibperl='$(LIBPERL)' shrpldflags='$(LDDLFLAGS)' + ldlibpth='' case "$useshrplib" in true) + # Prefix all runs of 'miniperl' and 'perl' with + # $ldlibpth so that ./perl finds *this* libperl.so. + ldlibpth="LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH" + pldlflags="$cccdlflags" # NeXT-4 specific stuff. Can't we do this in the hint file? case "${osname}${osvers}" in *************** *** 35,44 **** lddlflags="-dynamic -undefined warning -framework System \ -compatibility_version 1 -current_version $patchlevel \ -prebind -seg1addr 0x27000000 -install_name \$(shrpdir)/\$@" ;; ! sunos*|freebsd[23]*|netbsd*) linklibperl="-lperl" ;; aix*) shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp" case "$osvers" in --- 40,60 ---- lddlflags="-dynamic -undefined warning -framework System \ -compatibility_version 1 -current_version $patchlevel \ -prebind -seg1addr 0x27000000 -install_name \$(shrpdir)/\$@" + # NeXT uses a different name. + ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH" + ;; + rhapsody*) + ldlibpth="DYLD_LIBRARY_PATH=`pwd`/Perl:$DYLD_LIBRARY_PATH" ;; ! os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH. ! ldlibpth='' ! ;; ! sunos*) linklibperl="-lperl" ;; + netbsd*|freebsd[234]*) + linklibperl="-L. -lperl" + ;; aix*) shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp" case "$osvers" in *************** *** 52,60 **** aixinstdir=`pwd | sed 's/\/UU$//'` linklibperl="-L $archlibexp/CORE -L $aixinstdir -lperl" ;; ! hpux10*) linklibperl="-L `pwd | sed 's/\/UU$//'` -Wl,+b$archlibexp/CORE -lperl" ;; esac ;; *) pldlflags='' --- 68,78 ---- aixinstdir=`pwd | sed 's/\/UU$//'` linklibperl="-L $archlibexp/CORE -L $aixinstdir -lperl" ;; ! hpux10*|hpux11*) linklibperl="-L `pwd | sed 's/\/UU$//'` -Wl,+b$archlibexp/CORE -lperl" ;; + beos*) ldlibpth="LIBRARY_PATH=`pwd`:$LIBRARY_PATH" + ;; esac ;; *) pldlflags='' *************** *** 124,129 **** --- 142,151 ---- LLIBPERL= $linklibperl SHRPENV = $shrpenv + # The following is used to include the current directory in + # LD_LIBRARY_PATH if you are building a shared libperl.so. + LDLIBPTH = $ldlibpth + dynamic_ext = $dynamic_list static_ext = $static_list ext = \$(dynamic_ext) \$(static_ext) *************** *** 220,229 **** @echo " "; echo " Everything is up to date." translators: miniperl lib/Config.pm FORCE ! @echo " "; echo " Making x2p stuff"; cd x2p; $(MAKE) all utilities: miniperl lib/Config.pm FORCE ! @echo " "; echo " Making utilities"; cd utils; $(MAKE) all # This is now done by installman only if you actually want the man pages. --- 242,251 ---- @echo " "; echo " Everything is up to date." translators: miniperl lib/Config.pm FORCE ! @echo " "; echo " Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all utilities: miniperl lib/Config.pm FORCE ! @echo " "; echo " Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all # This is now done by installman only if you actually want the man pages. *************** *** 272,277 **** --- 294,300 ---- case "$osname" in aix) $spitshell >>Makefile <<'!NO!SUBS!' + rm -f libperl$(OBJ_EXT) mv $@ libperl$(OBJ_EXT) $(AR) qv $(LIBPERL) libperl$(OBJ_EXT) !NO!SUBS! *************** *** 299,318 **** # The Module used here must not depend on Config or any extensions. miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) ! $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs) ! @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) # This version, if specified in Configure, does ONLY those scripts which need # set-id emulation. Suidperl must be setuid root. It contains the "taint" --- 322,341 ---- # The Module used here must not depend on Config or any extensions. miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) ! $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs) ! $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) # This version, if specified in Configure, does ONLY those scripts which need # set-id emulation. Suidperl must be setuid root. It contains the "taint" *************** *** 320,326 **** # has been invoked correctly. suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) !NO!SUBS! --- 343,349 ---- # has been invoked correctly. suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs ! $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) !NO!SUBS! *************** *** 340,378 **** preplibrary: miniperl lib/Config.pm $(plextract) @sh ./makedir lib/auto @echo " AutoSplitting perl library" ! @./miniperl -Ilib -e 'use AutoSplit; \ autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm # Take care to avoid modifying lib/Config.pm without reason # (If trying to create a new port and having problems with the configpm script, # try 'make minitest' and/or commenting out the tests at the end of configpm.) lib/Config.pm: config.sh miniperl configpm ! ./miniperl configpm tmp ! sh mv-if-diff tmp lib/Config.pm lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm ! ./miniperl minimod.pl > tmp && mv tmp $@ $(plextract): miniperl lib/Config.pm ! ./miniperl -Ilib $@.PL install: all install.perl install.man install.perl: all installperl ! ./perl installperl install.man: all installman ! ./perl installman # XXX Experimental. Hardwired values, but useful for testing. # Eventually Configure could ask for some of these values. install.html: all installhtml ! ./perl installhtml \ ! --podroot=. --podpath=. --recurse \ ! --htmldir=$(privlib)/html \ ! --htmlroot=$(privlib)/html \ ! --splithead=pod/perlipc \ ! --splititem=pod/perlfunc \ --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ --verbose --- 363,402 ---- preplibrary: miniperl lib/Config.pm $(plextract) @sh ./makedir lib/auto @echo " AutoSplitting perl library" ! $(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \ autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm # Take care to avoid modifying lib/Config.pm without reason # (If trying to create a new port and having problems with the configpm script, # try 'make minitest' and/or commenting out the tests at the end of configpm.) lib/Config.pm: config.sh miniperl configpm ! $(LDLIBPTH) ./miniperl configpm tmp ! sh mv-if-diff tmp $@ lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm ! $(LDLIBPTH) ./miniperl minimod.pl > tmp ! sh mv-if-diff tmp $@ $(plextract): miniperl lib/Config.pm ! $(LDLIBPTH) ./miniperl -Ilib $@.PL install: all install.perl install.man install.perl: all installperl ! $(LDLIBPTH) ./perl installperl install.man: all installman ! $(LDLIBPTH) ./perl installman # XXX Experimental. Hardwired values, but useful for testing. # Eventually Configure could ask for some of these values. install.html: all installhtml ! $(LDLIBPTH) ./perl installhtml \ ! --podroot=. --podpath=. --recurse \ ! --htmldir=$(privlib)/html \ ! --htmlroot=$(privlib)/html \ ! --splithead=pod/perlipc \ ! --splititem=pod/perlfunc \ --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ --verbose *************** *** 429,441 **** # DynaLoader may be needed for extensions that use Makefile.PL. $(DYNALOADER): miniperl preplibrary FORCE ! @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) d_dummy $(dynamic_ext): miniperl preplibrary $(DYNALOADER) FORCE ! @sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE ! @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) clean: _tidy _mopup --- 453,465 ---- # DynaLoader may be needed for extensions that use Makefile.PL. $(DYNALOADER): miniperl preplibrary FORCE ! @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) d_dummy $(dynamic_ext): miniperl preplibrary $(DYNALOADER) FORCE ! @$(LDLIBPTH) sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE ! @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) clean: _tidy _mopup *************** *** 514,528 **** makedepend: makedepend.SH config.sh sh ./makedepend.SH ! test-prep: miniperl perl preplibrary $(dynamic_ext) cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) test check: test-prep ! cd t && ./perl TEST .clist --- 554,573 ---- @echo "You may see some irrelevant test failures if you have been unable" @echo "to build lib/Config.pm." - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \ ! && $(LDLIBPTH) ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t .clist diff -c /dev/null 'perl5.004_05/Porting/Contract' Index: ./Porting/Contract *** ./Porting/Contract Wed Dec 31 19:00:00 1969 --- ./Porting/Contract Thu Apr 23 15:49:22 1998 *************** *** 0 **** --- 1,108 ---- + + Contributed Modules in Perl Core + A Social Contract about Artistic Control + + What follows is a statement about artistic control, defined as the ability + of authors of packages to guide the future of their code and maintain + control over their work. It is a recognition that authors should have + control over their work, and that it is a responsibility of the rest of + the Perl community to ensure that they retain this control. It is an + attempt to document the standards to which we, as Perl developers, intend + to hold ourselves. It is an attempt to write down rough guidelines about + the respect we owe each other as Perl developers. + + This statement is not a legal contract. This statement is not a legal + document in any way, shape, or form. Perl is distributed under the GNU + Public License and under the Artistic License; those are the precise legal + terms. This statement isn't about the law or licenses. It's about + community, mutual respect, trust, and good-faith cooperation. + + We recognize that the Perl core, defined as the software distributed with + the heart of Perl itself, is a joint project on the part of all of us. + >From time to time, a script, module, or set of modules (hereafter referred + to simply as a "module") will prove so widely useful and/or so integral to + the correct functioning of Perl itself that it should be distributed with + Perl core. This should never be done without the author's explicit + consent, and a clear recognition on all parts that this means the module + is being distributed under the same terms as Perl itself. A module author + should realize that inclusion of a module into the Perl core will + necessarily mean some loss of control over it, since changes may + occasionally have to be made on short notice or for consistency with the + rest of Perl. + + Once a module has been included in the Perl core, however, everyone + involved in maintaining Perl should be aware that the module is still the + property of the original author unless the original author explicitly + gives up their ownership of it. In particular: + + 1) The version of the module in the core should still be considered the + work of the original author. All patches, bug reports, and so forth + should be fed back to them. Their development directions should be + respected whenever possible. + + 2) Patches may be applied by the pumpkin holder without the explicit + cooperation of the module author if and only if they are very minor, + time-critical in some fashion (such as urgent security fixes), or if + the module author cannot be reached. Those patches must still be + given back to the author when possible, and if the author decides on + an alternate fix in their version, that fix should be strongly + preferred unless there is a serious problem with it. Any changes not + endorsed by the author should be marked as such, and the contributor + of the change acknowledged. + + 3) The version of the module distributed with Perl should, whenever + possible, be the latest version of the module as distributed by the + author (the latest non-beta version in the case of public Perl + releases), although the pumpkin holder may hold off on upgrading the + version of the module distributed with Perl to the latest version + until the latest version has had sufficient testing. + + In other words, the author of a module should be considered to have final + say on modifications to their module whenever possible (bearing in mind + that it's expected that everyone involved will work together and arrive at + reasonable compromises when there are disagreements). + + As a last resort, however: + + 4) If the author's vision of the future of their module is sufficiently + different from the vision of the pumpkin holder and perl5-porters as a + whole so as to cause serious problems for Perl, the pumpkin holder may + choose to formally fork the version of the module in the core from the + one maintained by the author. This should not be done lightly and + should *always* if at all possible be done only after direct input + from Larry. If this is done, it must then be made explicit in the + module as distributed with Perl core that it is a forked version and + that while it is based on the original author's work, it is no longer + maintained by them. This must be noted in both the documentation and + in the comments in the source of the module. + + Again, this should be a last resort only. Ideally, this should never + happen, and every possible effort at cooperation and compromise should be + made before doing this. If it does prove necessary to fork a module for + the overall health of Perl, proper credit must be given to the original + author in perpetuity and the decision should be constantly re-evaluated to + see if a remerging of the two branches is possible down the road. + + In all dealings with contributed modules, everyone maintaining Perl should + keep in mind that the code belongs to the original author, that they may + not be on perl5-porters at any given time, and that a patch is not + official unless it has been integrated into the author's copy of the + module. To aid with this, and with points #1, #2, and #3 above, contact + information for the authors of all contributed modules should be kept with + the Perl distribution. + + Finally, the Perl community as a whole recognizes that respect for + ownership of code, respect for artistic control, proper credit, and active + effort to prevent unintentional code skew or communication gaps is vital + to the health of the community and Perl itself. Members of a community + should not normally have to resort to rules and laws to deal with each + other, and this document, although it contains rules so as to be clear, is + about an attitude and general approach. The first step in any dispute + should be open communication, respect for opposing views, and an attempt + at a compromise. In nearly every circumstance nothing more will be + necessary, and certainly no more drastic measure should be used until + every avenue of communication and discussion has failed. + + -- + Version 1.2. By Russ Allbery (rra@stanford.edu) and the perl5-porters. + diff -c 'perl5.004_04/Porting/Glossary' 'perl5.004_05/Porting/Glossary' Index: ./Porting/Glossary *** ./Porting/Glossary Mon Feb 10 10:37:46 1997 --- ./Porting/Glossary Fri May 15 11:28:45 1998 *************** *** 454,480 **** to poll active file descriptors. d_pwage (i_pwd.U): ! This varaible conditionally defines PWAGE, which indicates that struct passwd contains pw_age. d_pwchange (i_pwd.U): ! This varaible conditionally defines PWCHANGE, which indicates that struct passwd contains pw_change. d_pwclass (i_pwd.U): ! This varaible conditionally defines PWCLASS, which indicates that struct passwd contains pw_class. d_pwcomment (i_pwd.U): ! This varaible conditionally defines PWCOMMENT, which indicates that struct passwd contains pw_comment. d_pwexpire (i_pwd.U): ! This varaible conditionally defines PWEXPIRE, which indicates that struct passwd contains pw_expire. d_pwquota (i_pwd.U): ! This varaible conditionally defines PWQUOTA, which indicates that struct passwd contains pw_quota. d_readdir (d_readdir.U): --- 454,484 ---- to poll active file descriptors. d_pwage (i_pwd.U): ! This variable conditionally defines PWAGE, which indicates that struct passwd contains pw_age. d_pwchange (i_pwd.U): ! This variable conditionally defines PWCHANGE, which indicates that struct passwd contains pw_change. d_pwclass (i_pwd.U): ! This variable conditionally defines PWCLASS, which indicates that struct passwd contains pw_class. d_pwcomment (i_pwd.U): ! This variable conditionally defines PWCOMMENT, which indicates that struct passwd contains pw_comment. d_pwexpire (i_pwd.U): ! This variable conditionally defines PWEXPIRE, which indicates that struct passwd contains pw_expire. + d_pwgecos (i_pwd.U): + This variable conditionally defines PWGECOS, which indicates + that struct passwd contains pw_gecos. + d_pwquota (i_pwd.U): ! This variable conditionally defines PWQUOTA, which indicates that struct passwd contains pw_quota. d_readdir (d_readdir.U): diff -c /dev/null 'perl5.004_05/Porting/genlog' Index: ./Porting/genlog *** ./Porting/genlog Wed Dec 31 19:00:00 1969 --- ./Porting/genlog Mon Apr 26 15:11:12 1999 *************** *** 0 **** --- 1,119 ---- + #!/usr/bin/perl -w + # + # Generate a nice changelist by querying perforce. + # + # Each change is described with the change number, description, + # which branch the change happened in, files modified, + # and who was responsible for entering the change. + # + # Can be called with a list of change numbers or a range of the + # form "12..42". Changelog will be printed from highest number + # to lowest. + # + # Outputs the changelist to stdout. + # + # Gurusamy Sarathy + # + + use Text::Wrap; + + $0 =~ s|^.*/||; + unless (@ARGV) { + die < + USAGE + } + + my @changes; + + my %editkind; + @editkind{ qw( add edit delete integrate branch )} + = qw( + ! - !> +> ); + + my $p4port = $ENV{P4PORT} || 'localhost:1666'; + + while (@ARGV) { + $_ = shift; + if (/^(\d+)\.\.(\d+)$/) { + push @changes, $1 .. $2; + } + elsif (/^\d+$/) { + push @changes, $_; + } + elsif (/^-p(.*)$/) { + $p4port = $1 || shift; + } + else { + warn "Arguments must be change numbers, ignoring `$_'\n"; + } + } + + @changes = sort { $b <=> $a } @changes; + + my @desc = `p4 -p $p4port describe -s @changes`; + if ($?) { + die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n"; + } + else { + chomp @desc; + while (@desc) { + my ($change,$who,$date,$time,@log,$branch,$file,$type,%files); + $_ = shift @desc; + if (/^Change (\d+) by (\w+)\@.+ on (\S+) (\S+)\s*$/) { + ($change, $who, $date, $time) = ($1,$2,$3,$4); + $_ = shift @desc; # get rid of empty line + while (@desc) { + $_ = shift @desc; + last if /^Affected/; + push @log, $_; + } + if (/^Affected/) { + $_ = shift @desc; # get rid of empty line + while ($_ = shift @desc) { + last unless /^\.\.\./; + if (m{^\.\.\. //depot/(.*?perl|[^/]*)/([^#]+)#\d+ (\w+)\s*$}) { + ($branch,$file,$type) = ($1,$2,$3); + $files{$branch} = {} unless exists $files{$branch}; + $files{$branch}{$type} = [] unless exists $files{$branch}{$type}; + push @{$files{$branch}{$type}}, $file; + } + else { + warn "Unknown line [$_], ignoring\n"; + } + } + } + } + next unless $change; + print "_" x 76, "\n"; + printf < 25 && ($kind eq 'integrate' + || $kind eq 'branch')) + || @$files > 100; + print wrap(sprintf("%12s ", $editkind{$kind}), + sprintf("%12s ", $editkind{$kind}), + "@$files\n"); + } + } + } + } diff -c 'perl5.004_04/Porting/makerel' 'perl5.004_05/Porting/makerel' Index: ./Porting/makerel *** ./Porting/makerel Mon Sep 22 05:54:02 1997 --- ./Porting/makerel Mon Apr 26 16:07:41 1999 *************** *** 1,4 **** ! #!/bin/env perl -w # A first attempt at some automated support for making a perl release. # Very basic but functional - if you're on a unix system. --- 1,4 ---- ! #!/usr/bin/perl -w # A first attempt at some automated support for making a perl release. # Very basic but functional - if you're on a unix system. *************** *** 17,36 **** die "Must be in root of the perl source tree.\n" unless -f "./MANIFEST" and -f "patchlevel.h"; ! $patchlevel_h = `grep '#define ' patchlevel.h`; print $patchlevel_h; $patchlevel = $1 if $patchlevel_h =~ /PATCHLEVEL\s+(\d+)/; $subversion = $1 if $patchlevel_h =~ /SUBVERSION\s+(\d+)/; ! die "Unable to parse patchlevel.h" unless $subversion > 0; $vers = sprintf("5.%03d", $patchlevel); ! $vers.= sprintf( "_%02d", $subversion) if $subversion; ! $perl = "perl$vers"; ! $reldir = "$relroot/$perl"; ! $reldir .= "-$ARGV[0]" if $ARGV[0]; ! print "\nMaking a release for $perl in $reldir\n\n"; print "Cross-checking the MANIFEST...\n"; ($missfile, $missentry) = fullcheck(); --- 17,51 ---- die "Must be in root of the perl source tree.\n" unless -f "./MANIFEST" and -f "patchlevel.h"; ! open PATCHLEVEL,"; ! close PATCHLEVEL; ! my $patchlevel_h = join "", grep { /^#define/ } @patchlevel_h; print $patchlevel_h; $patchlevel = $1 if $patchlevel_h =~ /PATCHLEVEL\s+(\d+)/; $subversion = $1 if $patchlevel_h =~ /SUBVERSION\s+(\d+)/; ! die "Unable to parse patchlevel.h" unless $subversion >= 0; $vers = sprintf("5.%03d", $patchlevel); ! $vms_vers = sprintf("5_%03d", $patchlevel); ! if ($subversion) { ! $vers.= sprintf( "_%02d", $subversion); ! $vms_vers.= sprintf( "%02d", $subversion); ! } else { ! $vms_vers.= " "; ! } ! # fetch list of local patches ! my (@local_patches, @lpatch_tags, $lpatch_tags); ! @local_patches = grep { /^static.*local_patches/../^};/ } @patchlevel_h; ! @local_patches = grep { !/^\s*,?NULL/ } @local_patches; ! @lpatch_tags = map { /^\s*,"(\w+)/ } @local_patches; ! $lpatch_tags = join "-", @lpatch_tags; ! $perl = "perl$vers"; ! $reldir = "$perl"; ! $reldir .= "-$lpatch_tags" if $lpatch_tags; + print "\nMaking a release for $perl in $relroot/$reldir\n\n"; print "Cross-checking the MANIFEST...\n"; ($missfile, $missentry) = fullcheck(); *************** *** 47,58 **** print "\n"; print "Setting file permissions...\n"; system("find . -type f -print | xargs chmod -w"); ! system("find . -type d -print | xargs chmod g-s"); system("find t -name '*.t' -print | xargs chmod +x"); system("chmod +w configure"); # special case (see pumpkin.pod) ! @exe = qw( Configure configpm configure --- 62,92 ---- print "\n"; + print "Creating $relroot/$reldir release directory...\n"; + die "$relroot/$reldir release directory already exists\n" if -e "$relroot/$reldir"; + die "$relroot/$reldir.tar.gz release file already exists\n" if -e "$relroot/$reldir.tar.gz"; + mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n"; + print "\n"; + + print "Copying files to release directory...\n"; + # ExtUtils::Manifest maniread does not preserve the order + $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir"; + system($cmd) == 0 or die "$cmd failed"; + print "\n"; + + + chdir "$relroot/$reldir" or die $!; + + + print "Updating VMS version specific files with $vms_vers...\n"; + system("perl -pi -e 's/^\QPERL_VERSION = \E\d\_\d+(\s*\#)/PERL_VERSION = $vms_vers$1/' vms/descrip.mms"); + print "Setting file permissions...\n"; system("find . -type f -print | xargs chmod -w"); ! system("find . -type d -print | xargs chmod 755"); system("find t -name '*.t' -print | xargs chmod +x"); system("chmod +w configure"); # special case (see pumpkin.pod) ! my @exe = qw( Configure configpm configure *************** *** 74,99 **** Porting/makerel ); system("chmod +x @exe"); - print "\n"; - - - print "Creating $reldir release directory...\n"; - die "$reldir release directory already exists\n" if -e "../$perl"; - die "$reldir.tar.gz release file already exists\n" if -e "../$reldir.tar.gz"; - mkdir($reldir, 0755) or die "mkdir $reldir: $!\n"; - print "\n"; ! ! print "Copying files to release directory...\n"; ! # ExtUtils::Manifest maniread does not preserve the order ! $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $reldir"; ! system($cmd) == 0 or die "$cmd failed"; print "\n"; ! chdir $relroot or die $!; print "Creating and compressing the tar file...\n"; ! $cmd = "tar cf - $perl | gzip --best > $perl.tar.gz"; system($cmd) == 0 or die "$cmd failed"; print "\n"; --- 108,128 ---- Porting/makerel ); system("chmod +x @exe"); ! print "Adding CRs to DOSish files...\n"; ! my @crlf = qw( ! README.win32 ! win32/Makefile ! win32/makefile.mk ! ); ! system("perl -pi -e 's/\$/\\r/' @crlf"); print "\n"; ! chdir ".." or die $!; print "Creating and compressing the tar file...\n"; ! my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch ! $cmd = "tar cf - $reldir | gzip --best > $reldir.tar.gz"; system($cmd) == 0 or die "$cmd failed"; print "\n"; diff -c /dev/null 'perl5.004_05/Porting/p4d2p' Index: ./Porting/p4d2p *** ./Porting/p4d2p Wed Dec 31 19:00:00 1969 --- ./Porting/p4d2p Thu Apr 29 11:01:02 1999 *************** *** 0 **** --- 1,84 ---- + #!/usr/bin/perl -wspi.bak + + # + # reads a perforce style diff on stdin and outputs appropriate headers + # so the diff can be applied with the patch program + # + # Gurusamy Sarathy + # + + BEGIN { + $0 =~ s|.*/||; + if ($h or $help) { + print STDERR < change-123.patch + + USAGE + exit(0); + } + unless (@ARGV) { @ARGV = '-'; undef $^I; } + use vars qw($thisfile $time $file $fnum $v $h $help); + $thisfile = ""; + $time = localtime(time); + } + + my ($cur, $match); + $cur = m<^==== //depot/(.+?)\#\d+.* ====$> ... m<^(\@\@.+\@\@|\*+)$>; + + $match = $1; + + if ($ARGV ne $thisfile) { + warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-'; + $thisfile = $ARGV; + } + + # while we are within range + if ($cur) { + # set the file name after first line + if ($cur == 1) { + $file = $match; + $fnum++; + } + # emit the diff header when we hit last line + elsif ($cur =~ /E0$/) { + my $f = $file; + + # special hack for perl so we can always use "patch -p1" + $f =~ s<^.*?(perl.*?/)><$1>; + + # unified diff + if ($match =~ /^\@/) { + warn "emitting udiff header\n" if $v; + $_ = "Index: $f\n--- $f.~1~\t$time\n+++ $f\t$time\n$_"; + } + # context diff + elsif ($match =~ /^\*/) { + warn "emitting cdiff header\n" if $v; + $_ = "Index: $f\n*** $f.~1~\t$time\n--- $f\t$time\n$_"; + } + } + # see if we hit another patch (i.e. previous patch was empty) + elsif (m<^==== //depot/(.+?)\#\d+.* ====$>) { + $file = $match = $1; + } + # suppress all other lines in the header + else { + $_ = ""; + } + warn "file [$file] line [$cur] file# [$fnum]\n" if $v; + } + + $_ .= "End of Patch.\n" if eof; diff -c /dev/null 'perl5.004_05/Porting/p4desc' Index: ./Porting/p4desc *** ./Porting/p4desc Wed Dec 31 19:00:00 1969 --- ./Porting/p4desc Sun Mar 28 01:00:46 1999 *************** *** 0 **** --- 1,117 ---- + #!/usr/bin/perl -wpi.bak + + # + # Munge "p4 describe ..." output to include new files. + # + # Gurusamy Sarathy + # + + use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles); + + BEGIN { + $0 =~ s|^.*/||; + $p4port = $ENV{P4PORT} || 'localhost:1666'; + for (@ARGV) { + if ($p4port =~ /^\s+$/) { + $p4port = $_; + } + elsif (/^-p(.*)$/) { + $p4port = $1 || ' '; + } + elsif (/^-v$/) { + $v++; + } + elsif (/^-h/) { + $h++; + } + else { + push @files, $_; + } + } + unless (@files) { @files = '-'; undef $^I; } + @ARGV = @files; + if ($h) { + print STDERR < change-123.desc + p4 describe -du 123 | $0 | p4d2p > change-123.patch + + USAGE + exit(0); + } + $thisfile = ""; + } + + + if ($ARGV ne $thisfile) { + warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-'; + $thisfile = $ARGV; + } + + my $cur = m|^Affected files| ... m|^Differences|; + + # while we are within range + if ($cur) { + if (m|^\.\.\. (//depot/.+?#\d+) add$|) { + my $newfile = $1; + push @addfiles, $newfile; + warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/; + } + warn "file [$file] line [$cur] file# [$fnum]\n" if $v; + } + + if (/^Change (\d+) by/) { + $_ = "\n\n" . $_ if $change; # start of a new change list + $change = $1; + my $new = newfiles(); + if ($new) { + $_ = $new . $_; + } + } + + if (eof) { + $_ .= newfiles(); + } + + sub newfiles { + my $addfile; + my $ret = ""; + for $addfile (@addfiles) { + my $type = `p4 -p $p4port files $addfile`; + if ($?) { + warn "$0: `p4 -p $p4port print $addfile` failed, status[$?]\n"; + next; + } + $type =~ m|^//.*\((.+)\)$| or next; + $type = $1; + unless ($type =~ /text/) { + $ret .= "\n==== $addfile ($type) ====\n\n"; + next; + } + my @new = `p4 -p $p4port print $addfile`; + if ($?) { + die "$0: `p4 -p $p4port print $addfile` failed, status[$?]\n"; + } + my $desc = shift @new; # discard initial description + $ret .= "\n==== $addfile ($type) ====\n\n"; + my $lines = "," . @new; + $lines = "" if @new < 2; + $ret .= "\@\@ -0,0 +1$lines \@\@\n"; + $ret .= join("+","",@new); + } + @addfiles = (); + return $ret; + } diff -c /dev/null 'perl5.004_05/Porting/patching.pod' Index: ./Porting/patching.pod *** ./Porting/patching.pod Wed Dec 31 19:00:00 1969 --- ./Porting/patching.pod Sun Jan 24 02:09:05 1999 *************** *** 0 **** --- 1,325 ---- + =head1 Name + + patching.pod - Appropriate format for patches to the perl source tree + + =head2 Where to get this document + + The latest version of this document is available from + http://perrin.dimensional.com/perl/perlpatch.html + + =head2 How to contribute to this document + + You may mail corrections, additions, and suggestions to me + at dgris@dimensional.com but the preferred method would be + to follow the instructions set forth in this document and + submit a patch 8-). + + =head1 Description + + =head2 Why this document exists + + As an open source project Perl relies on patches and contributions from + its users to continue functioning properly and to root out the inevitable + bugs. But, some users are unsure as to the I way to prepare a patch + and end up submitting seriously malformed patches. This makes it very + difficult for the current maintainer to integrate said patches into their + distribution. This document sets out usage guidelines for patches in an + attempt to make everybody's life easier. + + =head2 Common problems + + The most common problems appear to be patches being mangled by certain + mailers (I won't name names, but most of these seem to be originating on + boxes running a certain popular commercial operating system). Other problems + include patches not rooted in the appropriate place in the directory structure, + 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 + + =item Creating your patch + + First, back up the original files. This can't be stressed enough, + back everything up _first_. + + Also, please create patches against a clean distribution of the perl source. + This insures that everyone else can apply your patch without clobbering their + source tree. + + =item diff + + While individual tastes vary (and are not the point here) patches should + be created using either C<-u> or C<-c> arguments to diff. These produce, + respectively, unified diffs (where the changed line appears immediately next + to the original) and context diffs (where several lines surrounding the changes + are included). See the manpage for diff for more details. + + Also, the preferred method for patching is - + + C | C<-u>] Eold-fileE Enew-fileE> + + Note the order of files. + + Also, if your patch is to the core (rather than to a module) it + is better to create it as a context diff as some machines have + broken patch utilities that choke on unified diffs. + + GNU diff has many desirable features not provided by most vendor-supplied + diffs. Some examples using GNU diff: + + # generate a patch for a newly added file + % diff -u /dev/null new/file + + # generate a patch to remove a file (patch > v2.4 will remove it cleanly) + % diff -u old/goner /dev/null + + # get additions, deletions along with everything else, recursively + % diff -ruN olddir newdir + + # ignore whitespace + % diff -bu a/file b/file + + # show function name in every hunk (safer, more informative) + % diff -u -F '^[_a-zA-Z0-9]+ *(' old/file new/file + + + =item Directories + + Patches should be generated from the source root directory, not from the + directory that the patched file resides in. This insures that the maintainer + patches the proper file and avoids name collisions (especially common when trying + to apply patches to files that appear in both $src_root/ext/* and $src_root/lib/*). + It is better to diff the file in $src_root/ext than the file in $src_root/lib. + + =item Filenames + + The most usual convention when submitting patches for a single file is to make + your changes to a copy of the file with the same name as the original. Rename + the original file in such a way that it is obvious what is being patched ($file~ or + $file.old seem to be popular). + + If you are submitting patches that affect multiple files then you should backup + the entire directory tree (to $source_root.old/ for example). This will allow + C Eold-dirE Enew-dirE> to create all the patches + at once. + + =back + + =head2 What to include in your patch + + =over 4 + + =item Description of problem + + The first thing you should include is a description of the problem that + the patch corrects. If it is a code patch (rather than a documentation + patch) you should also include a small test case that illustrates the + bug. + + =item Direction for application + + You should include instructions on how to properly apply your patch. + These should include the files affected, any shell scripts or commands + that need to be run before or after application of the patch, and + the command line necessary for application. + + =item If you have a code patch + + If you are submitting a code patch there are several other things that + you need to do. + + =over 4 + + =item Comments, Comments, Comments + + Be sure to adequately comment your code. While commenting every + line is unnecessary, anything that takes advantage of side effects of + operators, that creates changes that will be felt outside of the + function being patched, or that others may find confusing should + be documented. If you are going to err, it is better to err on the + side of adding too many comments than too few. + + =item Style + + Please follow the indentation style and nesting style in use in the + block of code that you are patching. + + =item Testsuite + + When submitting a patch you should make every effort to also include + an addition to perl's regression tests to properly exercise your + patch. Your testsuite additions should generally follow these + guidelines (courtesy of Gurusamy Sarathy (gsar@engin.umich.edu))- + + Know what you're testing. Read the docs, and the source. + Tend to fail, not succeed. + Interpret results strictly. + Use unrelated features (this will flush out bizarre interactions). + Use non-standard idioms (otherwise you are not testing TIMTOWTDI). + Avoid using hardcoded test numbers whenever possible (the + EXPECTED/GOT found in t/op/tie.t is much more maintainable, + and gives better failure reports). + Give meaningful error messages when a test fails. + Avoid using qx// and system() unless you are testing for them. If you + do use them, make sure that you cover _all_ perl platforms. + Unlink any temporary files you create. + Promote unforeseen warnings to errors with $SIG{__WARN__}. + Be sure to use the libraries and modules shipped with version + being tested, not those that were already installed. + Add comments to the code explaining what you are testing for. + Make updating the '1..42' string unnecessary. Or make sure that + you update it. + Test _all_ behaviors of a given operator, library, or function- + All optional arguments + Return values in various contexts (boolean, scalar, list, lvalue) + Use both global and lexical variables + Don't forget the exceptional, pathological cases. + + =back + + =item Test your patch + + Apply your patch to a clean distribution, compile, and run the + regression test suite (you did remember to add one for your + patch, didn't you). + + =back + + =head2 An example patch creation + + This should work for most patches- + + cp MANIFEST MANIFEST.old + emacs MANIFEST + (make changes) + cd .. + diff -c perl5.008_42/MANIFEST.old perl5.008_42/MANIFEST > mypatch + (testing the patch:) + mv perl5.008_42/MANIFEST perl5.008_42/MANIFEST.new + cp perl5.008_42/MANIFEST.old perl5.008_42/MANIFEST + patch -p < mypatch + (should succeed) + diff perl5.008_42/MANIFEST perl5.008_42/MANIFEST.new + (should produce no output) + + =head2 Submitting your patch + + =over 4 + + =item Mailers + + Please, please, please (get the point? 8-) don't use a mailer that + word wraps your patch or that MIME encodes it. Both of these leave + the patch essentially worthless to the maintainer. + + If you have no choice in mailers and no way to get your hands on a + better one there is, of course, a perl solution. Just do this- + + perl -ne 'print pack("u*",$_)' patch > patch.uue + + and post patch.uue with a note saying to unpack it using + + perl -ne 'print unpack("u*",$_)' patch.uue > patch + + =item Subject lines for patches + + The subject line on your patch should read + + [PATCH]5.xxx_xx (Area) Description + + where the x's are replaced by the appropriate version number, + area is a short keyword identifying what area of perl you are + patching, and description is a very brief summary of the + problem (don't forget this is an email header). + + Examples- + + [PATCH]5.004_04 (DOC) fix minor typos + + [PATCH]5.004_99 (CORE) New warning for foo() when frobbing + + [PATCH]5.005_42 (CONFIG) Added support for fribnatz 1.5 + + =item Where to send your patch + + If your patch is for the perl core it should be sent perlbug@perl.org. + If it is a patch to a module that you downloaded from CPAN you should + submit your patch to that module's author. + + =back + + =head2 Applying a patch + + =over 4 + + =item General notes on applying patches + + The following are some general notes on applying a patch + to your perl distribution. + + =over 4 + + =item patch C<-p> + + It is generally easier to apply patches with the C<-p> argument to + patch. This helps reconcile differing paths between the machine the + patch was created on and the machine on which it is being applied. + + =item Cut and paste + + _Never_ cut and paste a patch into your editor. This usually clobbers + the tabs and confuses patch. + + =item Hand editing patches + + Avoid hand editing patches as this frequently screws up the whitespace + in the patch and confuses the patch program. + + =back + + =back + + =head2 Final notes + + If you follow these guidelines it will make everybody's life a little + easier. You'll have the satisfaction of having contributed to perl, + 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 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 January 1999 + Daniel Grisinger + + =head1 Author and Copyright Information + + 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 -c 'perl5.004_04/Porting/patchls' 'perl5.004_05/Porting/patchls' Index: ./Porting/patchls *** ./Porting/patchls Wed Oct 15 09:09:31 1997 --- ./Porting/patchls Mon Apr 26 15:10:50 1999 *************** *** 1,4 **** ! #!/bin/perl -w # # patchls - patch listing utility # --- 1,4 ---- ! #!/usr/bin/perl -w # # patchls - patch listing utility # *************** *** 17,26 **** use strict; use vars qw($VERSION); ! $VERSION = 2.04; sub usage { ! die q{ patchls [options] patchfile [ ... ] -h no filename headers (like grep), only the listing. --- 17,26 ---- use strict; use vars qw($VERSION); ! $VERSION = 2.10; sub usage { ! die qq{ patchls [options] patchfile [ ... ] -h no filename headers (like grep), only the listing. *************** *** 30,42 **** -m print formatted Meta-information (Subject,From,Msg-ID etc). -p N strip N levels of directory Prefix (like patch), else automatic. -v more verbose (-d for noisy debugging). -f F only list patches which patch files matching regexp F ! (F has $ appended unless it contains a /). other options for special uses: -I just gather and display summary Information about the patches. -4 write to stdout the PerForce commands to prepare for patching. -M T Like -m but only output listed meta tags (eg -M 'Title From') -W N set wrap width to N (defaults to 70, use 0 for no wrap) } } --- 30,49 ---- -m print formatted Meta-information (Subject,From,Msg-ID etc). -p N strip N levels of directory Prefix (like patch), else automatic. -v more verbose (-d for noisy debugging). + -n give a count of the number of patches applied to a file if >1. -f F only list patches which patch files matching regexp F ! (F has \$ appended unless it contains a /). ! -e Expect patched files to Exist (relative to current directory) ! Will print warnings for files which don't. Also affects -4 option. other options for special uses: -I just gather and display summary Information about the patches. -4 write to stdout the PerForce commands to prepare for patching. + -5 like -4 but add "|| exit 1" after each command -M T Like -m but only output listed meta tags (eg -M 'Title From') -W N set wrap width to N (defaults to 70, use 0 for no wrap) + -X list patchfiles that may clash (i.e. patch the same file) + + patchls version $VERSION by Tim Bunce } } *************** *** 44,83 **** $::opt_d = 0; $::opt_v = 0; $::opt_m = 0; $::opt_i = 0; $::opt_h = 0; $::opt_l = 0; $::opt_c = 0; $::opt_f = ''; # special purpose options $::opt_I = 0; $::opt_4 = 0; # output PerForce commands to prepare for patching $::opt_M = ''; # like -m but only output these meta items (-M Title) $::opt_W = 70; # set wrap width columns (see Text::Wrap module) usage unless @ARGV; ! getopts("mihlvc4p:f:IM:W:") or usage; $columns = $::opt_W || 9999999; $::opt_m = 1 if $::opt_M; ! my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID'); my %cat_title = ( 'BUILD' => 'BUILD PROCESS', 'CORE' => 'CORE LANGUAGE', 'DOC' => 'DOCUMENTATION', ! 'LIB' => 'LIBRARY AND EXTENSIONS', 'PORT1' => 'PORTABILITY - WIN32', 'PORT2' => 'PORTABILITY - GENERAL', 'TEST' => 'TESTS', 'UTIL' => 'UTILITIES', 'OTHER' => 'OTHER CHANGES', ); ! my %ls; # Style 1: # *** perl-5.004/embed.h Sat May 10 03:39:32 1997 --- 51,125 ---- $::opt_d = 0; $::opt_v = 0; $::opt_m = 0; + $::opt_n = 0; $::opt_i = 0; $::opt_h = 0; $::opt_l = 0; $::opt_c = 0; $::opt_f = ''; + $::opt_e = 0; # special purpose options $::opt_I = 0; $::opt_4 = 0; # output PerForce commands to prepare for patching + $::opt_5 = 0; $::opt_M = ''; # like -m but only output these meta items (-M Title) $::opt_W = 70; # set wrap width columns (see Text::Wrap module) + $::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented + $::opt_X = 0; # list patchfiles that patch the same file usage unless @ARGV; ! getopts("dmnihlvecC45Xp:f:IM:W:") or usage; $columns = $::opt_W || 9999999; $::opt_m = 1 if $::opt_M; ! $::opt_4 = 1 if $::opt_5; ! $::opt_i = 1 if $::opt_X; ! ! # see get_meta_info() ! my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID Files'); ! my %show_meta = map { ($_,1) } @show_meta; my %cat_title = ( 'BUILD' => 'BUILD PROCESS', 'CORE' => 'CORE LANGUAGE', 'DOC' => 'DOCUMENTATION', ! 'LIB' => 'LIBRARY', 'PORT1' => 'PORTABILITY - WIN32', 'PORT2' => 'PORTABILITY - GENERAL', 'TEST' => 'TESTS', 'UTIL' => 'UTILITIES', 'OTHER' => 'OTHER CHANGES', + 'EXT' => 'EXTENSIONS', + 'UNKNOWN' => 'UNKNOWN - NO FILES PATCHED', ); ! ! sub get_meta_info { ! my $ls = shift; ! local($_) = shift; ! if (/^From:\s+(.*\S)/i) {; ! my $from = $1; # temporary measure for Chip Salzenberg ! $from =~ s/chip\@(atlantic\.net|perlsupport\.com)/chip\@pobox.com/; ! $from =~ s/\(Tim Bunce\) \(Tim Bunce\)/(Tim Bunce)/; ! $ls->{From}{$from} = 1 ! } ! if (/^Subject:\s+(?:Re: )?(.*\S)/i) { ! my $title = $1; ! $title =~ s/\[(PATCH|PERL)[\w\. ]*\]:?//g; ! $title =~ s/\b(PATCH|PERL)[\w\.]*://g; ! $title =~ s/\bRe:\s+/ /g; ! $title =~ s/\s+/ /g; ! $title =~ s/^\s*(.*?)\s*$/$1/g; ! $ls->{Title}{$title} = 1; ! } ! $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i; ! $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i; ! $ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/; ! } ! # Style 1: # *** perl-5.004/embed.h Sat May 10 03:39:32 1997 *************** *** 89,95 **** # Style 2: # --- perl5.004001/mg.c Sun Jun 08 12:26:24 1997 # +++ perl5.004-bc/mg.c Sun Jun 08 11:56:08 1997 ! # @@ -656,9 +656,27 @@ # or (rcs, note the different date format) # --- 1.18 1997/05/23 19:22:04 # +++ ./pod/perlembed.pod 1997/06/03 21:41:38 --- 131,141 ---- # Style 2: # --- perl5.004001/mg.c Sun Jun 08 12:26:24 1997 # +++ perl5.004-bc/mg.c Sun Jun 08 11:56:08 1997 ! # @@ .. @@ ! # or for deletions ! # --- perl5.004001/mg.c Sun Jun 08 12:26:24 1997 ! # +++ /dev/null Sun Jun 08 11:56:08 1997 ! # @@ ... @@ # or (rcs, note the different date format) # --- 1.18 1997/05/23 19:22:04 # +++ ./pod/perlembed.pod 1997/06/03 21:41:38 *************** *** 97,108 **** # Variation: # Index: embed.h ! my($in, $prevline, $prevtype, $ls); ! my(@removed, @added); my $prologue = 1; # assume prologue till patch or /^exit\b/ seen foreach my $argv (@ARGV) { $in = $argv; unless (open F, "<$in") { warn "Unable to open $in: $!\n"; next; --- 143,164 ---- # Variation: # Index: embed.h ! my %ls; ! ! my $in; ! my $ls; ! my $prevline = ''; ! my $prevtype = ''; ! my (%removed, %added); my $prologue = 1; # assume prologue till patch or /^exit\b/ seen + foreach my $argv (@ARGV) { $in = $argv; + if (-d $in) { + warn "Ignored directory $in\n"; + next; + } unless (open F, "<$in") { warn "Unable to open $in: $!\n"; next; *************** *** 115,149 **** # not an interesting patch line # but possibly meta-information or prologue if ($prologue) { ! push @added, $1 if /^touch\s+(\S+)/; ! push @removed, $1 if /^rm\s+(?:-f)?\s*(\S+)/; $prologue = 0 if /^exit\b/; } ! next unless $::opt_m; ! $ls->{From}{$1}=1,next if /^From:\s+(.*\S)/i; ! $ls->{Title}{$1}=1,next if /^Subject:\s+(?:Re: )?(.*\S)/i; ! $ls->{'Msg-ID'}{$1}=1,next if /^Message-Id:\s+(.*\S)/i; ! $ls->{Date}{$1}=1,next if /^Date:\s+(.*\S)/i; ! $ls->{$1}{$2}=1,next if /^([-\w]+):\s+(.*\S)/; next; } $type = $1; next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/; $prologue = 0; ! print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d; # Some patches have Index lines but not diff headers # Patch copes with this, so must we. It's also handy for # documenting manual changes by simply adding Index: lines ! # to the file which describes the problem bing fixed. ! add_file($ls, $1), next if /^Index:\s+(\S+)/; if ( ($type eq '---' and $prevtype eq '***') # Style 1 or ($type eq '+++' and $prevtype eq '---') # Style 2 ) { if (/^[-+*]{3} (\S+)\s*(.*?\d\d:\d\d:\d\d)?/) { # double check ! add_file($ls, $1); } else { warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_"; --- 171,210 ---- # not an interesting patch line # but possibly meta-information or prologue if ($prologue) { ! $added{$1} = 1 if /^touch\s+(\S+)/; ! $removed{$1} = 1 if /^rm\s+(?:-f)?\s*(\S+)/; $prologue = 0 if /^exit\b/; } ! get_meta_info($ls, $_) if $::opt_m; next; } $type = $1; next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/; $prologue = 0; ! print "Last: $prevline","This: ${_}Got: $type\n\n" if $::opt_d; # Some patches have Index lines but not diff headers # Patch copes with this, so must we. It's also handy for # documenting manual changes by simply adding Index: lines ! # to the file which describes the problem being fixed. ! if (/^Index:\s+(.*)/) { ! my $f; ! foreach $f (split(/ /, $1)) { add_patched_file($ls, $f) } ! next; ! } if ( ($type eq '---' and $prevtype eq '***') # Style 1 or ($type eq '+++' and $prevtype eq '---') # Style 2 ) { if (/^[-+*]{3} (\S+)\s*(.*?\d\d:\d\d:\d\d)?/) { # double check ! if ($1 eq "/dev/null") { ! $prevline =~ /^[-+*]{3} (\S+)\s*/; ! add_deleted_file($ls, $1); ! } ! else { ! add_patched_file($ls, $1); ! } } else { warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_"; *************** *** 152,162 **** } continue { $prevline = $_; ! $prevtype = $type; $type = ''; } # if we don't have a title for -m then use the file name ! $ls->{Title}{$in}=1 if $::opt_m and !$ls->{Title} and $ls->{out}; $ls->{category} = $::opt_c --- 213,246 ---- } continue { $prevline = $_; ! $prevtype = $type || ''; $type = ''; } + + # special mode for patch sets from Chip + if ($in =~ m:[\\/]patch$:) { + my $is_chip; + my $chip; + my $dir; ($dir = $in) =~ s:[\\/]patch$::; + if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) { + get_meta_info($ls, $_) while (); + $is_chip = 1; + } + if (open CHIP,"<$dir/from") { + chop($chip = ); + $ls->{From} = { $chip => 1 }; + $is_chip = 1; + } + if (open CHIP,"<$dir/tag") { + chop($chip = ); + $ls->{Title} = { $chip => 1 }; + $is_chip = 1; + } + $ls->{From} = { "Chip Salzenberg" => 1 } if $is_chip && !$ls->{From}; + } + # if we don't have a title for -m then use the file name ! $ls->{Title}{"Untitled: $in"}=1 if $::opt_m and !$ls->{Title} and $ls->{out}; $ls->{category} = $::opt_c *************** *** 170,182 **** my @ls = values %ls; if ($::opt_f) { # filter out patches based on -f - my $out; $::opt_f .= '$' unless $::opt_f =~ m:/:; @ls = grep { - my @out = keys %{$_->{out}}; my $match = 0; ! for $out (@out) { ! ++$match if $out =~ m/$::opt_f/o; } $match; } @ls; --- 254,268 ---- my @ls = values %ls; if ($::opt_f) { # filter out patches based on -f $::opt_f .= '$' unless $::opt_f =~ m:/:; @ls = grep { my $match = 0; ! if ($_->{is_in}) { ! my @out = keys %{ $_->{out} }; ! $match=1 if grep { m/$::opt_f/o } @out; ! } ! else { ! $match=1 if $_->{in} =~ m/$::opt_f/o; } $match; } @ls; *************** *** 190,234 **** # --- Handle special modes --- if ($::opt_4) { ! print map { "p4 delete $_\n" } @removed if @removed; ! print map { "p4 add $_\n" } @added if @added; ! my @patches = grep { $_->{is_in} } @ls; my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches; ! delete @patched{@added}; my @patched = sort keys %patched; ! print map { "p4 edit $_\n" } @patched if @patched; ! exit 0; } if ($::opt_I) { my $n_patches = 0; my($in,$out); my %all_out; foreach $in (@ls) { next unless $in->{is_in}; ++$n_patches; my @outs = keys %{$in->{out}}; @all_out{@outs} = ($in->{in}) x @outs; } my @all_out = sort keys %all_out; my @missing = grep { ! -f $_ } @all_out; print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n"; print "(use -v to list patches which patch 'missing' files)\n" ! if @missing && !$::opt_v; if ($::opt_v and @missing) { print "Missing files:\n"; foreach $out (@missing) { ! printf " %-20s\t%s\n", $out, $all_out{$out}; } } ! print "Added files: @added\n" if @added; ! print "Removed files: @removed\n" if @removed; exit 0+@missing; } unless ($::opt_c and $::opt_m) { foreach $ls (@ls) { next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; list_files_by_patch($ls); } } --- 276,342 ---- # --- Handle special modes --- if ($::opt_4) { ! my $tail = ($::opt_5) ? "|| exit 1" : ""; ! print map { "p4 delete $_$tail\n" } sort keys %removed if %removed; ! print map { "p4 add $_$tail\n" } sort keys %added if %added; ! my @patches = sort grep { $_->{is_in} } @ls; ! my @no_outs = grep { keys %{$_->{out}} == 0 } @patches; ! warn "Warning: Some files contain no patches:", ! join("\n\t", '', map { $_->{in} } @no_outs), "\n" if @no_outs; ! my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches; ! delete @patched{keys %added}; my @patched = sort keys %patched; ! foreach(@patched) { ! next if $removed{$_}; ! my $edit = ($::opt_e && !-f $_) ? "add " : "edit"; ! print "p4 $edit $_$tail\n"; ! } ! exit 0 unless $::opt_C; } + if ($::opt_I) { my $n_patches = 0; my($in,$out); my %all_out; + my @no_outs; foreach $in (@ls) { next unless $in->{is_in}; ++$n_patches; my @outs = keys %{$in->{out}}; + push @no_outs, $in unless @outs; @all_out{@outs} = ($in->{in}) x @outs; } my @all_out = sort keys %all_out; my @missing = grep { ! -f $_ } @all_out; print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n"; + print @no_outs." patch files don't contain patches.\n" if @no_outs; print "(use -v to list patches which patch 'missing' files)\n" ! if (@missing || @no_outs) && !$::opt_v; ! if ($::opt_v and @no_outs) { ! print "Patch files which don't contain patches:\n"; ! foreach $out (@no_outs) { ! printf " %-20s\n", $out->{in}; ! } ! } if ($::opt_v and @missing) { print "Missing files:\n"; foreach $out (@missing) { ! printf " %-20s\t", $out unless $::opt_h; ! print $all_out{$out} unless $::opt_l; ! print "\n"; } } ! print "Added files: ".join(" ",sort keys %added )."\n" if %added; ! print "Removed files: ".join(" ",sort keys %removed)."\n" if %removed; exit 0+@missing; } unless ($::opt_c and $::opt_m) { foreach $ls (@ls) { next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; + next if $::opt_X and keys %{$ls->{out}} <= 1; list_files_by_patch($ls); } } *************** *** 261,271 **** # --- ! sub add_file { my $ls = shift; ! my $out = trim_name(shift); ! $ls->{out}->{$out} = 1; # do the -i inverse as well, even if we're not doing -i my $i = $ls{$out} ||= { --- 369,385 ---- # --- ! sub add_patched_file { my $ls = shift; ! my $raw_name = shift; ! my $action = shift || 1; # 1==patched, 2==deleted ! ! my $out = trim_name($raw_name); ! print "add_patched_file '$out' ($raw_name, $action)\n" if $::opt_d; ! ! $ls->{out}->{$out} = $action; ! warn "$out patched but not present\n" if $::opt_e && !-f $out; # do the -i inverse as well, even if we're not doing -i my $i = $ls{$out} ||= { *************** *** 276,288 **** $i->{out}->{$in} = 1; } sub trim_name { # reduce/tidy file paths from diff lines my $name = shift; - $name = "$name ($in)" if $name eq "/dev/null"; $name =~ s:\\:/:g; # adjust windows paths $name =~ s://:/:g; # simplify (and make win \\share into absolute path) ! if (defined $::opt_p) { # strip on -p levels of directory prefix my $dc = $::opt_p; $name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0; --- 390,413 ---- $i->{out}->{$in} = 1; } + sub add_deleted_file { + my $ls = shift; + my $raw_name = shift; + my $out = trim_name($raw_name); + print "add_deleted_file '$out' ($raw_name)\n" if $::opt_d; + $removed{$out} = 1; + #add_patched_file(@_[0,1], 2); + } + sub trim_name { # reduce/tidy file paths from diff lines my $name = shift; $name =~ s:\\:/:g; # adjust windows paths $name =~ s://:/:g; # simplify (and make win \\share into absolute path) ! if ($name eq "/dev/null") { ! # do nothing (XXX but we need a way to record deletions) ! } ! elsif (defined $::opt_p) { # strip on -p levels of directory prefix my $dc = $::opt_p; $name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0; *************** *** 290,296 **** else { # try to strip off leading path to perl directory # if absolute path, strip down to any *perl* directory first $name =~ s:^/.*?perl.*?/::i; ! $name =~ s:.*perl[-_]?5?[._]?[-_a-z0-9.+]*/::i; $name =~ s:^\./::; } return $name; --- 415,421 ---- else { # try to strip off leading path to perl directory # if absolute path, strip down to any *perl* directory first $name =~ s:^/.*?perl.*?/::i; ! $name =~ s:.*(perl|maint)[-_]?5?[._]?[-_a-z0-9.+]*/::i; $name =~ s:^\./::; } return $name; *************** *** 308,314 **** my @list = sort keys %{$ls->{$meta}}; push @meta, sprintf "%7s: ", $meta; if ($meta eq 'Title') { ! @list = map { s/\[?PATCH\]?:?\s*//g; "\"$_\""; } @list } elsif ($meta eq 'From') { # fix-up bizzare addresses from japan and ibm :-) --- 433,440 ---- my @list = sort keys %{$ls->{$meta}}; push @meta, sprintf "%7s: ", $meta; if ($meta eq 'Title') { ! @list = map { "\"$_\""; } @list; ! push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:; } elsif ($meta eq 'From') { # fix-up bizzare addresses from japan and ibm :-) *************** *** 328,344 **** $name = "\n$name" if @meta and $name; } # don't print the header unless the file contains something interesting ! return if !@meta and !$ls->{out}; ! print("$ls->{in}\n"),return if $::opt_l; # -l = no listing # a twisty maze of little options my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : ""; print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat"; ! print join('',"\n",@meta) if @meta; my @v = sort PATORDER keys %{ $ls->{out} }; ! my $v = "@v\n"; print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v; } --- 454,482 ---- $name = "\n$name" if @meta and $name; } # don't print the header unless the file contains something interesting ! return if !@meta and !$ls->{out} and !$::opt_v; ! if ($::opt_l) { # -l = no listing, just names ! print "$ls->{in}"; ! my $n = keys %{ $ls->{out} }; ! print " ($n patches)" if $::opt_n and $n>1; ! print "\n"; ! return; ! } # a twisty maze of little options my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : ""; print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat"; ! my $sep = "\n"; ! $sep = "" if @show_meta==1 && $::opt_c && $::opt_h; ! print join('', $sep, @meta) if @meta; + return if $::opt_m && !$show_meta{Files}; my @v = sort PATORDER keys %{ $ls->{out} }; ! my $n = @v; ! my $v = "@v"; print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v; + print " ($n patches)" if $::opt_n and $n>1; + print "\n"; } *************** *** 364,371 **** if m:^(cygwin32|os2|plan9|qnx|vms)/: or m:^(hints|Porting|ext/DynaLoader)/: or m:^README\.:; $c{LIB} += 10,next ! if m:^(lib|ext)/:; $c{'CORE'} += 15,next if m:^[^/]+[\._]([chH]|sym|pl)$:; $c{BUILD} += 10,next --- 502,511 ---- if m:^(cygwin32|os2|plan9|qnx|vms)/: or m:^(hints|Porting|ext/DynaLoader)/: or m:^README\.:; + $c{EXT} += 10,next + if m:^(ext|lib/ExtUtils)/:; $c{LIB} += 10,next ! if m:^(lib)/:; $c{'CORE'} += 15,next if m:^[^/]+[\._]([chH]|sym|pl)$:; $c{BUILD} += 10,next *************** *** 391,397 **** } else { my($c, $v) = %c; ! $c ||= 'OTHER'; $v ||= 0; print " ".@$files." patches: $c: $v\n" if $verb; return $c; } --- 531,537 ---- } else { my($c, $v) = %c; ! $c ||= 'UNKNOWN'; $v ||= 0; print " ".@$files." patches: $c: $v\n" if $verb; return $c; } diff -c 'perl5.004_04/Porting/pumpkin.pod' 'perl5.004_05/Porting/pumpkin.pod' Index: ./Porting/pumpkin.pod Prereq: 1.13 *** ./Porting/pumpkin.pod Wed Oct 8 09:58:04 1997 --- ./Porting/pumpkin.pod Sat Apr 24 12:35:57 1999 *************** *** 8,15 **** =head1 DESCRIPTION ! This document attempts to begin to describe some of the ! considerations involved in patching and maintaining perl. This document is still under construction, and still subject to significant changes. Still, I hope parts of it will be useful, --- 8,15 ---- =head1 DESCRIPTION ! This document attempts to begin to describe some of the considerations ! involved in patching, porting, and maintaining perl. This document is still under construction, and still subject to significant changes. Still, I hope parts of it will be useful, *************** *** 73,86 **** =head2 Subversions ! In addition, there may be "developer" sub-versions available. These ! are not official releases. They may contain unstable experimental ! features, and are subject to rapid change. Such developer ! sub-versions are numbered with sub-version numbers. For example, ! version 5.003_04 is the 4'th developer version built on top of ! 5.003. It might include the _01, _02, and _03 changes, but it ! also might not. Sub-versions are allowed to be subversive. (But see ! the next section for recent changes.) These sub-versions can also be used as floating point numbers, so you can do things such as --- 73,84 ---- =head2 Subversions ! In addition, there usually are sub-versions available. Sub-versions ! are numbered with sub-version numbers. For example, version 5.003_04 ! is the 4'th developer version built on top of 5.003. It might include ! the _01, _02, and _03 changes, but it also might not. Sub-versions are ! allowed to be subversive. (But see the next section for recent ! changes.) These sub-versions can also be used as floating point numbers, so you can do things such as *************** *** 92,117 **** use 5.003_03; # the "_" is optional Sub-versions produced by the members of perl5-porters are usually ! available on CPAN in the F directory. =head2 Maintenance and Development Subversions ! As an experiment, starting with version 5.004, subversions _01 through ! _49 will be reserved for bug-fix maintenance releases, and subversions ! _50 through _99 will be available for unstable development versions. The separate bug-fix track is being established to allow us an easy way to distribute important bug fixes without waiting for the developers to untangle all the other problems in the current ! developer's release. Trial releases of bug-fix maintenance releases are announced on perl5-porters. Trial releases use the new subversion number (to avoid testers installing it over the previous release) and include a 'local ! patch' entry in patchlevel.h. ! Watch for announcements of maintenance subversions in ! comp.lang.perl.announce. =head2 Why such a complicated scheme? --- 90,136 ---- use 5.003_03; # the "_" is optional Sub-versions produced by the members of perl5-porters are usually ! available on CPAN in the F and F ! directories. =head2 Maintenance and Development Subversions ! Starting with version 5.004, subversions _01 through _49 is reserved ! for bug-fix maintenance releases, and subversions _50 through _99 for ! unstable development versions. The separate bug-fix track is being established to allow us an easy way to distribute important bug fixes without waiting for the developers to untangle all the other problems in the current ! developer's release. The first rule of maintenance work is "First, do ! no harm." Trial releases of bug-fix maintenance releases are announced on perl5-porters. Trial releases use the new subversion number (to avoid testers installing it over the previous release) and include a 'local ! patch' entry in patchlevel.h. The distribution file contains the ! string C to make clear that the file is not meant for ! public consumption. ! ! In general, the names of official distribution files for the public ! always match the regular expression ! ! ^perl5\.\d{3}(_[0-4]\d)?\.tar\.gz$ ! ! Developer releases always match ! ! ^perl5\.\d{3}(_[5-9]\d)?\.tar\.gz$ ! And the trial versions for a new maintainance release match ! ! ^perl5\.\d{3}(_[0-4]\d)-MAINT_TRIAL_\d+\.tar\.gz$ ! ! In the past it has been observed that pumkings tend to invent new ! naming conventions on the fly. If you are a pumpking, before you ! invent a new name for any of the three types of perl distributions, ! please inform the guys from the CPAN who are doing indexing and ! provide the trees of symlinks and the like. They will have to know ! I what you decide. =head2 Why such a complicated scheme? *************** *** 153,159 **** The name has stuck. ! =head1 Philosophical Issues in Patching Perl There are no absolute rules, but there are some general guidelines I have tried to follow as I apply patches to the perl sources. --- 172,178 ---- The name has stuck. ! =head1 Philosophical Issues in Patching and Porting Perl There are no absolute rules, but there are some general guidelines I have tried to follow as I apply patches to the perl sources. *************** *** 172,177 **** --- 191,206 ---- could still get their work done, but others could build a shared libperl if they wanted to as well. + Contain your changes carefully. Assume nothing about other operating + systems, not even closely related ones. Your changes must not affect + other platforms. + + Spy shamelessly on how similar patching or porting issues have been + settled elsewhere. + + If feasible, try to keep filenames 8.3-compliant to humor those poor + souls that get joy from running Perl under such dire limitations. + =head2 Seek consensus on major changes If you are making big changes, don't do it in secret. Discuss the *************** *** 194,199 **** --- 223,310 ---- releases of the operating system. Further, the feature-specific tests may help out folks on another platform who have the same problem. + =head2 Machine-specific files + + =over 4 + + =item source code + + If you have many machine-specific #defines or #includes, consider + creating an "osish.h" (os2ish.h, vmsish.h, and so on) and including + that in perl.h. If you have several machine-specific files (function + emulations, function stubs, build utility wrappers) you may create a + separate subdirectory (djgpp, win32) and put the files in there. + Remember to update C when you add files. + + If your system support dynamic loading but none of the existing + methods at F work for you, you must write + a new one. Study the existing ones to see what kind of interface + you must supply. + + =item build hints + + There are two kinds of hints: hints for building Perl and hints for + extensions. The former live in the C subdirectory, the latter + in C subdirectories. + + The top level hints are Bourne-shell scripts that set, modify and + unset appropriate Configure variables, based on the Configure command + line options and possibly existing config.sh and Policy.sh files from + previous Configure runs. + + The extension hints are written Perl (by the time they are used + miniperl has been built) and control the building of their respective + extensions. They can be used to for example manipulate compilation + and linking flags. + + =item build and installation Makefiles, scripts, and so forth + + Sometimes you will also need to tweak the Perl build and installation + procedure itself, like for example F and F. + Tread very carefully, even more than usual. Contain your changes + with utmost care. + + =item test suite + + Many of the tests in C subdirectory assume machine-specific things + like existence of certain functions, something about filesystem + semantics, certain external utilities and their error messages. Use + the C<$^O> and the C module (which contains the results of the + Configure run, in effect the C converted to Perl) to either + skip (preferably not) or customize (preferable) the tests for your + platform. + + =item modules + + Certain standard modules may need updating if your operating system + sports for example a native filesystem naming. You may want to update + some or all of the modules File::Basename, File::Spec, File::Path, and + File::Copy to become aware of your native filesystem syntax and + peculiarities. + + =item documentation + + If your operating system comes from outside UNIX you almost certainly + will have differences in the available operating system functionality + (missing system calls, different semantics, whatever). Please + document these at F. If your operating system is + the first B to have a system call also update the list of + "portability-bewares" at the beginning of F. + + A file called F at the top level that explains things + like how to install perl at this platform, where to get any possibly + required additional software, and for example what test suite errors + to expect, is nice too. + + You may also want to write a separate F<.pod> file for your operating + system to tell about existing mailing lists, os-specific modules, + documentation, whatever. Please name these along the lines of + FI.pod. [unfinished: where to put this file (the pod/ + subdirectory, of course: but more importantly, which/what index files + should be updated?)] + + =back + =head2 Allow for lots of testing We should never release a main version without testing it as a *************** *** 209,215 **** but, in general, we ought to try to avoid breaking widely-installed things. ! =head2 Automate generation of derivative files The F, F, F, and F files are all automatically generated by perl scripts. In general, don't --- 320,326 ---- but, in general, we ought to try to avoid breaking widely-installed things. ! =head2 Automated generation of derivative files The F, F, F, and F files are all automatically generated by perl scripts. In general, don't *************** *** 217,225 **** F and F are also automatically generated by B. In general, you should patch the metaconfig units ! instead of patching these files directly. However, minor changes to ! F may be made in between major sync-ups with the metaconfig ! units, which tends to be complicated operations. =head1 How to Make a Distribution --- 328,346 ---- F and F are also automatically generated by B. In general, you should patch the metaconfig units ! instead of patching these files directly. However, very minor changes ! to F may be made in between major sync-ups with the ! metaconfig units, which tends to be complicated operations. But be ! careful, this can quickly spiral out of control. Running metaconfig ! is not really hard. ! ! Also F is automatically produced from F. ! In general, look out for all F<*.SH> files. ! ! Finally, the sample files in the F subdirectory are ! generated automatically by the script F included ! with the metaconfig units. See L<"run metaconfig"> below for ! information on obtaining the metaconfig units. =head1 How to Make a Distribution *************** *** 273,288 **** metaconfig -m ! will regenerate Configure and config_h.SH. More information on ! obtaining and running metaconfig is in the F file that comes ! with Perl's metaconfig units. Perl's metaconfig units should be ! available the same place you found this file. On CPAN, look under my ! directory F for a file such as F<5.003_07-02.U.tar.gz>. ! That file should be unpacked in your main perl source directory. It ! contains the files needed to run B to reproduce Perl's ! Configure script. (Those units are for 5.003_07. There have been ! changes since then; please contact me if you want more recent ! versions, and I will try to point you in the right direction.) Alternatively, do consider if the F<*ish.h> files might be a better place for your changes. --- 394,409 ---- metaconfig -m ! will regenerate Configure and config_h.SH. Much more information ! on obtaining and running metaconfig is in the F file ! that comes with Perl's metaconfig units. Perl's metaconfig units ! should be available on CPAN. A set of units that will work with ! perl5.005 is in the file F under ! http://www.perl.com/CPAN/authors/id/ANDYD/ . The mc_units tar file ! should be unpacked in your main perl source directory. Note: those ! units were for use with 5.005. There may have been changes since then. ! Check for later versions or contact perl5-porters@perl.org to obtain a ! pointer to the current version. Alternatively, do consider if the F<*ish.h> files might be a better place for your changes. *************** *** 297,313 **** Both commands will also list extra files in the directory that are not listed in MANIFEST. ! The MANIFEST is normally sorted, with one exception. Perl includes ! both a F script and a F script. The ! F script is a front-end to the main F, but ! is there to aid folks who use autoconf-generated F files ! for other software. The problem is that F and F ! are the same on case-insensitive file systems, so I deliberately put ! F first in the MANIFEST so that the extraction of ! F will overwrite F and leave you with the ! correct script. (The F script must also have write ! permission for this to work, so it's the only file in the distribution ! I normally have with write permission.) If you are using metaconfig to regenerate Configure, then you should note that metaconfig actually uses MANIFEST.new, so you want to be sure --- 418,424 ---- Both commands will also list extra files in the directory that are not listed in MANIFEST. ! The MANIFEST is normally sorted. If you are using metaconfig to regenerate Configure, then you should note that metaconfig actually uses MANIFEST.new, so you want to be sure *************** *** 320,333 **** All the tests in the t/ directory ought to be executable. The main makefile used to do a 'chmod t/*/*.t', but that resulted in a self-modifying distribution--something some users would strongly ! prefer to avoid. Probably, the F script should check for this ! and do the chmod if needed, but it doesn't currently. In all, the following files should probably be executable: Configure configpm ! configure embed.pl installperl installman --- 431,445 ---- All the tests in the t/ directory ought to be executable. The main makefile used to do a 'chmod t/*/*.t', but that resulted in a self-modifying distribution--something some users would strongly ! prefer to avoid. The F script will check for this ! and do the chmod if needed, but the tests still ought to be ! executable. In all, the following files should probably be executable: Configure configpm ! configure.gnu embed.pl installperl installman *************** *** 340,346 **** *.SH vms/ext/Stdio/test.pl vms/ext/filespec.t - vms/fndvers.com x2p/*.SH Other things ought to be readable, at least :-). --- 452,457 ---- *************** *** 355,372 **** =head2 Run Configure This will build a config.sh and config.h. You can skip this if you haven't ! changed Configure or config_h.SH at all. ! =head2 Update config_H ! The config_H file is provided to help those folks who can't run Configure. ! It is important to keep it up-to-date. If you have changed config_h.SH, ! those changes must be reflected in config_H as well. (The name config_H was ! chosen to distinguish the file from config.h even on case-insensitive file ! systems.) Simply edit the existing config_H file; keep the first few ! explanatory lines and then copy your new config.h below. ! ! It may also be necessary to update vms/config.vms and plan9/config.plan9, though you should be quite careful in doing so if you are not familiar with those systems. You might want to issue your patch with a promise to quickly issue a follow-up that handles those --- 466,508 ---- =head2 Run Configure This will build a config.sh and config.h. You can skip this if you haven't ! changed Configure or config_h.SH at all. I use the following command ! sh Configure -Dprefix=/opt/perl -Doptimize=-O -Dusethreads \ ! -Dcf_by='yourname' \ ! -Dcf_email='yourname@yourhost.yourplace.com' \ ! -Dperladmin='yourname@yourhost.yourplace.com' \ ! -Dmydomain='.yourplace.com' \ ! -Dmyhostname='yourhost' \ ! -des ! ! =head2 Update Porting/config.sh and Porting/config_H ! ! [XXX ! This section needs revision. We're currently working on easing ! the task of keeping the vms, win32, and plan9 config.sh info ! up-to-date. The plan is to use keep up-to-date 'canned' config.sh ! files in the appropriate subdirectories and then generate 'canned' ! config.h files for vms, win32, etc. from the generic config.sh file. ! This is to ease maintenance. When Configure gets updated, the parts ! sometimes get scrambled around, and the changes in config_H can ! sometimes be very hard to follow. config.sh, on the other hand, can ! safely be sorted, so it's easy to track (typically very small) changes ! to config.sh and then propoagate them to a canned 'config.h' by any ! number of means, including a perl script in win32/ or carrying ! config.sh and config_h.SH to a Unix system and running sh ! config_h.SH.) ! XXX] ! ! The Porting/config.sh and Porting/config_H files are provided to ! help those folks who can't run Configure. It is important to keep ! them up-to-date. If you have changed config_h.SH, those changes must ! be reflected in config_H as well. (The name config_H was chosen to ! distinguish the file from config.h even on case-insensitive file systems.) ! Simply edit the existing config_H file; keep the first few explanatory ! lines and then copy your new config.h below. ! It may also be necessary to update win32/config.?c, vms/config.vms and plan9/config.plan9, though you should be quite careful in doing so if you are not familiar with those systems. You might want to issue your patch with a promise to quickly issue a follow-up that handles those *************** *** 387,401 **** started to fix F to detect this, but I never completed the task. Some additional notes from Larry on this: ! Don't forget to regenerate perly.c.diff. byacc -d perly.y mv y.tab.c perly.c ! patch perly.c perly.c.diff One chunk of lines that often fails begins with --- 523,540 ---- started to fix F to detect this, but I never completed the task. + If C changes, make sure you run C to + update the corresponding VMS files. See L. + Some additional notes from Larry on this: ! Don't forget to regenerate perly_c.diff. byacc -d perly.y mv y.tab.c perly.c ! patch perly.c perly_c.diff One chunk of lines that often fails begins with *************** *** 467,472 **** --- 606,628 ---- separately in the patch file (or both). There is no disagreement that detailed descriptions ought to be easily available somewhere. + =head2 Todo + + The F file contains a roughly-catgorized unordered list of + aspects of Perl that could use enhancement, features that could be + added, areas that could be cleaned up, and so on. During your term as + pumpkin-holder, you will probably address some of these issues, and + perhaps identify others which, while you decide not to address them + this time around, may be tackled in the future. Update the file + reflect the situation as it stands when you hand over the pumpkin. + + You might like, early in your pumpkin-holding career, to see if you + can find champions for partiticular issues on the to-do list: an issue + owned is an issue more likely to be resolved. + + There are also some more porting-specific L items later in this + file. + =head2 OS/2-specific updates In the os2 directory is F, a set of OS/2-specific *************** *** 479,486 **** =head2 VMS-specific updates ! If you have changed F, then you may want to update ! F by running C. The Perl version number appears in several places under F. It is courteous to update these versions. For example, if you are --- 635,642 ---- =head2 VMS-specific updates ! If you have changed F or F, then you most probably want ! to update F by running C. The Perl version number appears in several places under F. It is courteous to update these versions. For example, if you are *************** *** 1030,1035 **** --- 1186,1247 ---- then perl.c will put /my/override ahead of ARCHLIB and PRIVLIB. + =head2 Shared libperl.so location + + Why isn't the shared libperl.so installed in /usr/lib/ along + with "all the other" shared libraries? Instead, it is installed + in $archlib, which is typically something like + + /usr/local/lib/perl5/archname/5.00404 + + and is architecture- and version-specific. + + The basic reason why a shared libperl.so gets put in $archlib is so that + you can have more than one version of perl on the system at the same time, + and have each refer to its own libperl.so. + + Three examples might help. All of these work now; none would work if you + put libperl.so in /usr/lib. + + =over + + =item 1. + + Suppose you want to have both threaded and non-threaded perl versions + around. Configure will name both perl libraries "libperl.so" (so that + you can link to them with -lperl). The perl binaries tell them apart + by having looking in the appropriate $archlib directories. + + =item 2. + + Suppose you have perl5.004_04 installed and you want to try to compile + it again, perhaps with different options or after applying a patch. + If you already have libperl.so installed in /usr/lib/, then it may be + either difficult or impossible to get ld.so to find the new libperl.so + that you're trying to build. If, instead, libperl.so is tucked away in + $archlib, then you can always just change $archlib in the current perl + you're trying to build so that ld.so won't find your old libperl.so. + (The INSTALL file suggests you do this when building a debugging perl.) + + =item 3. + + The shared perl library is not a "well-behaved" shared library with + proper major and minor version numbers, so you can't necessarily + have perl5.004_04 and perl5.004_05 installed simultaneously. Suppose + perl5.004_04 were to install /usr/lib/libperl.so.4.4, and perl5.004_05 + were to install /usr/lib/libperl.so.4.5. Now, when you try to run + perl5.004_04, ld.so might try to load libperl.so.4.5, since it has + the right "major version" number. If this works at all, it almost + certainly defeats the reason for keeping perl5.004_04 around. Worse, + with development subversions, you certaily can't guarantee that + libperl.so.4.4 and libperl.so.4.55 will be compatible. + + Anyway, all this leads to quite obscure failures that are sure to drive + casual users crazy. Even experienced users will get confused :-). Upon + reflection, I'd say leave libperl.so in $archlib. + + =back + =head1 Upload Your Work to CPAN You can upload your work to CPAN if you have a CPAN id. Check out *************** *** 1073,1084 **** We should probably duplicate the metaconfig prefix stuff for an install prefix. ! =item Configure -Dsrcdir=/blah/blah We should be able to emulate B. Tom Tromey tromey@creche.cygnus.com has submitted some patches to ! the dist-users mailing list along these lines. Eventually, they ought ! to get folded back into the main distribution. =item Hint file fixes --- 1285,1325 ---- We should probably duplicate the metaconfig prefix stuff for an install prefix. ! =item Configure -Dsrc=/blah/blah We should be able to emulate B. Tom Tromey tromey@creche.cygnus.com has submitted some patches to ! 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 the default $archlib, ! then they need to be updated each time the perl version is updated. ! Perhaps we need a set of libries $vendorlib and $vendorarch that ! track $apiversion (like the $sitexxx directories do) rather than just ! $version (like the main perl directory). ! ! An alternative (and perhaps even better) plan might be for the vendor ! to select non-default $privlib and $archlib directories, perhaps using ! $apiversion instead of $version (or even just /usr/lib/perl5 with no ! version stuff at all), and put modules into those directories (with perl ! Makefile.PL INSTALLDIRS=perl). This would be fine unless the vendor ! wanted to support different versions of perl installed at the same time. ! (How many vendors *really* want to do that?) ! ! =item Separate directories for Perl-supplied and add-on man pages ! ! Man pages supplied with the perl distribution proper ought to go in ! an appropriate man directory. Perhaps man pages supplied with add-on ! modules ought to (at least optionally) go into a $siteman[1-9] directory. ! For example, suppose that $privlib is /usr/lib/perl5 and $man1dir ! is /usr/man/man1. Also, suppose $sitelib is /usr/local/lib/perl5. ! In this situation, it might make sense for man pages to go into ! /usr/local/lib/man/man1. =item Hint file fixes *************** *** 1090,1095 **** --- 1331,1377 ---- Some of the hint file information (particularly dynamic loading stuff) ought to be fed back into the main metaconfig distribution. + =item Catch GNU Libc "Stub" functions + + Some functions (such as lchown()) are present in libc, but are + unimplmented. That is, they always fail and set errno=ENOSYS. + + Thomas Bushnell provided the following sample code and the explanation + that follows: + + /* System header to define __stub macros and hopefully few prototypes, + which can conflict with char FOO(); below. */ + #include + /* Override any gcc2 internal prototype to avoid an error. */ + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char FOO(); + + int main() { + + /* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ + #if defined (__stub_FOO) || defined (__stub___FOO) + choke me + #else + FOO(); + #endif + + ; return 0; } + + The choice of is essentially arbitrary. The GNU libc + macros are found in . You can include that file instead + of (which itself includes ) if you test for + its existence first. is assumed to exist on every system, + which is why it's used here. Any GNU libc header file will include + the stubs macros. If either __stub_NAME or __stub___NAME is defined, + then the function doesn't actually exist. Tests using work + on every system around. + + The declaration of FOO is there to override builtin prototypes for + ANSI C functions. + =back =head2 Probably good ideas waiting for round tuits *************** *** 1135,1146 **** Maybe include a replacement function that doesn't lose data in rare cases of coercion between string and numerical values. - =item long long - - Can we support C on systems where C is larger - than what we've been using for C? What if you can't C - a C? - =item Improve makedepend The current makedepend process is clunky and annoyingly slow, but it --- 1417,1422 ---- *************** *** 1177,1180 **** =head1 LAST MODIFIED ! $Id: pumpkin.pod,v 1.13 1997/08/28 18:26:40 doughera Released $ --- 1453,1456 ---- =head1 LAST MODIFIED ! $Id: pumpkin.pod,v 1.22 1998/07/22 16:33:55 doughera Released $ diff -c 'perl5.004_04/README' 'perl5.004_05/README' Index: ./README *** ./README Tue Jun 10 21:44:56 1997 --- ./README Sun Nov 22 10:08:38 1998 *************** *** 22,29 **** Kit, in the file named "Artistic". If not, I'll be glad to provide one. You should also have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. For those of you that choose to use the GNU General Public License, my interpretation of the GNU General Public License is that no Perl --- 22,29 ---- Kit, in the file named "Artistic". If not, I'll be glad to provide one. You should also have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software Foundation, ! Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. For those of you that choose to use the GNU General Public License, my interpretation of the GNU General Public License is that no Perl *************** *** 76,86 **** 2) Read the manual entries before running perl. 3) IMPORTANT! Help save the world! Communicate any problems and suggested ! patches to me, larry@wall.org (Larry Wall), so we can ! keep the world in sync. If you have a problem, there's someone else ! out there who either has had or will have the same problem. ! It's usually helpful if you send the output of the "myconfig" script ! in the main perl directory. If you've succeeded in compiling perl, the perlbug script in the utils/ subdirectory can be used to help mail in a bug report. --- 76,85 ---- 2) Read the manual entries before running perl. 3) IMPORTANT! Help save the world! Communicate any problems and suggested ! patches to perlbug@perl.com so we can keep the world in sync. ! If you have a problem, there's someone else out there who either has had ! or will have the same problem. It's usually helpful if you send the ! output of the "myconfig" script in the main perl directory. If you've succeeded in compiling perl, the perlbug script in the utils/ subdirectory can be used to help mail in a bug report. diff -c /dev/null 'perl5.004_05/README.beos' Index: ./README.beos *** ./README.beos Wed Dec 31 19:00:00 1969 --- ./README.beos Fri May 15 11:28:45 1998 *************** *** 0 **** --- 1,75 ---- + $Id: README.beos,v 1.2 1998/05/02 01:55:04 dogcow Exp dogcow $ + + Notes on building perl under BeOS: + + GENERAL ISSUES + -------------- + perl will almost compile straight out of the box with ./Configure -d, but + there are a few gotchas: + + Currently, you have to edit config.sh and remove SDBM_File from the + dynamic_ext= and extensions= lines. SDBM_File does not build properly + at this time. You need to run ./Configure -S after editing config.sh. + + In addition, with mwcc, after doing `make depend`, you need to edit + makefile and x2p/makefile and remove the lines that mention 'Bletch:'. + This is not necessary if you're using gnu cpp. + + in short: + ./Configure -d + remove SDBM_File from config.sh + ./Configure -S + make depend + remove Bletch: from makefile and x2p/makefile + make + + Other than that, perl should build without problems. There are some + technical comments in hints/beos.sh. + + OS RELEASE-SPECIFIC NOTES + ------------------------- + + PR1/PPC: + See R3/X86. Same bug, different form. + + PR2/PPC: + Signals are somewhat unreliable, but they can work. Use caution. + The POSIX module is still somewhat buggy. + + R3/X86: + Under R3 x86, there are some serious problems with the math routines + such that numbers are incorrectly printed. This causes problems with + modules that encode their version numbers - in particular, IO.pm will + probably not work properly. This should be fixed under R3.1. + + The problem has manifested itself if you see something similar to the + following during the compile: + + cc -c -I/usr/local/include -O -DVERSION=\"1.1504\" -DXS_VERSION=\"1.1499999999\" -fpic -I../.. IO.c + (lots of 9's are the indication of the problem.) + + In the meantime, you can use the following workaround: + + make perl + cd ext/IO + cc -c -I/usr/local/include -O -DVERSION=\"1.1504\" -DXS_VERSION=\"1.15\" -fpic -I../.. IO.c + cd .. + make + + (Substitute the correct numbers if IO has been updated.) + + R3/PPC- + There's math problems, but of a different kind. In particular, + perl -e 'print (240000 - (3e4<<3))' gives a non-zero answer. + I'm looking into this. There is no workaround as yet. Hopefully, + this will be fixed in R3.1. + + CONTACT INFORMATION + ------------------- + If you have comments, problem reports, or even patches or bugfixes (gasp!) + please email me. + + 1 May 1998 + Tom Spindler + dogcow@merit.edu + diff -c 'perl5.004_04/README.os2' 'perl5.004_05/README.os2' Index: ./README.os2 *** ./README.os2 Tue Aug 5 09:04:17 1997 --- ./README.os2 Fri Apr 10 10:35:34 1998 *************** *** 308,314 **** The only cases when the shell is not used is the multi-argument system() (see L)/exec() (see L), and one-argument version thereof without redirection and shell ! meta-characters. =head1 Frequently asked questions --- 308,338 ---- The only cases when the shell is not used is the multi-argument system() (see L)/exec() (see L), and one-argument version thereof without redirection and shell ! meta-characters. Perl may also start scripts which start with cookies ! C or C<#!> directly, without an intervention of shell. ! ! If starting scripts directly, Perl will use exactly the same algorithm as for ! the search of script given by B<-S> command-line option: it will look in ! the current directory, then on components of C<$ENV{PATH}> using the ! following order of appended extensions: no extension, F<.cmd>, F<.btm>, ! F<.bat>, F<.pl>. ! ! Note that Perl will start to look for scripts only if OS/2 cannot start the ! specified application, thus C will not look for a script if ! there is an executable file F I on C. ! ! Note also that executable files on OS/2 can have an arbitrary extension, ! but F<.exe> will be automatically appended if no dot is present in the name. ! The workaround as as simple as that: since F and F denote the ! same file, to start an executable residing in file F (no ! extension) give an argument C to system(). ! ! The last note is that currently it is not straightforward to start PM ! programs from VIO (=text-mode) Perl process and visa versa. Either ensure ! that shell will be used, as in C, or start it using ! optional arguments to system() documented in C module. This ! is considered a bug and should be fixed soon. ! =head1 Frequently asked questions *************** *** 780,785 **** --- 804,813 ---- =head2 Testing + If you haven't yet moved perl.dll onto LIBPATH, do it now(alternatively, if + you have a previous perl installation you'd rather not disrupt until this one + is installed, copy perl.dll to the t directory). + Now run make test *************** *** 910,915 **** --- 938,945 ---- to 1. =head2 Installing the built perl + + If you haven't yet moved perl.dll onto LIBPATH, do it now. Run diff -c 'perl5.004_04/README.vms' 'perl5.004_05/README.vms' Index: ./README.vms *** ./README.vms Mon Sep 22 15:36:22 1997 --- ./README.vms Fri Apr 10 10:35:34 1998 *************** *** 203,212 **** --- 203,221 ---- 6) Optionally define the command PERLDOC as PERLDOC :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T + Note that if you wish to use most as a pager please see + ftp://space.mit.edu/pub/davis/ for both most and slang. 7) Optionally define the command PERLBUG (the Perl bug report generator) as PERLBUG :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM" + 8) Optionally define the command POD2MAN (Converts POD files to nroff + source suitable for converting to man pages. Also quiets complaints during + module builds) as + + DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM + POD2MAN :== $PERL_ROOT:[000000]PERL POD2MAN + * Installing Perl into DCLTABLES Courtesy of Brad Hughes: *************** *** 367,736 **** the the opportunity to test and develop for the AXP, and to the entire VMSperl group for useful advice and suggestions. In addition the perl5-porters deserve credit for their creativity and - willingness to work with the VMS newcomers. Finally, the greatest debt of - gratitude is due to Larry Wall , for having the ideas which - have made our sleepless nights possible. - - Thanks, - The VMSperl group - - - --------------------------------------------------------------------------- - [Here's the pre-5.004_04 version of README.vms, for the record.] - - Last revised: 19-Jan-1996 by Charles Bailey bailey@genetics.upenn.edu - - The VMS port of Perl is still under development. At this time, the Perl - binaries built under VMS handle internal operations properly, for the most - part, as well as most of the system calls which have close equivalents under - VMS. There are still some incompatibilities in process handling (e.g the - fork/exec model for creating subprocesses doesn't do what you might expect - under Unix), and there remain some file handling differences from Unix. Over - the longer term, we'll try to get many of the useful VMS system services - integrated as well, depending on time and people available. Of course, if - you'd like to add something yourself, or join the porting team, we'd love to - have you! - - The current sources and build procedures have been tested on a VAX using VAXC - and DECC, and on an AXP using DECC. If you run into problems with other - compilers, please let us know. - - Note to DECC users: Some early versions of the DECCRTL contained a few bugs - which affect Perl performance: - - Newlines are lost on I/O through pipes, causing lines to run together. - This shows up as RMS RTB errors when reading from a pipe. You can - work around this by having one process write data to a file, and - then having the other read the file, instead of the pipe. This is - fixed in version 4 of DECC. - - The modf() routine returns a non-integral value for some values above - INT_MAX; the Perl "int" operator will return a non-integral value in - these cases. This is fixed in version 4 of DECC. - - On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine - changes the process default device and directory permanently, even - though the call specified that the change should not persist after - Perl exited. This is fixed by DEC CSC patch AXPACRT04_061. - - * Other software required - - At the moment, in addition to basic VMS, you'll need two things: - - a C compiler: VAXC, DECC, or gcc for the VAX; DECC for the AXP - - a make tool: DEC's MMS (version 2.6 or later) or the free analog MMK - (available from ftp.spc.edu), or a standard make utility (e.g. GNU make, - also available from ftp.spc.edu). - In addition, you may include socket support if you have an IP stack running - on your system. See the topic "Socket support" for more information. - - * Socket support - - Perl includes a number of IP socket routines among its builtin functions, - which are available if you choose to compile Perl with socket support. Since - IP networking is an optional addition to VMS, there are several different IP - stacks available, so it's difficult to automate the process of building Perl - with socket support in a way which will work on all systems. - - By default, Perl is built without IP socket support. If you define the macro - SOCKET when invoking MMK, however, socket support will be included. As - distributed, Perl for VMS includes support for the SOCKETSHR socket library, - which is layered on MadGoat software's vendor-independent NETLIB interface. - This provides support for all socket calls used by Perl except the - [g|s]etnet*() routines, which are replaced for the moment by stubs which - generate a fatal error if a Perl script attempts to call one of these routines. - Both SOCKETSHR and NETLIB are available from MadGoat ftp sites, such as - ftp.spc.edu or ftp.wku.edu. - - You can link Perl directly to your TCP/IP stack's library, *as long as* it - supplies shims for stdio routines which will properly handle both sockets and - normal file descriptors. This is necessary because Perl does not distinguish - between the two, and will try to make normal stdio calls such as read() and - getc() on socket file descriptors. If you'd like to link Perl directly to - your IP stack, then make the following changes: - - In Descrip.MMS, locate the section beginning with .ifdef SOCKET, and - change the SOCKLIB macro so that it translates to the filespec of your - IP stack's socket library. This will be added to the RTL options file. - - Edit the file SockAdapt.H in the [.VMS] subdirectory so that it - includes the Socket.H, In.H, Inet.H, NetDb.H, and, if necessary, - Errno.H header files for your IP stack, or so that it declares the - standard TCP/IP constants and data structures appropriately. (See - the distributed copy of SockAdapt.H for a collection of the structures - needed by Perl itself, and [.ext.Socket]Socket.xs for a list of the - constants used by the Socket extension, if you elect to built it.) - You should also define any logical names necessary for your C compiler - to find these files before invoking MM[KS] to build Perl. - - Edit the file SockAdapt.C in the [.VMS] subdirectory so that it - contains routines which substitute for any IP library routines - required by Perl which your IP stack does not provide. This may - require a little trial and error; we'll try to compile a complete - list soon of socket routines required by Perl. - - - * Building Perl under VMS - - Since you're reading this, presumably you've unpacked the Perl distribution - into its directory tree, in which you will find a [.vms] subdirectory below - the directory in which this file is found. If this isn't the case, then you'll - need to unpack the distribution properly, or manually edit Descrip.MMS or - the VMS Makefile to alter directory paths as necessary. (I'd advise using the - `normal' directory tree, at least for the first time through.) This - subdirectory contains several files, among which are the following: - Config.VMS - A template Config.H set up for VMS. - Descrip.MMS - The MMS/MMK dependency file for building Perl - GenConfig.Pl - A Perl script to generate Config.SH retrospectively - from Config.VMS, since the Configure shell script which - normally generates Config.SH doesn't run under VMS. - GenOpt.Com - A little DCL procedure used to write some linker options - files, since not all make utilities can do this easily. - Gen_ShrFls.Pl - A Perl script which generates linker options files and - MACRO declarations for PerlShr.Exe. - Makefile - The make dependency file for building Perl - MMS2Make.Pl - A Perl script used to generate Makefile from Descrip.MMS - PerlVMS.pod - Documentation for VMS-specific behavior of Perl - Perly_[CH].VMS - Versions of the byacc output from Perl's grammar, - modified to include VMS-specific C compiler options - SockAdapt.[CH] - C source code used to integrate VMS TCP/IP support - Test.Com - DCL driver for Perl regression tests - VMSish.H - C header file containing VMS-specific definitions - VMS.C - C source code for VMS-specific routines - VMS_Yfix.Pl - Perl script to convert Perly.[CH] to Perly_[CH].VMS - WriteMain.Pl - Perl script to generate Perlmain.C - The [.Ext...] directories contain VMS-specific extensions distributed with - Perl. There may also be other files in [.VMS...] pertaining to features under - development; for the most part, you can ignore them. Note that packages in - [.ext.*] are not built with Perl by default; you build the ones you want - once the basic Perl build is complete (see the perlvms docs for instructions - on building extensions.) - - Config.VMS and Decrip.MMS/Makefile are set up to build a version of Perl which - includes all features known to work when this release was assembled. If you - have code at your site which would support additional features (e.g. emulation - of Unix system calls), feel free to make the appropriate changes to these - files. (Note: Do not use or edit config.h in the main Perl source directory; - it is superseded by the current Config.VMS during the build.) You may also - wish to make site-specific changes to Descrip.MMS or Makefile to reflect local - conventions for naming of files, etc. - - There are several pieces of system-specific information which become part of - the Perl Config extension. Under VMS, the data for Config are generated by the - script GenConfig.Pl in the [.VMS] subdirectory. It tries to ascertain the - necessary information from various files, or from the system itself, and - generally does the right thing. There is a list of hard-coded values at the - end of this script which specifies items that are correct for most VMS systems, - but may be incorrect for you, if your site is set up in an unusual fashion. If - you're familiar with Perl's Config extension, feel free to edit these values as - necessary. If this doesn't mean much to you, don't worry -- the information is - probably correct, and even if it's not, none of these parameters affect your - ability to build or run Perl. You'll only get the wrong answer if you ask for - it specifically from Config. - - Examine the information at the beginning of Descrip.MMS for information about - specifying alternate C compilers or building a version of Perl with debugging - support. For instance, if you want to use DECC, you'll need to include the - /macro="decc=1" qualifier to MMK (If you're using make, these options are not - supported.) If you're on an AXP system, define the macro __AXP__ (MMK does - this for you), and DECC will automatically be selected. - - To start the build, set default to the main source directory. Since - Descrip.MMS assumes that VMS commands have their usual meaning, and makes use - of command-line macros, you may want to be certain that you haven't defined DCL - symbols which would interfere with the build. Then, if you are using MMS or - MMK, say - $ MMS/Descrip=[.VMS] ! or MMK - (N.B. If you are using MMS, you must use version 2.6 or later; a bug in - earlier versions produces malformed cc command lines.) If you are using a - version of make, say - $ Make -f [.VMS]Makefile - Note that the Makefile doesn't support conditional compilation, is - set up to use VAXC on a VAX, and does not include socket support. You can - either edit the Makefile by hand, using Descrip.MMS as a guide, or use the - Makefile to build Miniperl.Exe, and then run the Perl script MMS2Make.pl, - found in the [.VMS] subdirectory, to generate a new Makefile with the options - appropriate to your site. - - If you are using MM[SK], and you decide to rebuild Perl with a different set - of parameters (e.g. changing the C compiler, or adding socket support), be - sure to say - $ MMK/Descrip=[.VMS] realclean - first, in order to remove files generated during the previous build. If - you omit this step, you risk ending up with a copy of Perl which - composed partially of old files and partially of new ones, which may lead - to strange effects when you try to run Perl. - - A bug in some early versions of the DECC RTL on the AXP causes newlines - to be lost when writing to a pipe. A different bug in some patched versions - of DECC 4.0 for VAX can also scramble preprocessor output. Finally, gcc 2.7.2 - has yet another preprocessor bug, which causes line breaks to be inserted - into the output at inopportune times. Each of these bugs causes Gen_ShrFls.pl - to fail, since it can't parse the preprocessor output to identify global - variables and routines. This problem is generally manifested as missing - global symbols when linking PerlShr.Exe or Perl.Exe. You can work around - it by defining the macro PIPES_BROKEN when you invoke MMS or MMK. - - - This will build the following files: - Miniperl.Exe - a stand-alone version of without any extensions. - Miniperl has all the intrinsic capabilities of Perl, - but cannot make use of the DynaLoader or any - extensions which use XS code. - PerlShr.Exe - a shareable image containing most of Perl's internal - routines and global variables. Perl.Exe is linked to - this image, as are all dynamic extensions, so everyone's - using the same set of global variables and routines. - Perl.Exe - the main Perl executable image. It's contains the - main() routine, plus code for any statically linked - extensions. - PerlShr_Attr.Opt - A linker options file which specifies psect attributes - matching those in PerlShr.Exe. It should be used when - linking images against PerlShr.Exe - PerlShr_Bld.Opt - A linker options file which specifies various things - used to build PerlShr.Exe. It should be used when - rebuilding PerlShr.Exe via MakeMaker-produced - Descrip.MMS files for static extensions. - c2ph - Perl program which generates template code to access - C struct members from Perl. - h2ph - Perl program which generates template code to access - #defined constants in a C header file from Perl, - using the "old-style" interface. (Largely supplanted - by h2xs.) - h2xs - Perl program which generates template files for creating - XSUB extensions, optionally beginning with the #defined - constants in a C header file. - [.lib.pod]perldoc - A Perl program which locates and displays documentation - for Perl and its extensions. - [.Lib]Config.pm - the Perl extension which saves configuration information - about Perl and your system. - [.Lib]DynaLoader.pm - The Perl extension which performs dynamic linking of - shareable images for extensions. - Several subdirectories under [.Lib] containing preprocessed files or - site-specific files. - There are, of course, a number of other files created for use during the build. - Once you've got the binaries built, you may wish to `build' the `tidy' or - `clean' targets to remove extra files. - - If you run into problems during the build, you can get help from the VMSPerl - or perl5-porters mailing lists (see below). When you report the problem, - please include the following information: - - The version of Perl you're trying to build. Please include any - "letter" patchlevel, in addition to the version number. If the - build successfully created Miniperl.Exe, you can check this by - saying '$ MCR Sys$Disk:[]Miniperl -v'. Also, please mention - where you obtained the distribution kit; in particular, note - whether you were using a basic Perl kit or the VMS test kit - (see below). - - The exact command you issued to build Perl. - - A copy of all error messages which were generated during the build. - Please include enough of the build log to establish the context of - the error messages. - - A summary of your configuration. If the build progressed far enough - to generate Miniperl.Exe and [.Lib]Config.pm, you can obtain this - by saying '$ MCR Sys$Disk:[]Miniperl "-V"' (note the "" around -V). - If not, then you can say '$ MMK/Descrip=[.VMS] printconfig' to - produce the summary. - This may sound like a lot of information to send, but it'll often make - it easier for someone to spot the problem, instead of having to give - a spectrum of possibilities. - - - - * Installing Perl once it's built - - Once the build is complete, you'll need to do the following: - - Put PerlShr.Exe in a common directory, and make it world-readable. - If you place it in a location other than Sys$Share, you'll need to - define the logical name PerlShr to point to the image. (If you're - installing on a VMScluster, be sure that each node is using the - copy of PerlShr you expect [e.g. if you put PerlShr.Exe in Sys$Share, - do they all share Sys$Share?]). - - Put Perl.Exe in a common directory, and make it world-executable. - - Define a foreign command to invoke Perl, using a statement like - $ Perl == "$dev:[dir]Perl.Exe" - - Create a world-readable directory tree for Perl library modules, - scripts, and what-have-you, and define PERL_ROOT as a rooted logical - name pointing to the top of this tree (i.e. if your Perl files were - going to live in DKA1:[Util.Perl5...], then you should - $ Define/Translation=Concealed Perl_Root DKA1:[Util.Perl5.] - (Be careful to follow the rules for rooted logical names; in particular, - remember that a rooted logical name cannot have as its device portion - another rooted logical name - you've got to supply the actual device name - and directory path to the root directory.) - - Place the files from the [.lib...] directory tree in the distribution - package into a [.lib...] directory tree off the root directory described - above. - - Most of the Perl documentation lives in the [.pod] subdirectory, and - is written in a simple markup format which can be easily read. In this - directory as well are pod2man and pod2html translators to reformat the - docs for common display engines; a pod2hlp translator is under development. - These files are copied to [.lib.pod] during the installation. - - Define a foreign command to execute perldoc, such as - $ Perldoc == "''Perl' Perl_Root:[lib.pod]Perldoc -t" - This will allow users to retrieve documentation using Perldoc. For - more details, say "perldoc perldoc". - That's it. - - If you run into a bug in Perl, please submit a bug report. The PerlBug - program, found in the [.lib] directory, will walk you through the process - of assembling the necessary information into a bug report, and sending - of to the Perl bug reporting address, perlbug@perl.com. - - * For more information - - If you're interested in more information on Perl in general, you may wish to - consult the Usenet newsgroups comp.lang.perl.announce and comp.lang.perl.misc. - The FAQ for these groups provides pointers to other online sources of - information, as well as books describing Perl in depth. - - If you're interested in up-to-date information on Perl development and - internals, you might want to subscribe to the perl5-porters mailing list. You - can do this by sending a message to perl5-porters-request@nicoh.com, containing - the single line - subscribe perl5-porters - This is a high-volume list at the moment (>50 messages/day). - - If you're interested in ongoing information about the VMS port, you can - subscribe to the VMSPerl mailing list by sending a request to - vmsperl-request@genetics.upenn.edu, containing the single line - subscribe VMSPerl - as the body of the message. And, as always, we welcome any help or code you'd - like to offer - you can send mail to bailey@genetics.upenn.edu or directly to - the VMSPerl list at vmsperl@genetics.upenn.edu. - - Finally, if you'd like to try out the latest changes to VMS Perl, you can - retrieve a test distribution kit by anonymous ftp from genetics.upenn.edu, in - the file [.perl5]perl5_ppp_yymmddx.zip, where "ppp" is the current Perl - patchlevel, and "yymmddx" is a sequence number indicating the date that - particular kit was assembled. In order to make retrieval convenient, this - kit is also available by the name Perl5_VMSTest.Zip. These test kits contain - "unofficial" patches from the perl5-porters group, test patches for important - bugs, and VMS-specific fixes and improvements which have occurred since the - last Perl release. Most of these changes will be incorporated in the next - release of Perl, but until Larry Wall's looked at them and said they're OK, - none of them should be considered official. - - Good luck using Perl. Please let us know how it works for you - we can't - guarantee that we'll be able to fix bugs quickly, but we'll try, and we'd - certainly like to know they're out there. - - - * Acknowledgements - - There are, of course, far too many people involved in the porting and testing - of Perl to mention everyone who deserves it, so please forgive us if we've - missed someone. That said, special thanks are due to the following: - Tim Adye - for the VMS emulations of getpw*() - David Denholm - for extensive testing and provision of pipe and SocketShr code, - Mark Pizzolato - for the getredirection() code - Rich Salz - for readdir() and related routines - Peter Prymmer - and Tim Bunce , deserve credit for their creativity and willingness to work with the VMS newcomers. Finally, the greatest debt of gratitude is due to Larry Wall , for having the ideas which have made our sleepless nights possible. --- 376,381 ---- diff -c 'perl5.004_04/README.win32' 'perl5.004_05/README.win32' Index: ./README.win32 *** ./README.win32 Mon Jul 28 20:02:36 1997 --- ./README.win32 Thu Apr 29 11:45:26 1999 *************** *** 1,583 **** ! If you read this file _as_is_, just ignore the funny characters you ! see. It is written in the POD format (see pod/perlpod.pod) which is ! specially designed to be readable as is. ! ! =head1 NAME ! ! perlwin32 - Perl under Win32 ! ! =head1 SYNOPSIS ! ! These are instructions for building Perl under Windows NT (versions ! 3.51 or 4.0), using Visual C++ (versions 2.0 through 5.0) or Borland ! C++ (version 5.x). Currently, this port may also build under Windows95, ! but you can expect problems stemming from the unmentionable command ! shell that infests that platform. Note this caveat is only about ! B perl. Once built, you should be able to B it on ! either Win32 platform (modulo the problems arising from the inferior ! command shell). ! ! =head1 DESCRIPTION ! ! Before you start, you should glance through the README file ! found in the top-level directory where the Perl distribution ! was extracted. Make sure you read and understand the terms under ! which this software is being distributed. ! ! Also make sure you read L below for the ! known limitations of this port. ! ! The INSTALL file in the perl top-level has much information that is ! only relevant to people building Perl on Unix-like systems. In ! particular, you can safely ignore any information that talks about ! "Configure". ! ! You may also want to look at two other options for building ! a perl that will work on Windows NT: the README.cygwin32 and ! README.os2 files, which each give a different set of rules to build ! a Perl that will work on Win32 platforms. Those two methods will ! probably enable you to build a more Unix-compatible perl, but you ! will also need to download and use various other build-time and ! run-time support software described in those files. ! ! This set of instructions is meant to describe a so-called "native" ! port of Perl to Win32 platforms. The resulting Perl requires no ! additional software to run (other than what came with your operating ! system). Currently, this port is capable of using either the ! Microsoft Visual C++ compiler, or the Borland C++ compiler. The ! ultimate goal is to support the other major compilers that can ! generally be used to build Win32 applications. ! ! This port currently supports MakeMaker (the set of modules that ! is used to build extensions to perl). Therefore, you should be ! able to build and install most extensions found in the CPAN sites. ! See L below for general hints about this. ! ! =head2 Setting Up ! ! =over 4 ! ! =item Command Shell ! ! Use the default "cmd" shell that comes with NT. In particular, do ! *not* use the 4DOS/NT shell. The Makefile has commands that are not ! compatible with that shell. The Makefile also has known ! incompatibilites with the default shell that comes with Windows95, ! so building under Windows95 should be considered "unsupported". ! ! =item Borland C++ ! ! If you are using the Borland compiler, you will need dmake, a freely ! available make that has very nice macro features and parallelability. ! (The make that Borland supplies is seriously crippled, and will not ! work for MakeMaker builds--if you *have* to bug someone about this, ! I suggest you bug Borland to fix their make :) ! ! A port of dmake for win32 platforms is available from ! "http://www-personal.umich.edu/~gsar/dmake-4.0-win32.tar.gz". ! Fetch and install dmake somewhere on your path. Also make sure you ! copy the Borland dmake.ini file to some location where you keep ! *.ini files. If you use the binary that comes with the above port, you ! will need to set INIT in your environment to the directory where you ! put the dmake.ini file. ! ! =item Microsoft Visual C++ ! ! The NMAKE that comes with Visual C++ will suffice for building. ! If you did not choose to always initialize the Visual C++ compilation ! environment variables when you installed Visual C++ on your system, you ! will need to run the VCVARS32.BAT file usually found somewhere like ! C:\MSDEV4.2\BIN. This will set your build environment. ! ! You can also use dmake to build using Visual C++, provided: you ! copied the dmake.ini for Visual C++; set INIT to point to the ! directory where you put it, as above; and edit win32/config.vc ! and change "make=nmake" to "make=dmake". The last step is only ! essential if you want to use dmake to be your default make for ! building extensions using MakeMaker. ! ! =item Permissions ! ! Depending on how you extracted the distribution, you have to make sure ! some of the files are writable by you. The easiest way to make sure of ! this is to execute: ! ! attrib -R *.* /S ! ! from the perl toplevel directory. You don't I to do this if you ! used the right tools to extract the files in the standard distribution, ! but it doesn't hurt to do so. ! ! =back ! ! =head2 Building ! ! =over 4 ! ! =item * ! ! Make sure you are in the "win32" subdirectory under the perl toplevel. ! This directory contains a "Makefile" that will work with ! versions of NMAKE that come with Visual C++ ver. 2.0 and above, and ! a dmake "makefile.mk" that will work for both Borland and Visual C++ ! builds. The defaults in the dmake makefile are setup to build using the ! Borland compiler. ! ! =item * ! ! Edit the Makefile (or makefile.mk, if using dmake) and change the values ! of INST_DRV and INST_TOP if you want perl to be installed in a location ! other than "C:\PERL". If you are using Visual C++ ver. 2.0, uncomment ! the line that sets "CCTYPE=MSVC20". ! ! You will also have to make sure CCHOME points to wherever you installed ! your compiler. ! ! =item * ! ! Type "nmake" (or "dmake" if you are using that make). ! ! This should build everything. Specifically, it will create perl.exe, ! perl.dll, and perlglob.exe at the perl toplevel, and various other ! extension dll's under the lib\auto directory. If the build fails for ! any reason, make sure you have done the previous steps correctly. ! ! The build process may produce "harmless" compiler warnings (more or ! less copiously, depending on how picky your compiler gets). The ! maintainers are aware of these warnings, thankyouverymuch. :) ! ! When building using Visual C++, a perl95.exe will also get built. This ! executable is only needed on Windows95, and should be used instead of ! perl.exe, and then only if you want sockets to work properly on Windows95. ! This is necessitated by a bug in the Microsoft C Runtime that cannot be ! worked around in the "normal" perl.exe. Again, if this bugs you, please ! bug Microsoft :). perl95.exe gets built with its own private copy of the ! C Runtime that is not accessible to extensions (which see the DLL version ! of the CRT). Be aware, therefore, that this perl95.exe will have ! esoteric problems with extensions like perl/Tk that themselves use the C ! Runtime heavily, or want to free() pointers malloc()-ed by perl. ! ! You can avoid the perl95.exe problems completely if you use Borland ! C++ for building perl (perl95.exe is not needed and will not be built ! in that case). ! ! =back ! ! =head2 Testing ! ! Type "nmake test" (or "dmake test"). This will run most of the tests from ! the testsuite (many tests will be skipped, and but no test should fail). ! ! If some tests do fail, it may be because you are using a different command ! shell than the native "cmd.exe". ! ! If you used the Borland compiler, you may see a failure in op/taint.t ! arising from the inability to find the Borland Runtime DLLs on the system ! default path. You will need to copy the DLLs reported by the messages ! from where Borland chose to install it, into the Windows system directory ! (usually somewhere like C:\WINNT\SYSTEM32), and rerun the test. ! ! Please report any other failures as described under L. ! ! =head2 Installation ! ! Type "nmake install" (or "dmake install"). This will put the newly ! built perl and the libraries under "C:\perl" (actually whatever you set ! C to in the Makefile). It will also install the pod ! documentation under C<$INST_TOP\lib\pod> and HTML versions of the same ! under C<$INST_TOP\lib\pod\html>. To use the Perl you just installed, ! set your PATH environment variable to "C:\perl\bin" (or C<$INST_TOP\bin>, ! if you changed the default as above). ! ! =head2 Usage Hints ! ! =over 4 ! ! =item Environment Variables ! ! The installation paths that you set during the build get compiled ! into perl, so you don't have to do anything additional to start ! using that perl (except add its location to your PATH variable). ! ! If you put extensions in unusual places, you can set PERL5LIB ! to a list of paths separated by semicolons where you want perl ! to look for libraries. Look for descriptions of other environment ! variables you can set in the perlrun podpage. ! ! Sometime in the future, some of the configuration information ! for perl will be moved into the Windows registry. ! ! =item File Globbing ! ! By default, perl spawns an external program to do file globbing. ! The install process installs both a perlglob.exe and a perlglob.bat ! that perl can use for this purpose. Note that with the default ! installation, perlglob.exe will be found by the system before ! perlglob.bat. ! ! perlglob.exe relies on the argv expansion done by the C Runtime of ! the particular compiler you used, and therefore behaves very ! differently depending on the Runtime used to build it. To preserve ! compatiblity, perlglob.bat (a perl script/module that can be ! used portably) is installed. Besides being portable, perlglob.bat ! also offers enhanced globbing functionality. ! ! If you want perl to use perlglob.bat instead of perlglob.exe, just ! delete perlglob.exe from the install location (or move it somewhere ! perl cannot find). Using File::DosGlob.pm (which is the same ! as perlglob.bat) to override the internal CORE::glob() works about 10 ! times faster than spawing perlglob.exe, and you should take this ! approach when writing new modules. See File::DosGlob for details. ! ! =item Using perl from the command line ! ! If you are accustomed to using perl from various command-line ! shells found in UNIX environments, you will be less than pleased ! with what Windows NT offers by way of a command shell. ! ! The crucial thing to understand about the "cmd" shell (which is ! the default on Windows NT) is that it does not do any wildcard ! expansions of command-line arguments (so wildcards need not be ! quoted). It also provides only rudimentary quoting. The only ! (useful) quote character is the double quote ("). It can be used to ! protect spaces in arguments and other special characters. The ! Windows NT documentation has almost no description of how the ! quoting rules are implemented, but here are some general observations ! based on experiments: The shell breaks arguments at spaces and ! passes them to programs in argc/argv. Doublequotes can be used ! to prevent arguments with spaces in them from being split up. ! You can put a double quote in an argument by escaping it with ! a backslash and enclosing the whole argument within double quotes. ! The backslash and the pair of double quotes surrounding the ! argument will be stripped by the shell. ! ! The file redirection characters "<", ">", and "|" cannot be quoted ! by double quotes (there are probably more such). Single quotes ! will protect those three file redirection characters, but the ! single quotes don't get stripped by the shell (just to make this ! type of quoting completely useless). The caret "^" has also ! been observed to behave as a quoting character (and doesn't get ! stripped by the shell also). ! ! Here are some examples of usage of the "cmd" shell: ! ! This prints two doublequotes: ! ! perl -e "print '\"\"' " ! ! This does the same: ! ! perl -e "print \"\\\"\\\"\" " ! ! This prints "bar" and writes "foo" to the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" > blurch ! ! This prints "foo" ("bar" disappears into nowhereland): ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> nul ! ! This prints "bar" and writes "foo" into the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 1> blurch ! ! This pipes "foo" to the "less" pager and prints "bar" on the console: ! ! perl -e "print 'foo'; print STDERR 'bar'" | less ! ! This pipes "foo\nbar\n" to the less pager: ! ! perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less ! ! This pipes "foo" to the pager and writes "bar" in the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less ! ! ! Discovering the usefulness of the "command.com" shell on Windows95 ! is left as an exercise to the reader :) ! ! =item Building Extensions ! ! The Comprehensive Perl Archive Network (CPAN) offers a wealth ! of extensions, some of which require a C compiler to build. ! Look in http://www.perl.com/ for more information on CPAN. ! ! Most extensions (whether they require a C compiler or not) can ! be built, tested and installed with the standard mantra: ! ! perl Makefile.PL ! $MAKE ! $MAKE test ! $MAKE install ! ! where $MAKE stands for NMAKE or DMAKE. Some extensions may not ! provide a testsuite (so "$MAKE test" may not do anything, or fail), ! but most serious ones do. ! ! If a module implements XSUBs, you will need one of the supported ! C compilers. You must make sure you have set up the environment for ! the compiler for command-line compilation. ! ! If a module does not build for some reason, look carefully for ! why it failed, and report problems to the module author. If ! it looks like the extension building support is at fault, report ! that with full details of how the build failed using the perlbug ! utility. ! ! =item Win32 Specific Extensions ! ! A number of extensions specific to the Win32 platform are available ! from CPAN. You may find that many of these extensions are meant to ! be used under the Activeware port of Perl, which used to be the only ! native port for the Win32 platform. Since the Activeware port does not ! have adequate support for Perl's extension building tools, these ! extensions typically do not support those tools either, and therefore ! cannot be built using the generic steps shown in the previous section. ! ! To ensure smooth transitioning of existing code that uses the ! Activeware port, there is a bundle of Win32 extensions that contains ! all of the Activeware extensions and most other Win32 extensions from ! CPAN in source form, along with many added bugfixes, and with MakeMaker ! support. This bundle is available at: ! ! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.08.tar.gz ! ! See the README in that distribution for building and installation ! instructions. Look for later versions that may be available at the ! same location. ! ! It is expected that authors of Win32 specific extensions will begin ! distributing their work in MakeMaker compatible form subsequent to ! the 5.004 release of perl, at which point the need for a dedicated ! bundle such as the above should diminish. ! ! =item Running Perl Scripts ! ! Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to ! indicate to the OS that it should execute the file using perl. ! Win32 has no comparable means to indicate arbitrary files are ! executables. ! ! Instead, all available methods to execute plain text files on ! Win32 rely on the file "extension". There are three methods ! to use this to execute perl scripts: ! ! =over 8 ! ! =item 1 ! ! There is a facility called "file extension associations" that will ! work in Windows NT 4.0. This can be manipulated via the two ! commands "assoc" and "ftype" that come standard with Windows NT ! 4.0. Type "ftype /?" for a complete example of how to set this ! up for perl scripts (Say what? You thought Windows NT wasn't ! perl-ready? :). ! ! =item 2 ! ! Since file associations don't work everywhere, and there are ! reportedly bugs with file associations where it does work, the ! old method of wrapping the perl script to make it look like a ! regular batch file to the OS, may be used. The install process ! makes available the "pl2bat.bat" script which can be used to wrap ! perl scripts into batch files. For example: ! ! pl2bat foo.pl ! ! will create the file "FOO.BAT". Note "pl2bat" strips any ! .pl suffix and adds a .bat suffix to the generated file. ! ! If you use the 4DOS/NT or similar command shell, note that ! "pl2bat" uses the "%*" variable in the generated batch file to ! refer to all the command line arguments, so you may need to make ! sure that construct works in batch files. As of this writing, ! 4DOS/NT users will need a "ParameterChar = *" statement in their ! 4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT ! startup file to enable this to work. ! ! =item 3 ! ! Using "pl2bat" has a few problems: the file name gets changed, ! so scripts that rely on C<$0> to find what they must do may not ! run properly; running "pl2bat" replicates the contents of the ! original script, and so this process can be maintenance intensive ! if the originals get updated often. A different approach that ! avoids both problems is possible. ! ! A script called "runperl.bat" is available that can be copied ! to any filename (along with the .bat suffix). For example, ! if you call it "foo.bat", it will run the file "foo" when it is ! executed. Since you can run batch files on Win32 platforms simply ! by typing the name (without the extension), this effectively ! runs the file "foo", when you type either "foo" or "foo.bat". ! With this method, "foo.bat" can even be in a different location ! than the file "foo", as long as "foo" is available somewhere on ! the PATH. If your scripts are on a filesystem that allows symbolic ! links, you can even avoid copying "runperl.bat". ! ! Here's a diversion: copy "runperl.bat" to "runperl", and type ! "runperl". Explain the observed behavior, or lack thereof. :) ! Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH ! ! =back ! ! =item Miscellaneous Things ! ! A full set of HTML documentation is installed, so you should be ! able to use it if you have a web browser installed on your ! system. ! ! C is also a useful tool for browsing information contained ! in the documentation, especially in conjunction with a pager ! like C (recent versions of which have Win32 support). You may ! have to set the PAGER environment variable to use a specific pager. ! "perldoc -f foo" will print information about the perl operator ! "foo". ! ! If you find bugs in perl, you can run C to create a ! bug report (you may have to send it manually if C cannot ! find a mailer on your system). ! ! =back ! ! =head1 BUGS AND CAVEATS ! ! This port should be considered beta quality software at the present ! time because some details are still in flux and there may be ! changes in any of these areas: build process, installation structure, ! supported utilities/modules, and supported perl functionality. ! In particular, functionality specific to the Win32 environment may ! ultimately be supported as either core modules or extensions. The ! beta status implies, among other things, that you should be prepared ! to recompile extensions when binary incompatibilites arise due to ! changes in the internal structure of the code. ! ! An effort has been made to ensure that the DLLs produced by the two ! supported compilers are compatible with each other (despite the ! best efforts of the compiler vendors). Extension binaries produced ! by one compiler should also coexist with a perl binary built by ! a different compiler. In order to accomplish this, PERL.DLL provides ! a layer of runtime code that uses the C Runtime that perl was compiled ! with. Extensions which include "perl.h" will transparently access ! the functions in this layer, thereby ensuring that both perl and ! extensions use the same runtime functions. ! ! If you have had prior exposure to Perl on Unix platforms, you will notice ! this port exhibits behavior different from what is documented. Most of the ! differences fall under one of these categories. We do not consider ! any of them to be serious limitations (especially when compared to the ! limited nature of some of the Win32 OSes themselves :) ! ! =over 8 ! ! =item * ! ! C and C functions may not behave as documented. They ! may return values that bear no resemblance to those reported on Unix ! platforms, and some fields (like the the one for inode) may be completely ! bogus. ! ! =item * ! ! The following functions are currently unavailable: C, ! C, C, C, C, C, ! C, C, C, C, ! C, C. This list is possibly very incomplete. ! ! =item * ! ! crypt() is not available due to silly export restrictions. It may ! become available when the laws change. Meanwhile, look in CPAN for ! extensions that provide it. ! ! =item * ! ! Various C related calls are supported, but they may not ! behave as on Unix platforms. ! ! =item * ! ! The four-argument C call is only supported on sockets. ! ! =item * ! ! C<$?> ends up with the exitstatus of the subprocess (this is different ! from Unix, where the exitstatus is actually given by "$? >> 8"). ! Failure to spawn() the subprocess is indicated by setting $? to ! "255<<8". This is subject to change. ! ! =item * ! ! Building modules available on CPAN is mostly supported, but this ! hasn't been tested much yet. Expect strange problems, and be ! prepared to deal with the consequences. ! ! =item * ! ! C, C and process-related functions may not ! behave as described in the documentation, and some of the ! returned values or effects may be bogus. ! ! =item * ! ! Signal handling may not behave as on Unix platforms (where it ! doesn't exactly "behave", either :). For instance, calling C ! or C from signal handlers will cause an exception, since most ! implementations of C on Win32 are severely crippled. ! Thus, signals may work only for simple things like setting a flag ! variable in the handler. Using signals under this port should ! currently be considered unsupported. ! ! =item * ! ! File globbing may not behave as on Unix platforms. In particular, ! if you don't use perlglob.bat for globbing, it will understand ! wildcards only in the filename component (and not in the pathname). ! In other words, something like "print <*/*.pl>" will not print all the ! perl scripts in all the subdirectories one level under the current one ! (like it does on UNIX platforms). perlglob.exe is also dependent on ! the particular implementation of wildcard expansion in the vendor ! libraries used to build it (which varies wildly at the present time). ! Using perlglob.bat (or File::DosGlob) avoids these limitations, but ! still only provides DOS semantics (read "warts") for globbing. ! ! =back ! ! Please send detailed descriptions of any problems and solutions that ! you may find to >, along with the output produced ! by C. ! ! =head1 AUTHORS ! ! =over 4 ! ! Gary Ng E71564.1743@CompuServe.COME ! ! Gurusamy Sarathy Egsar@umich.eduE ! ! Nick Ing-Simmons Enick@ni-s.u-net.comE ! ! =back ! ! This document is maintained by Gurusamy Sarathy. ! ! =head1 SEE ALSO ! ! L ! ! =head1 HISTORY ! ! This port was originally contributed by Gary Ng around 5.003_24, ! and borrowed from the Hip Communications port that was available ! at the time. ! ! Nick Ing-Simmons and Gurusamy Sarathy have made numerous and ! sundry hacks since then. ! ! Borland support was added in 5.004_01 (Gurusamy Sarathy). ! ! Last updated: 25 July 1997 ! ! =cut ! --- 1,673 ---- ! If you read this file _as_is_, just ignore the funny characters you ! see. It is written in the POD format (see pod/perlpod.pod) which is ! specially designed to be readable as is. ! ! =head1 NAME ! ! perlwin32 - Perl under Win32 ! ! =head1 SYNOPSIS ! ! These are instructions for building Perl under Windows NT (versions ! 3.51 or 4.0). Currently, this port is reported to build ! under Windows95 using the 4DOS shell--the default shell that infests ! Windows95 will not work (see below). Note this caveat is only about ! B perl. Once built, you should be able to B it on ! either Win32 platform (modulo the problems arising from the inferior ! command shell). ! ! =head1 DESCRIPTION ! ! Before you start, you should glance through the README file ! found in the top-level directory where the Perl distribution ! was extracted. Make sure you read and understand the terms under ! which this software is being distributed. ! ! Also make sure you read L below for the ! known limitations of this port. ! ! The INSTALL file in the perl top-level has much information that is ! only relevant to people building Perl on Unix-like systems. In ! particular, you can safely ignore any information that talks about ! "Configure". ! ! You may also want to look at two other options for building ! a perl that will work on Windows NT: the README.cygwin32 and ! README.os2 files, which each give a different set of rules to build ! a Perl that will work on Win32 platforms. Those two methods will ! probably enable you to build a more Unix-compatible perl, but you ! will also need to download and use various other build-time and ! run-time support software described in those files. ! ! This set of instructions is meant to describe a so-called "native" ! port of Perl to Win32 platforms. The resulting Perl requires no ! additional software to run (other than what came with your operating ! system). Currently, this port is capable of using one of the ! following compilers: ! ! Borland C++ version 5.02 or later ! Microsoft Visual C++ version 4.2 or later ! ! ! This port currently supports MakeMaker (the set of modules that ! is used to build extensions to perl). Therefore, you should be ! able to build and install most extensions found in the CPAN sites. ! See L below for general hints about this. ! ! =head2 Setting Up ! ! =over 4 ! ! =item Command Shell ! ! Use the default "cmd" shell that comes with NT. Some versions of the ! popular 4DOS/NT shell have incompatibilities that may cause you trouble. ! If the build fails under that shell, try building again with the cmd ! shell. The Makefile also has known incompatibilites with the "command.com" ! shell that comes with Windows95, so building under Windows95 should ! be considered "unsupported". However, there have been reports of successful ! build attempts using 4DOS/NT version 6.01 under Windows95, using dmake, but ! your mileage may vary. ! ! The surest way to build it is on WindowsNT, using the cmd shell. ! ! Make sure the path to the build directory does not contain spaces. The ! build usually works in this circumstance, but some tests will fail. ! ! =item Borland C++ ! ! If you are using the Borland compiler, you will need dmake, a freely ! available make that has very nice macro features and parallelability. ! (The make that Borland supplies is seriously crippled, and will not ! work for MakeMaker builds.) ! ! A port of dmake for win32 platforms is available from: ! ! http://www-personal.umich.edu/~gsar/dmake-4.1-win32.zip ! ! Fetch and install dmake somewhere on your path (follow the instructions ! in the README.NOW file). ! ! =item Microsoft Visual C++ ! ! The NMAKE that comes with Visual C++ will suffice for building. ! You will need to run the VCVARS32.BAT file usually found somewhere ! like C:\MSDEV4.2\BIN. This will set your build environment. ! ! You can also use dmake to build using Visual C++, provided: ! you set OSRELEASE to "microsft" (or whatever the directory name ! under which the Visual C dmake configuration lives) in your environment, ! and edit win32/config.vc to change "make=nmake" into "make=dmake". The ! latter step is only essential if you want to use dmake as your default ! make for building extensions using MakeMaker. ! ! =back ! ! =head2 Building ! ! =over 4 ! ! =item * ! ! Make sure you are in the "win32" subdirectory under the perl toplevel. ! This directory contains a "Makefile" that will work with ! versions of NMAKE that come with Visual C++, and a dmake "makefile.mk" ! that will work for all supported compilers. The defaults in the dmake ! makefile are setup to build using the Borland compiler. ! ! =item * ! ! Edit the makefile.mk (or Makefile, if using nmake) and change the values ! of INST_DRV and INST_TOP. You can also enable various build ! flags. ! ! If you have either the source or a library that contains des_fcrypt(), ! enable the appropriate option in the makefile. des_fcrypt() is not ! bundled with the distribution due to US Government restrictions ! on the export of cryptographic software. Nevertheless, this routine ! is part of the "libdes" library (written by Ed Young) which is widely ! available worldwide, usually along with SSLeay (for example: ! "ftp://fractal.mta.ca/pub/crypto/SSLeay/DES/"). Set CRYPT_SRC to the ! name of the file that implements des_fcrypt(). Alternatively, if ! you have built a library that contains des_fcrypt(), you can set ! CRYPT_LIB to point to the library name. The location above contains ! many versions of the "libdes" library, all with slightly different ! implementations of des_fcrypt(). Older versions have a single, ! self-contained file (fcrypt.c) that implements crypt(), so they may be ! easier to use. A patch against the fcrypt.c found in libdes-3.06 is ! in des_fcrypt.patch. ! ! Perl will also build without des_fcrypt(), but the crypt() builtin will ! fail at run time. ! ! You will also have to make sure CCHOME points to wherever you installed ! your compiler. Make sure this path has no spaces in it. If you ! insist on spaces in your path names, there is no telling what else ! will fail, but you can try putting the path in double quotes. Some ! parts of perl try to accomodate that, but not all pieces do. ! ! The default value for CCHOME in the makefiles for Visual C++ ! may not be correct if you have a version later than 5.2. Make ! sure the default exists and is valid. ! ! Other options are explained in the makefiles. Be sure to read the ! instructions carefully. ! ! =item * ! ! Type "dmake" (or "nmake" if you are using that make). ! ! This should build everything. Specifically, it will create perl.exe, ! perl.dll, and perlglob.exe at the perl toplevel, and various other ! extension dll's under the lib\auto directory. If the build fails for ! any reason, make sure you have done the previous steps correctly. ! ! The build process may produce "harmless" compiler warnings (more or ! less copiously, depending on how picky your compiler gets). The ! maintainers are aware of these warnings, thankyouverymuch. :) ! ! When building using Visual C++, a perl95.exe will also get built. This ! executable is only needed on Windows95, and should be used instead of ! perl.exe, and then only if you want sockets to work properly on Windows95. ! This is necessitated by a bug in the Microsoft C Runtime that cannot be ! worked around in the "normal" perl.exe. perl95.exe gets built with its ! own private copy of the C Runtime that is not accessible to extensions ! (which see the DLL version of the CRT). Be aware, therefore, that this ! perl95.exe will have esoteric problems with extensions like perl/Tk that ! themselves use the C Runtime heavily, or want to free() pointers ! malloc()-ed by perl. ! ! You can avoid the perl95.exe problems completely if you either enable ! USE_PERLCRT with Visual C++, or use Borland C++ for building perl. In ! those cases, perl95.exe is not needed and will not be built. ! ! =back ! ! =head2 Testing ! ! Type "dmake test" (or "nmake test"). This will run most of the tests from ! the testsuite (many tests will be skipped, and but no test should fail). ! ! If some tests do fail, it may be because you are using a different command ! shell than the native "cmd.exe", or because you are building from a path ! that contains spaces. So don't do that. ! ! If you're using the Borland compiler, you may see a failure in op/taint.t ! arising from the inability to find the Borland Runtime DLLs on the system ! default path. You will need to copy the DLLs reported by the messages ! from where Borland chose to install it, into the Windows system directory ! (usually somewhere like C:\WINNT\SYSTEM32), and rerun the test. ! ! The Visual C runtime apparently has a bug that causes posix.t to fail ! test#2. This usually happens only if you extracted the files in text ! mode. Enable the USE_PERLCRT option in the Makefile to fix this bug. ! ! Please report any other failures as described under L. ! ! =head2 Installation ! ! Type "dmake install" (or "nmake install"). This will put the newly ! built perl and the libraries under whatever C points to in the ! Makefile. It will also install the pod documentation under ! C<$INST_TOP\lib\pod> and HTML versions of the same under ! C<$INST_TOP\lib\pod\html>. To use the Perl you just installed, ! set your PATH environment variable to C<$INST_TOP\bin>. ! ! =head2 Usage Hints ! ! =over 4 ! ! =item Environment Variables ! ! The installation paths that you set during the build get compiled ! into perl, so you don't have to do anything additional to start ! using that perl (except add its location to your PATH variable). ! ! If you put extensions in unusual places, you can set PERL5LIB ! to a list of paths separated by semicolons where you want perl ! to look for libraries. Look for descriptions of other environment ! variables you can set in L. ! ! You can also control the shell that perl uses to run system() and ! backtick commands via PERL5SHELL. See L. ! ! Perl does not depend on the registry, but it can look up certain default ! values if you choose to put them there. Perl attempts to read entries from ! C and C. ! Entries in the former override entries in the latter. One or more of the ! following entries (of type REG_SZ or REG_EXPAND_SZ) may be set: ! ! lib-$] version-specific path to add to @INC ! lib path to add to @INC ! sitelib-$] version-specific path to add to @INC ! sitelib path to add to @INC ! PERL* fallback for all %ENV lookups that begin with "PERL" ! ! Note the C<$]> in the above is not literal. Substitute whatever version ! of perl you want to honor that entry, e.g. C<5.00502>. Paths must be ! separated with semicolons, as usual on win32. ! ! =item File Globbing ! ! By default, perl spawns an external program to do file globbing. ! The install process installs both a perlglob.exe and a perlglob.bat ! that perl can use for this purpose. Note that with the default ! installation, perlglob.exe will be found by the system before ! perlglob.bat. ! ! perlglob.exe relies on the argv expansion done by the C Runtime of ! the particular compiler you used, and therefore behaves very ! differently depending on the Runtime used to build it. To preserve ! compatiblity, perlglob.bat (a perl script that can be used portably) ! is installed. Besides being portable, perlglob.bat also offers ! enhanced globbing functionality. ! ! If you want perl to use perlglob.bat instead of perlglob.exe, just ! delete perlglob.exe from the install location (or move it somewhere ! perl cannot find). Using File::DosGlob.pm (which implements the core ! functionality of perlglob.bat) to override the internal CORE::glob() ! works about 10 times faster than spawing perlglob.exe, and you should ! take this approach when writing new modules. See File::DosGlob for ! details. ! ! =item Using perl from the command line ! ! If you are accustomed to using perl from various command-line ! shells found in UNIX environments, you will be less than pleased ! with what Windows NT offers by way of a command shell. ! ! The crucial thing to understand about the "cmd" shell (which is ! the default on Windows NT) is that it does not do any wildcard ! expansions of command-line arguments (so wildcards need not be ! quoted). It also provides only rudimentary quoting. The only ! (useful) quote character is the double quote ("). It can be used to ! protect spaces in arguments and other special characters. The ! Windows NT documentation has almost no description of how the ! quoting rules are implemented, but here are some general observations ! based on experiments: The shell breaks arguments at spaces and ! passes them to programs in argc/argv. Doublequotes can be used ! to prevent arguments with spaces in them from being split up. ! You can put a double quote in an argument by escaping it with ! a backslash and enclosing the whole argument within double quotes. ! The backslash and the pair of double quotes surrounding the ! argument will be stripped by the shell. ! ! The file redirection characters "<", ">", and "|" cannot be quoted ! by double quotes (there are probably more such). Single quotes ! will protect those three file redirection characters, but the ! single quotes don't get stripped by the shell (just to make this ! type of quoting completely useless). The caret "^" has also ! been observed to behave as a quoting character (and doesn't get ! stripped by the shell also). ! ! Here are some examples of usage of the "cmd" shell: ! ! This prints two doublequotes: ! ! perl -e "print '\"\"' " ! ! This does the same: ! ! perl -e "print \"\\\"\\\"\" " ! ! This prints "bar" and writes "foo" to the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" > blurch ! ! This prints "foo" ("bar" disappears into nowhereland): ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> nul ! ! This prints "bar" and writes "foo" into the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 1> blurch ! ! This pipes "foo" to the "less" pager and prints "bar" on the console: ! ! perl -e "print 'foo'; print STDERR 'bar'" | less ! ! This pipes "foo\nbar\n" to the less pager: ! ! perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less ! ! This pipes "foo" to the pager and writes "bar" in the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less ! ! ! Discovering the usefulness of the "command.com" shell on Windows95 ! is left as an exercise to the reader :) ! ! =item Building Extensions ! ! The Comprehensive Perl Archive Network (CPAN) offers a wealth ! of extensions, some of which require a C compiler to build. ! Look in http://www.perl.com/ for more information on CPAN. ! ! Most extensions (whether they require a C compiler or not) can ! be built, tested and installed with the standard mantra: ! ! perl Makefile.PL ! $MAKE ! $MAKE test ! $MAKE install ! ! where $MAKE stands for NMAKE or DMAKE. Some extensions may not ! provide a testsuite (so "$MAKE test" may not do anything, or fail), ! but most serious ones do. ! ! If a module implements XSUBs, you will need one of the supported ! C compilers. You must make sure you have set up the environment for ! the compiler for command-line compilation. ! ! If a module does not build for some reason, look carefully for ! why it failed, and report problems to the module author. If ! it looks like the extension building support is at fault, report ! that with full details of how the build failed using the perlbug ! utility. ! ! =item Command-line Wildcard Expansion ! ! The default command shells on DOS descendant operating systems (such ! as they are) usually do not expand wildcard arguments supplied to ! programs. They consider it the application's job to handle that. ! This is commonly achieved by linking the application (in our case, ! perl) with startup code that the C runtime libraries usually provide. ! However, doing that results in incompatible perl versions (since the ! behavior of the argv expansion code differs depending on the ! compiler, and it is even buggy on some compilers). Besides, it may ! be a source of frustration if you use such a perl binary with an ! alternate shell that *does* expand wildcards. ! ! Instead, the following solution works rather well. The nice things ! about it: 1) you can start using it right away 2) it is more powerful, ! because it will do the right thing with a pattern like */*/*.c ! 3) you can decide whether you do/don't want to use it 4) you can ! extend the method to add any customizations (or even entirely ! different kinds of wildcard expansion). ! ! C:\> copy con c:\perl\lib\Wild.pm ! # Wild.pm - emulate shell @ARGV expansion on shells that don't ! use File::DosGlob; ! @ARGV = map { ! my @g = File::DosGlob::glob($_) if /[*?]/; ! @g ? @g : $_; ! } @ARGV; ! 1; ! ^Z ! C:\> set PERL5OPT=-MWild ! C:\> perl -le "for (@ARGV) { print }" */*/perl*.c ! p4view/perl/perl.c ! p4view/perl/perlio.c ! p4view/perl/perly.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! ! Note there are two distinct steps there: 1) You'll have to create ! Wild.pm and put it in your perl lib directory. 2) You'll need to ! set the PERL5OPT environment variable. If you want argv expansion ! to be the default, just set PERL5OPT in your default startup ! environment. ! ! If you are using the Visual C compiler, you can get the C runtime's ! command line wildcard expansion built into perl binary. The resulting ! binary will always expand unquoted command lines, which may not be ! what you want if you use a shell that does that for you. The expansion ! done is also somewhat less powerful than the approach suggested above. ! ! =item Win32 Specific Extensions ! ! A number of extensions specific to the Win32 platform are available ! from CPAN. You may find that many of these extensions are meant to ! be used under the Activeware port of Perl, which used to be the only ! native port for the Win32 platform. Since the Activeware port does not ! have adequate support for Perl's extension building tools, these ! extensions typically do not support those tools either, and therefore ! cannot be built using the generic steps shown in the previous section. ! ! To ensure smooth transitioning of existing code that uses the ! ActiveState port, there is a bundle of Win32 extensions that contains ! all of the ActiveState extensions and most other Win32 extensions from ! CPAN in source form, along with many added bugfixes, and with MakeMaker ! support. This bundle is available at: ! ! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.14.zip ! ! See the README in that distribution for building and installation ! instructions. Look for later versions that may be available at the ! same location. ! ! =item Running Perl Scripts ! ! Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to ! indicate to the OS that it should execute the file using perl. ! Win32 has no comparable means to indicate arbitrary files are ! executables. ! ! Instead, all available methods to execute plain text files on ! Win32 rely on the file "extension". There are three methods ! to use this to execute perl scripts: ! ! =over 8 ! ! =item 1 ! ! There is a facility called "file extension associations" that will ! work in Windows NT 4.0. This can be manipulated via the two ! commands "assoc" and "ftype" that come standard with Windows NT ! 4.0. Type "ftype /?" for a complete example of how to set this ! up for perl scripts (Say what? You thought Windows NT wasn't ! perl-ready? :). ! ! =item 2 ! ! Since file associations don't work everywhere, and there are ! reportedly bugs with file associations where it does work, the ! old method of wrapping the perl script to make it look like a ! regular batch file to the OS, may be used. The install process ! makes available the "pl2bat.bat" script which can be used to wrap ! perl scripts into batch files. For example: ! ! pl2bat foo.pl ! ! will create the file "FOO.BAT". Note "pl2bat" strips any ! .pl suffix and adds a .bat suffix to the generated file. ! ! If you use the 4DOS/NT or similar command shell, note that ! "pl2bat" uses the "%*" variable in the generated batch file to ! refer to all the command line arguments, so you may need to make ! sure that construct works in batch files. As of this writing, ! 4DOS/NT users will need a "ParameterChar = *" statement in their ! 4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT ! startup file to enable this to work. ! ! =item 3 ! ! Using "pl2bat" has a few problems: the file name gets changed, ! so scripts that rely on C<$0> to find what they must do may not ! run properly; running "pl2bat" replicates the contents of the ! original script, and so this process can be maintenance intensive ! if the originals get updated often. A different approach that ! avoids both problems is possible. ! ! A script called "runperl.bat" is available that can be copied ! to any filename (along with the .bat suffix). For example, ! if you call it "foo.bat", it will run the file "foo" when it is ! executed. Since you can run batch files on Win32 platforms simply ! by typing the name (without the extension), this effectively ! runs the file "foo", when you type either "foo" or "foo.bat". ! With this method, "foo.bat" can even be in a different location ! than the file "foo", as long as "foo" is available somewhere on ! the PATH. If your scripts are on a filesystem that allows symbolic ! links, you can even avoid copying "runperl.bat". ! ! Here's a diversion: copy "runperl.bat" to "runperl", and type ! "runperl". Explain the observed behavior, or lack thereof. :) ! Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH ! ! =back ! ! =item Miscellaneous Things ! ! A full set of HTML documentation is installed, so you should be ! able to use it if you have a web browser installed on your ! system. ! ! C is also a useful tool for browsing information contained ! in the documentation, especially in conjunction with a pager ! like C (recent versions of which have Win32 support). You may ! have to set the PAGER environment variable to use a specific pager. ! "perldoc -f foo" will print information about the perl operator ! "foo". ! ! If you find bugs in perl, you can run C to create a ! bug report (you may have to send it manually if C cannot ! find a mailer on your system). ! ! =back ! ! =head1 BUGS AND CAVEATS ! ! An effort has been made to ensure that the DLLs produced by the two ! supported compilers are compatible with each other (despite the ! best efforts of the compiler vendors). Extension binaries produced ! by one compiler should also coexist with a perl binary built by ! a different compiler. In order to accomplish this, PERL.DLL provides ! a layer of runtime code that uses the C Runtime that perl was compiled ! with. Extensions which include "perl.h" will transparently access ! the functions in this layer, thereby ensuring that both perl and ! extensions use the same runtime functions. ! ! If you have had prior exposure to Perl on Unix platforms, you will notice ! this port exhibits behavior different from what is documented. Most of the ! differences fall under one of these categories. We do not consider ! any of them to be serious limitations (especially when compared to the ! limited nature of some of the Win32 OSes themselves :) ! ! =over 8 ! ! =item * ! ! C and C functions may not behave as documented. They ! may return values that bear no resemblance to those reported on Unix ! platforms, and some fields (like the the one for inode) may be completely ! bogus. ! ! =item * ! ! The following functions are currently unavailable: C, ! C, C, C, C, C, ! C and related security functions, C, ! C, C, C, C, ! C, C, C, C, C, ! C<*netent()>, C<*protoent()>, C<*servent()>, C<*hostent()>, ! C. ! This list is possibly incomplete. ! ! =item * ! ! Various C related calls are supported, but they may not ! behave as on Unix platforms. ! ! =item * ! ! The four-argument C call is only supported on sockets. ! ! =item * ! ! The C call is only supported on sockets (where it provides the ! functionality of ioctlsocket() in the Winsock API). ! ! =item * ! ! Failure to spawn() a subprocess is indicated by setting $? to "255 << 8". ! C<$?> is set in a way compatible with Unix (i.e. the exitstatus of the ! subprocess is obtained by "$? >> 8", as described in the documentation). ! ! =item * ! ! You can expect problems building modules available on CPAN if you ! build perl itself with -DUSE_THREADS. These problems should be resolved ! as we get closer to 5.005. ! ! =item * ! ! C, C and process-related functions may not ! behave as described in the documentation, and some of the ! returned values or effects may be bogus. ! ! =item * ! ! Signal handling may not behave as on Unix platforms (where it ! doesn't exactly "behave", either :). For instance, calling C ! or C from signal handlers will cause an exception, since most ! implementations of C on Win32 are severely crippled. ! Thus, signals may work only for simple things like setting a flag ! variable in the handler. Using signals under this port should ! currently be considered unsupported. ! ! =item * ! ! C is implemented, but doesn't have the semantics of ! C, i.e. it doesn't send a signal to the identified process ! like it does on Unix platforms. Instead it immediately calls ! C. Thus the signal argument is ! used to set the exit-status of the terminated process. This behavior ! may change in future. ! ! =item * ! ! File globbing may not behave as on Unix platforms. In particular, ! if you don't use perlglob.bat for globbing, it will understand ! wildcards only in the filename component (and not in the pathname). ! In other words, something like "print <*/*.pl>" will not print all the ! perl scripts in all the subdirectories one level under the current one ! (like it does on UNIX platforms). perlglob.exe is also dependent on ! the particular implementation of wildcard expansion in the vendor ! libraries used to build it (which varies wildly at the present time). ! Using perlglob.bat (or File::DosGlob) avoids these limitations, but ! still only provides DOS semantics (read "warts") for globbing. ! ! =back ! ! Please send detailed descriptions of any problems and solutions that ! you may find to >, along with the output produced ! by C. ! ! =head1 AUTHORS ! ! =over 4 ! ! Gary Ng E71564.1743@CompuServe.COME ! ! Gurusamy Sarathy Egsar@umich.eduE ! ! Nick Ing-Simmons Enick@ni-s.u-net.comE ! ! =back ! ! This document is maintained by Gurusamy Sarathy. ! ! =head1 SEE ALSO ! ! L ! ! =head1 HISTORY ! ! This port was originally contributed by Gary Ng around 5.003_24, ! and borrowed from the Hip Communications port that was available ! at the time. ! ! Nick Ing-Simmons and Gurusamy Sarathy have made numerous and ! sundry hacks since then. ! ! Borland support was added in 5.004_01 (Gurusamy Sarathy). ! ! Last updated: 29 November 1998 ! ! =cut ! diff -c 'perl5.004_04/Todo' 'perl5.004_05/Todo' Index: ./Todo *** ./Todo Thu Jul 31 16:43:18 1997 --- ./Todo Sun Nov 22 10:08:38 1998 *************** *** 21,26 **** --- 21,28 ---- reference to compiled regexp lexically scoped functions: my sub foo { ... } lvalue functions + regression/sanity tests for suidperl + Full 64 bit support (i.e. "long long") Possible pragmas debugger *************** *** 30,36 **** constant function cache switch structures eval qw() at compile time - foreach (1..1000000) foreach(reverse...) Set KEEP on constant split Cache eval tree (unless lexical outer scope used (mark in &compiling?)) --- 32,37 ---- *************** *** 45,51 **** Vague possibilities ref function in list context - data prettyprint function? (or is it, as I suspect, a lib routine?) make tr/// return histogram in list context? Loop control on do{} et al Explicit switch statements --- 46,51 ---- *************** *** 54,58 **** structured types autocroak? Modifiable $1 et al - substr EXPR,OFFSET,LENGTH,STRING --- 54,57 ---- diff -c 'perl5.004_04/XSUB.h' 'perl5.004_05/XSUB.h' Index: ./XSUB.h *** ./XSUB.h Mon Jul 28 20:37:31 1997 --- ./XSUB.h Tue Mar 3 12:58:12 1998 *************** *** 15,21 **** #define dXSI32 I32 ix = XSANY.any_i32 ! #define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return /* Simple macros to put new mortal values onto the stack. */ /* Typically used to return values from XS functions. */ --- 15,25 ---- #define dXSI32 I32 ix = XSANY.any_i32 ! #define XSRETURN(off) \ ! STMT_START { \ ! stack_sp = stack_base + ax + ((off) - 1); \ ! return; \ ! } STMT_END /* Simple macros to put new mortal values onto the stack. */ /* Typically used to return values from XS functions. */ *************** *** 39,45 **** #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ ! char *vn = "", *module = SvPV(ST(0),na); \ if (items >= 2) /* version supplied as bootstrap arg */ \ Sv = ST(1); \ else { \ --- 43,49 ---- #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ ! char *vn = Nullch, *module = SvPV(ST(0),na); \ if (items >= 2) /* version supplied as bootstrap arg */ \ Sv = ST(1); \ else { \ *************** *** 51,58 **** vn = "VERSION"), FALSE); \ } \ if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \ ! croak("%s object version %s does not match $%s::%s %_", \ ! module, XS_VERSION, module, vn, Sv); \ } STMT_END #else # define XS_VERSION_BOOTCHECK --- 55,64 ---- vn = "VERSION"), FALSE); \ } \ if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \ ! croak("%s object version %s does not match %s%s%s%s %_", \ ! module, XS_VERSION, \ ! vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ ! vn ? vn : "bootstrap parameter", Sv); \ } STMT_END #else # define XS_VERSION_BOOTCHECK diff -c 'perl5.004_04/av.c' 'perl5.004_05/av.c' Index: ./av.c *** ./av.c Mon Oct 6 13:20:06 1997 --- ./av.c Sun Nov 22 10:08:38 1998 *************** *** 25,41 **** if (AvREAL(av)) return; key = AvMAX(av) + 1; ! while (key > AvFILL(av) + 1) AvARRAY(av)[--key] = &sv_undef; while (key) { sv = AvARRAY(av)[--key]; assert(sv); ! if (sv != &sv_undef) (void)SvREFCNT_inc(sv); } key = AvARRAY(av) - AvALLOC(av); while (key) AvALLOC(av)[--key] = &sv_undef; AvREAL_on(av); } --- 25,44 ---- if (AvREAL(av)) return; key = AvMAX(av) + 1; ! while (key > AvFILLp(av) + 1) AvARRAY(av)[--key] = &sv_undef; while (key) { sv = AvARRAY(av)[--key]; assert(sv); ! if (sv != &sv_undef) { ! dTHR; (void)SvREFCNT_inc(sv); + } } key = AvARRAY(av) - AvALLOC(av); while (key) AvALLOC(av)[--key] = &sv_undef; + AvREIFY_off(av); AvREAL_on(av); } *************** *** 44,58 **** AV *av; I32 key; { if (key > AvMAX(av)) { SV** ary; I32 tmp; I32 newmax; if (AvALLOC(av) != AvARRAY(av)) { ! ary = AvALLOC(av) + AvFILL(av) + 1; tmp = AvARRAY(av) - AvALLOC(av); ! Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*); AvMAX(av) += tmp; SvPVX(av) = (char*)AvALLOC(av); if (AvREAL(av)) { --- 47,62 ---- AV *av; I32 key; { + dTHR; /* only necessary if we have to extend stack */ if (key > AvMAX(av)) { SV** ary; I32 tmp; I32 newmax; if (AvALLOC(av) != AvARRAY(av)) { ! ary = AvALLOC(av) + AvFILLp(av) + 1; tmp = AvARRAY(av) - AvALLOC(av); ! Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*); AvMAX(av) += tmp; SvPVX(av) = (char*)AvALLOC(av); if (AvREAL(av)) { *************** *** 134,143 **** if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); ! Sv = sv; ! return &Sv; } } --- 138,148 ---- if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { + static SV *mysv; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); ! mysv = sv; ! return &mysv; } } *************** *** 146,158 **** if (key < 0) return 0; } ! else if (key > AvFILL(av)) { if (!lval) return 0; ! if (AvREALISH(av)) ! sv = NEWSV(5,0); ! else ! sv = sv_newmortal(); return av_store(av,key,sv); } if (AvARRAY(av)[key] == &sv_undef) { --- 151,160 ---- if (key < 0) return 0; } ! else if (key > AvFILLp(av)) { if (!lval) return 0; ! sv = NEWSV(5,0); return av_store(av,key,sv); } if (AvARRAY(av)[key] == &sv_undef) { *************** *** 198,203 **** --- 200,206 ---- if (key < 0) return 0; } + if (SvREADONLY(av) && key >= AvFILL(av)) croak(no_modify); if (!AvREAL(av) && AvREIFY(av)) *************** *** 205,219 **** if (key > AvMAX(av)) av_extend(av,key); ary = AvARRAY(av); ! if (AvFILL(av) < key) { if (!AvREAL(av)) { if (av == curstack && key > stack_sp - stack_base) stack_sp = stack_base + key; /* XPUSH in disguise */ do ! ary[++AvFILL(av)] = &sv_undef; ! while (AvFILL(av) < key); } ! AvFILL(av) = key; } else if (AvREAL(av)) SvREFCNT_dec(ary[key]); --- 208,223 ---- if (key > AvMAX(av)) av_extend(av,key); ary = AvARRAY(av); ! if (AvFILLp(av) < key) { if (!AvREAL(av)) { + dTHR; if (av == curstack && key > stack_sp - stack_base) stack_sp = stack_base + key; /* XPUSH in disguise */ do ! ary[++AvFILLp(av)] = &sv_undef; ! while (AvFILLp(av) < key); } ! AvFILLp(av) = key; } else if (AvREAL(av)) SvREFCNT_dec(ary[key]); *************** *** 238,244 **** AvREAL_on(av); AvALLOC(av) = 0; SvPVX(av) = 0; ! AvMAX(av) = AvFILL(av) = -1; return av; } --- 242,248 ---- AvREAL_on(av); AvALLOC(av) = 0; SvPVX(av) = 0; ! AvMAX(av) = AvFILLp(av) = -1; return av; } *************** *** 258,264 **** New(4,ary,size,SV*); AvALLOC(av) = ary; SvPVX(av) = (char*)ary; ! AvFILL(av) = size - 1; AvMAX(av) = size - 1; for (i = 0; i < size; i++) { assert (*strp); --- 262,268 ---- New(4,ary,size,SV*); AvALLOC(av) = ary; SvPVX(av) = (char*)ary; ! AvFILLp(av) = size - 1; AvMAX(av) = size - 1; for (i = 0; i < size; i++) { assert (*strp); *************** *** 285,291 **** Copy(strp,ary,size,SV*); AvFLAGS(av) = AVf_REIFY; SvPVX(av) = (char*)ary; ! AvFILL(av) = size - 1; AvMAX(av) = size - 1; while (size--) { assert (*strp); --- 289,295 ---- Copy(strp,ary,size,SV*); AvFLAGS(av) = AVf_REIFY; SvPVX(av) = (char*)ary; ! AvFILLp(av) = size - 1; AvMAX(av) = size - 1; while (size--) { assert (*strp); *************** *** 313,319 **** if (AvREAL(av)) { ary = AvARRAY(av); ! key = AvFILL(av) + 1; while (key) { SvREFCNT_dec(ary[--key]); ary[key] = &sv_undef; --- 317,323 ---- if (AvREAL(av)) { ary = AvARRAY(av); ! key = AvFILLp(av) + 1; while (key) { SvREFCNT_dec(ary[--key]); ary[key] = &sv_undef; *************** *** 323,329 **** AvMAX(av) += key; SvPVX(av) = (char*)AvALLOC(av); } ! AvFILL(av) = -1; if (SvRMAGICAL(av)) mg_clear((SV*)av); --- 327,333 ---- AvMAX(av) += key; SvPVX(av) = (char*)AvALLOC(av); } ! AvFILLp(av) = -1; if (SvRMAGICAL(av)) mg_clear((SV*)av); *************** *** 339,352 **** return; /*SUPPRESS 560*/ if (AvREAL(av)) { ! key = AvFILL(av) + 1; while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } Safefree(AvALLOC(av)); AvALLOC(av) = 0; SvPVX(av) = 0; ! AvMAX(av) = AvFILL(av) = -1; if (AvARYLEN(av)) { SvREFCNT_dec(AvARYLEN(av)); AvARYLEN(av) = 0; --- 343,356 ---- return; /*SUPPRESS 560*/ if (AvREAL(av)) { ! key = AvFILLp(av) + 1; while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } Safefree(AvALLOC(av)); AvALLOC(av) = 0; SvPVX(av) = 0; ! AvMAX(av) = AvFILLp(av) = -1; if (AvARYLEN(av)) { SvREFCNT_dec(AvARYLEN(av)); AvARYLEN(av) = 0; *************** *** 386,392 **** register I32 num; { register I32 i; ! register SV **sstr,**dstr; if (!av || num <= 0) return; --- 390,396 ---- register I32 num; { register I32 i; ! register SV **ary; if (!av || num <= 0) return; *************** *** 401,425 **** num -= i; AvMAX(av) += i; ! AvFILL(av) += i; SvPVX(av) = (char*)(AvARRAY(av) - i); } if (num) { ! av_extend(av,AvFILL(av)+num); ! AvFILL(av) += num; ! dstr = AvARRAY(av) + AvFILL(av); ! sstr = dstr - num; ! #ifdef BUGGY_MSC5 ! # pragma loop_opt(off) /* don't loop-optimize the following code */ ! #endif /* BUGGY_MSC5 */ ! for (i = AvFILL(av) - num; i >= 0; --i) { ! *dstr-- = *sstr--; ! #ifdef BUGGY_MSC5 ! # pragma loop_opt() /* loop-optimization back to command-line setting */ ! #endif /* BUGGY_MSC5 */ ! } ! while (num) ! AvARRAY(av)[--num] = &sv_undef; } } --- 405,422 ---- num -= i; AvMAX(av) += i; ! AvFILLp(av) += i; SvPVX(av) = (char*)(AvARRAY(av) - i); } if (num) { ! i = AvFILLp(av); ! av_extend(av, i + num); ! AvFILLp(av) += num; ! ary = AvARRAY(av); ! Move(ary, ary + num, i + 1, SV*); ! do { ! ary[--num] = &sv_undef; ! } while (num); } } *************** *** 438,444 **** *AvARRAY(av) = &sv_undef; SvPVX(av) = (char*)(AvARRAY(av) + 1); AvMAX(av)--; ! AvFILL(av)--; if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; --- 435,441 ---- *AvARRAY(av) = &sv_undef; SvPVX(av) = (char*)(AvARRAY(av) + 1); AvMAX(av)--; ! AvFILLp(av)--; if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; *************** *** 461,467 **** if (fill < 0) fill = -1; if (fill <= AvMAX(av)) { ! I32 key = AvFILL(av); SV** ary = AvARRAY(av); if (AvREAL(av)) { --- 458,464 ---- if (fill < 0) fill = -1; if (fill <= AvMAX(av)) { ! I32 key = AvFILLp(av); SV** ary = AvARRAY(av); if (AvREAL(av)) { *************** *** 475,481 **** ary[++key] = &sv_undef; } ! AvFILL(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } --- 472,478 ---- ary[++key] = &sv_undef; } ! AvFILLp(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } diff -c 'perl5.004_04/av.h' 'perl5.004_05/av.h' Index: ./av.h *** ./av.h Thu Mar 6 10:46:34 1997 --- ./av.h Tue May 19 17:26:03 1998 *************** *** 1,6 **** /* av.h * ! * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. --- 1,6 ---- /* av.h * ! * Copyright (c) 1991-1998, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. *************** *** 9,16 **** struct xpvav { char* xav_array; /* pointer to first array element */ ! SSize_t xav_fill; ! SSize_t xav_max; IV xof_off; /* ptr is incremented by offset */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ --- 9,16 ---- struct xpvav { char* xav_array; /* pointer to first array element */ ! SSize_t xav_fill; /* Index of last element present */ ! SSize_t xav_max; /* Number of elements for which array has space */ IV xof_off; /* ptr is incremented by offset */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ diff -c /dev/null 'perl5.004_05/beos/nm.c' Index: ./beos/nm.c *** ./beos/nm.c Wed Dec 31 19:00:00 1969 --- ./beos/nm.c Fri May 15 11:28:45 1998 *************** *** 0 **** --- 1,53 ---- + /* nm.c - a feeble shared-lib library parser + * Copyright 1997, 1998 Tom Spindler + * This software is covered under perl's Artistic license. + */ + + /* $Id: nm.c,v 1.1 1998/02/16 03:51:26 dogcow Exp $ */ + + #include + #include + #include + #include + #include + #include + + main(int argc, char **argv) { + char *path, *symname; + image_id img; + int32 n = 0; + volatile int32 symnamelen, symtype; + void *symloc; + + if (argc != 2) { printf("more args, bozo\n"); exit(1); } + + path = (void *) malloc((size_t) 2048); + symname = (void *) malloc((size_t) 2048); + + if (!getcwd(path, 2048)) { printf("aiee!\n"); exit(1); } + if (!strcat(path, "/")) {printf("naah.\n"); exit (1); } + /*printf("%s\n",path);*/ + + if ('/' != argv[1][0]) { + if (!strcat(path, argv[1])) { printf("feh1\n"); exit(1); } + } else { + if (!strcpy(path, argv[1])) { printf("gah!\n"); exit(1); } + } + /*printf("%s\n",path);*/ + + img = load_add_on(path); + if (B_ERROR == img) {printf("Couldn't load_add_on() %s.\n", path); exit(2); } + + symnamelen=2047; + + while (B_BAD_INDEX != get_nth_image_symbol(img, n++, symname, &symnamelen, + &symtype, &symloc)) { + printf("%s |%s |GLOB %Lx | \n", symname, + ((B_SYMBOL_TYPE_ANY == symtype) || (B_SYMBOL_TYPE_TEXT == symtype)) ? "FUNC" : "VAR ", symloc); + symnamelen=2047; + } + printf("number of symbols: %d\n", n); + if (B_ERROR == unload_add_on(img)) {printf("err while closing.\n"); exit(3); } + free(path); + return(0); + } diff -c 'perl5.004_04/cflags.SH' 'perl5.004_05/cflags.SH' Index: ./cflags.SH *** ./cflags.SH Mon Aug 19 13:08:07 1996 --- ./cflags.SH Tue May 19 17:26:03 1998 *************** *** 123,128 **** --- 123,129 ---- optimize="$optdebug" fi + : Can we perhaps use $ansi2knr here echo "$cc -c -DPERL_CORE $ccflags $optimize $perltype $large $split" eval "$also "'"$cc -DPERL_CORE -c $ccflags $optimize $perltype $large $split"' diff -c 'perl5.004_04/config_H' 'perl5.004_05/config_H' Index: ./config_H Prereq: 3.0.1.4 *** ./config_H Tue Apr 8 02:40:42 1997 --- ./config_H Wed Apr 22 07:49:24 1998 *************** *** 329,334 **** --- 329,340 ---- */ #define HAS_GETPRIORITY /**/ + /* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ + /*#define HAS_GNULIBC / **/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network diff -c 'perl5.004_04/config_h.SH' 'perl5.004_05/config_h.SH' Index: ./config_h.SH Prereq: 3.0.1.4 *** ./config_h.SH Thu May 8 12:57:47 1997 --- ./config_h.SH Tue Apr 6 15:38:11 1999 *************** *** 360,365 **** --- 360,371 ---- */ #$d_getprior HAS_GETPRIORITY /**/ + /* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ + #$d_gnulibc HAS_GNULIBC /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network *************** *** 617,622 **** --- 623,652 ---- */ #$d_sem HAS_SEM /**/ + /* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun + * is defined in . If not, the user code probably + * needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ + #$d_union_semun HAS_UNION_SEMUN /**/ + + /* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ + #$d_semctl_semun USE_SEMCTL_SEMUN /**/ + + /* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ + #$d_semctl_semid_ds USE_SEMCTL_SEMID_DS /**/ + /* HAS_SETEGID: * This symbol, if defined, indicates that the setegid routine is available * to change the effective gid of the current program. *************** *** 1145,1150 **** --- 1175,1184 ---- * This symbol, if defined, indicates to the C program that struct passwd * contains pw_comment. */ + /* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ #$i_pwd I_PWD /**/ #$d_pwquota PWQUOTA /**/ #$d_pwage PWAGE /**/ *************** *** 1152,1157 **** --- 1186,1192 ---- #$d_pwclass PWCLASS /**/ #$d_pwexpire PWEXPIRE /**/ #$d_pwcomment PWCOMMENT /**/ + #$d_pwgecos PWGECOS /**/ /* I_STDDEF: * This symbol, if defined, indicates that exists and should *************** *** 1225,1230 **** --- 1260,1283 ---- */ #$i_systypes I_SYS_TYPES /**/ + /* I_MNTENT: + * This symbol, if defined, indicates that exists and + * should be included. + */ + #$i_mntent I_MNTENT /**/ + + /* I_SYS_MOUNT: + * This symbol, if defined, indicates that exists and + * should be included. + */ + #$i_sysmount I_SYS_MOUNT /**/ + + /* I_SYS_STATVFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ + #$i_sysstatvfs I_SYS_STATVFS /**/ + /* I_SYS_UN: * This symbol, if defined, indicates to the C program that it should * include to get UNIX domain socket definitions. *************** *** 1587,1592 **** --- 1640,1676 ---- * be used. */ #$d_sfio USE_SFIO /**/ + + /* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to do stat filesystems of file descriptors. + */ + /* HAS_STRUCT_STATFS_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem holding the file. + * This kind of struct statfs is coming from sys/mount.h (BSD) + * and not from sys/statfs.h (SYSV). + */ + #$d_fstatfs HAS_FSTATFS /**/ + #$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/ + + /* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to do stat filesystems of file descriptors. + */ + #$d_fstatvfs HAS_FSTATVFS /**/ + + /* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to enumerate mounted filesystems. + */ + /* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to check options on mounted filesystems. + */ + #$d_getmntent HAS_GETMNTENT /**/ + #$d_hasmntopt HAS_HASMNTOPT /**/ /* Sigjmp_buf: * This is the buffer type to be used with Sigsetjmp and Siglongjmp. diff -c 'perl5.004_04/cop.h' 'perl5.004_05/cop.h' Index: ./cop.h *** ./cop.h Fri May 9 20:23:51 1997 --- ./cop.h Sun Nov 22 10:08:38 1998 *************** *** 187,200 **** pm = cx->blk_oldpm, \ gimme = cx->blk_gimme; \ DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \ ! (long)cxstack_ix+1,block_type[cx->cx_type]); ) /* Continue a block elsewhere (NEXT and REDO). */ #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ stack_sp = stack_base + cx->blk_oldsp, \ markstack_ptr = markstack + cx->blk_oldmarksp, \ scopestack_ix = cx->blk_oldscopesp, \ ! retstack_ix = cx->blk_oldretsp /* substitution context */ struct subst { --- 187,201 ---- pm = cx->blk_oldpm, \ gimme = cx->blk_gimme; \ DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \ ! (long)cxstack_ix+1,block_type[CxTYPE(cx)]); ) /* Continue a block elsewhere (NEXT and REDO). */ #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ stack_sp = stack_base + cx->blk_oldsp, \ markstack_ptr = markstack + cx->blk_oldmarksp, \ scopestack_ix = cx->blk_oldscopesp, \ ! retstack_ix = cx->blk_oldretsp, \ ! curpm = cx->blk_oldpm /* substitution context */ struct subst { *************** *** 250,261 **** rxres_free(&cx->sb_rxres) struct context { ! I32 cx_type; /* what kind of context this is */ union { struct block cx_blk; struct subst cx_subst; } cx_u; }; #define CXt_NULL 0 #define CXt_SUB 1 #define CXt_EVAL 2 --- 251,264 ---- rxres_free(&cx->sb_rxres) struct context { ! U32 cx_type; /* what kind of context this is */ union { struct block cx_blk; struct subst cx_subst; } cx_u; }; + + #define CXTYPEMASK 0xff #define CXt_NULL 0 #define CXt_SUB 1 #define CXt_EVAL 2 *************** *** 263,268 **** --- 266,277 ---- #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 */ *************** *** 275,277 **** --- 284,287 ---- #define G_EVAL 4 /* Assume eval {} around subroutine call. */ #define G_NOARGS 8 /* Don't construct a @_ array. */ #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ + #define G_NODEBUG 32 /* Disable debugging at toplevel. */ diff -c 'perl5.004_04/cygwin32/perlgcc' 'perl5.004_05/cygwin32/perlgcc' Index: ./cygwin32/perlgcc *** ./cygwin32/perlgcc Fri Apr 4 17:33:10 1997 --- ./cygwin32/perlgcc Tue May 19 17:26:03 1998 *************** *** 30,50 **** # make exports file my $command = "echo EXPORTS > perl.def"; print "$command\n"; ! system($command); $command ="nm $libstring | grep '^........ [TCD] _'| grep -v _impure_ptr | sed 's/[^_]*_//' >> perl.def"; print "$command\n"; ! system($command); # Build the perl.a lib to link to: $command ="dlltool --as=as --dllname perl.exe --def perl.def --output-lib perl.a"; print "$command\n"; ! system($command); # change name of export lib to libperlexp so that is can be understood by ld2/perlld $command ="mv perl.a libperlexp.a"; print "$command\n"; ! system($command); # get the full path name of a few libs: my $crt0 = `gcc -print-file-name=crt0.o`; --- 30,50 ---- # make exports file my $command = "echo EXPORTS > perl.def"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; $command ="nm $libstring | grep '^........ [TCD] _'| grep -v _impure_ptr | sed 's/[^_]*_//' >> perl.def"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; # Build the perl.a lib to link to: $command ="dlltool --as=as --dllname perl.exe --def perl.def --output-lib perl.a"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; # change name of export lib to libperlexp so that is can be understood by ld2/perlld $command ="mv perl.a libperlexp.a"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; # get the full path name of a few libs: my $crt0 = `gcc -print-file-name=crt0.o`; *************** *** 53,77 **** chomp $libdir; $libdir =~ s/libcygwin\.a//g; # Link exe: $command = "ld --base-file perl.base -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; ! system($command); $command = "dlltool --as=as --dllname perl.exe --def perl.def --base-file perl.base --output-exp perl.exp"; print "$command\n"; ! system($command); $command = "ld --base-file perl.base perl.exp -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; ! system($command); $command = "dlltool --as=as --dllname perl.exe --def perl.def --base-file perl.base --output-exp perl.exp"; print "$command\n"; ! system($command); $command = "ld perl.exp -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; ! system($command); print "perlgcc: Completed\n"; --- 53,84 ---- chomp $libdir; $libdir =~ s/libcygwin\.a//g; + # when $crt0 and $libdir get used in the system calls below, the \'s + # from the gcc -print-file-name get used to create special characters, + # such as \n, \t. Replace the \'s with /'s so that this does not + # happen: + $crt0 =~ s:\\:/:g; + $libdir =~ s:\\:/:g; + # Link exe: $command = "ld --base-file perl.base -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; $command = "dlltool --as=as --dllname perl.exe --def perl.def --base-file perl.base --output-exp perl.exp"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; $command = "ld --base-file perl.base perl.exp -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; $command = "dlltool --as=as --dllname perl.exe --def perl.def --base-file perl.base --output-exp perl.exp"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; $command = "ld perl.exp -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; ! system($command) == 0 or die "system() failed.\n"; print "perlgcc: Completed\n"; diff -c 'perl5.004_04/cygwin32/perlld' 'perl5.004_05/cygwin32/perlld' Index: ./cygwin32/perlld *** ./cygwin32/perlld Fri Apr 4 17:34:09 1997 --- ./cygwin32/perlld Tue May 19 17:26:03 1998 *************** *** 47,100 **** writeInit(); $command = "gcc -c $fixup.c\n"; print $command; ! system($command); $command = "gcc -c $init.cc\n"; print $command; ! system($command); $command = "echo EXPORTS > $libname.def\n"; print $command; ! system($command); $command = "nm ".join(" ",@objs)." $init.o $fixup.o | grep '^........ [TCD] _' | sed 's/[^_]*_//' >> $libname.def\n"; print $command; ! system($command); $command = "ld --base-file $libname.base --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o "; $command .= join(" ",@flags)." -e _dll_entry\@12 \n"; print $command; ! system($command); $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n"; print $command; ! system($command); $command = "ld --base-file $libname.base $libname.exp --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o "; $command .= join(" ",@flags)." -e _dll_entry\@12 \n"; print $command; ! system($command); $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n"; print $command; ! system($command); $command = "ld $libname.exp --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o "; $command .= join(" ",@flags)." -e _dll_entry\@12 \n"; print $command; ! system($command); print "Build the import lib\n"; $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --output-lib $libname.a\n"; print $command; ! system($command); # if there was originally a path, copy the dll and a to that location: if($path && $path ne "./" && $path."\n" ne "`pwd`"){ $command = "mv $libname.dll $path".$libname.".dll\n"; print $command; ! system($command); $command = "mv $libname.a $path".$libname.".a\n"; print $command; ! system($command); } --- 47,100 ---- writeInit(); $command = "gcc -c $fixup.c\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "gcc -c $init.cc\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "echo EXPORTS > $libname.def\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "nm ".join(" ",@objs)." $init.o $fixup.o | grep '^........ [TCD] _' | sed 's/[^_]*_//' >> $libname.def\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "ld --base-file $libname.base --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o "; $command .= join(" ",@flags)." -e _dll_entry\@12 \n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "ld --base-file $libname.base $libname.exp --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o "; $command .= join(" ",@flags)." -e _dll_entry\@12 \n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "ld $libname.exp --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o "; $command .= join(" ",@flags)." -e _dll_entry\@12 \n"; print $command; ! system($command) == 0 or die "system() failed.\n"; print "Build the import lib\n"; $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --output-lib $libname.a\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; # if there was originally a path, copy the dll and a to that location: if($path && $path ne "./" && $path."\n" ne "`pwd`"){ $command = "mv $libname.dll $path".$libname.".dll\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; $command = "mv $libname.a $path".$libname.".a\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; } *************** *** 102,108 **** else{ # no special processing, just call ld $command = "ld $args\n"; print $command; ! system($command); } #--------------------------------------------------------------------------- --- 102,108 ---- else{ # no special processing, just call ld $command = "ld $args\n"; print $command; ! system($command) == 0 or die "system() failed.\n"; } #--------------------------------------------------------------------------- diff -c 'perl5.004_04/deb.c' 'perl5.004_05/deb.c' Index: ./deb.c *** ./deb.c Thu Mar 6 10:46:34 1997 --- ./deb.c Mon Jul 6 19:03:16 1998 *************** *** 27,32 **** --- 27,33 ---- deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) char *pat; { + dTHR; register I32 i; GV* gv = curcop->cop_filegv; *************** *** 51,56 **** --- 52,58 ---- va_dcl # endif { + dTHR; va_list args; register I32 i; GV* gv = curcop->cop_filegv; *************** *** 82,100 **** I32 debstackptrs() { PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)curstack, (unsigned long)stack_base, (long)*markstack_ptr, (long)(stack_sp-stack_base), (long)(stack_max-stack_base)); PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)mainstack, (unsigned long)AvARRAY(curstack), ! (long)mainstack, (long)AvFILL(curstack), (long)AvMAX(curstack)); return 0; } I32 debstack() { I32 top = stack_sp - stack_base; register I32 i = top - 30; I32 *markscan = markstack; --- 84,104 ---- I32 debstackptrs() { + dTHR; PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)curstack, (unsigned long)stack_base, (long)*markstack_ptr, (long)(stack_sp-stack_base), (long)(stack_max-stack_base)); PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)mainstack, (unsigned long)AvARRAY(curstack), ! (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack)); return 0; } I32 debstack() { + dTHR; I32 top = stack_sp - stack_base; register I32 i = top - 30; I32 *markscan = markstack; diff -c 'perl5.004_04/doio.c' 'perl5.004_05/doio.c' Index: ./doio.c *** ./doio.c Mon Jul 28 21:08:11 1997 --- ./doio.c Tue Apr 13 00:21:23 1999 *************** *** 34,51 **** #endif #ifdef I_UTIME ! # ifdef _MSC_VER # include # else # include # endif #endif #ifdef I_FCNTL #include #endif #ifdef I_SYS_FILE #include #endif #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include --- 34,57 ---- #endif #ifdef I_UTIME ! # if defined(_MSC_VER) || defined(__MINGW32__) # include # else # include # endif #endif + #ifdef I_FCNTL #include #endif #ifdef I_SYS_FILE #include #endif + #ifdef O_EXCL + # define OPEN_EXCL O_EXCL + #else + # define OPEN_EXCL 0 + #endif #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include *************** *** 92,97 **** --- 98,104 ---- PerlIO *fp; int fd; int result; + bool was_fdopen = FALSE; forkprocess = 1; /* assume true if no fork */ *************** *** 170,177 **** if (strNE(name,"-")) TAINT_ENV(); TAINT_PROPER("piped open"); ! if (dowarn && name[strlen(name)-1] == '|') ! warn("Can't do bidirectional pipe"); fp = my_popen(name,"w"); writing = 1; } --- 177,187 ---- if (strNE(name,"-")) TAINT_ENV(); TAINT_PROPER("piped open"); ! if (name[strlen(name)-1] == '|') { ! name[strlen(name)-1] = '\0' ; ! if (dowarn) ! warn("Can't do bidirectional pipe"); ! } fp = my_popen(name,"w"); writing = 1; } *************** *** 221,226 **** --- 231,238 ---- } if (dodup) fd = dup(fd); + else + was_fdopen = TRUE; if (!(fp = PerlIO_fdopen(fd,mode))) { if (dodup) close(fd); *************** *** 252,258 **** else fp = PerlIO_open(name,mode); } ! else if (name[len-1] == '|') { name[--len] = '\0'; while (len && isSPACE(name[len-1])) name[--len] = '\0'; --- 264,270 ---- else fp = PerlIO_open(name,mode); } ! else if (len > 1 && name[len-1] == '|') { name[--len] = '\0'; while (len && isSPACE(name[len-1])) name[--len] = '\0'; *************** *** 283,288 **** --- 295,301 ---- } if (IoTYPE(io) && IoTYPE(io) != '|' && IoTYPE(io) != '-') { + dTHR; if (Fstat(PerlIO_fileno(fp),&statbuf) < 0) { (void)PerlIO_close(fp); goto say_false; *************** *** 328,345 **** sv = *av_fetch(fdpid,fd,TRUE); (void)SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; ! PerlIO_close(fp); } fp = saveifp; PerlIO_clearerr(fp); } #if defined(HAS_FCNTL) && defined(F_SETFD) ! fd = PerlIO_fileno(fp); ! fcntl(fd,F_SETFD,fd > maxsysfd); #endif IoIFP(io) = fp; if (writing) { if (IoTYPE(io) == 's' || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) { if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) { --- 341,364 ---- sv = *av_fetch(fdpid,fd,TRUE); (void)SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; ! if (!was_fdopen) ! PerlIO_close(fp); } fp = saveifp; PerlIO_clearerr(fp); } #if defined(HAS_FCNTL) && defined(F_SETFD) ! { ! int save_errno = errno; ! fd = PerlIO_fileno(fp); ! fcntl(fd,F_SETFD,fd > maxsysfd); /* can change errno */ ! errno = save_errno; ! } #endif IoIFP(io) = fp; if (writing) { + dTHR; if (IoTYPE(io) == 's' || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) { if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) { *************** *** 384,399 **** } filemode = 0; while (av_len(GvAV(gv)) >= 0) { ! STRLEN len; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); ! oldname = SvPVx(GvSV(gv), len); ! if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) { if (inplace) { TAINT_PROPER("inplace open"); ! if (strEQ(oldname,"-")) { setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO)); return IoIFP(GvIOp(gv)); } --- 403,419 ---- } filemode = 0; while (av_len(GvAV(gv)) >= 0) { ! dTHR; ! STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); ! oldname = SvPVx(GvSV(gv), oldlen); ! if (do_open(gv,oldname,oldlen,inplace!=0,0,0,Nullfp)) { if (inplace) { TAINT_PROPER("inplace open"); ! if (oldlen == 1 && *oldname == '-') { setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO)); return IoIFP(GvIOp(gv)); } *************** *** 438,444 **** do_close(gv,FALSE); (void)unlink(SvPVX(sv)); (void)rename(oldname,SvPVX(sv)); ! do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp); #endif /* DOSISH */ #else (void)UNLINK(SvPVX(sv)); --- 458,464 ---- do_close(gv,FALSE); (void)unlink(SvPVX(sv)); (void)rename(oldname,SvPVX(sv)); ! do_open(gv,SvPVX(sv),SvCUR(sv),inplace!=0,0,0,Nullfp); #endif /* DOSISH */ #else (void)UNLINK(SvPVX(sv)); *************** *** 455,462 **** #if !defined(DOSISH) && !defined(AMIGAOS) # ifndef VMS /* Don't delete; use automatic file versioning */ if (UNLINK(oldname) < 0) { ! warn("Can't rename %s to %s: %s, skipping file", ! oldname, SvPVX(sv), Strerror(errno) ); do_close(gv,FALSE); continue; } --- 475,482 ---- #if !defined(DOSISH) && !defined(AMIGAOS) # ifndef VMS /* Don't delete; use automatic file versioning */ if (UNLINK(oldname) < 0) { ! warn("Can't remove %s: %s, skipping file", ! oldname, Strerror(errno) ); do_close(gv,FALSE); continue; } *************** *** 466,475 **** #endif } ! sv_setpvn(sv,">",1); ! sv_catpv(sv,oldname); SETERRNO(0,0); /* in case sprintf set errno */ ! if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) { warn("Can't do inplace edit on %s: %s", oldname, Strerror(errno) ); do_close(gv,FALSE); --- 486,496 ---- #endif } ! sv_setpvn(sv,">",!inplace); ! sv_catpvn(sv,oldname,oldlen); SETERRNO(0,0); /* in case sprintf set errno */ ! if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),inplace!=0, ! O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) { warn("Can't do inplace edit on %s: %s", oldname, Strerror(errno) ); do_close(gv,FALSE); *************** *** 499,505 **** return IoIFP(GvIOp(gv)); } else ! PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",SvPV(sv, na), Strerror(errno)); } if (inplace) { (void)do_close(argvoutgv,FALSE); --- 520,527 ---- return IoIFP(GvIOp(gv)); } else ! PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n", ! SvPV(sv, na), Strerror(errno)); } if (inplace) { (void)do_close(argvoutgv,FALSE); *************** *** 572,584 **** if (!gv) gv = argvgv; if (!gv || SvTYPE(gv) != SVt_PVGV) { ! SETERRNO(EBADF,SS$_IVCHAN); return FALSE; } io = GvIO(gv); if (!io) { /* never opened */ ! if (dowarn && not_implicit) ! warn("Close on unopened file <%s>",GvENAME(gv)); return FALSE; } retval = io_close(io); --- 594,610 ---- if (!gv) gv = argvgv; if (!gv || SvTYPE(gv) != SVt_PVGV) { ! if (not_implicit) ! SETERRNO(EBADF,SS$_IVCHAN); return FALSE; } io = GvIO(gv); if (!io) { /* never opened */ ! if (not_implicit) { ! if (dowarn) ! warn("Close on unopened file <%s>",GvENAME(gv)); ! SETERRNO(EBADF,SS$_IVCHAN); ! } return FALSE; } retval = io_close(io); *************** *** 616,621 **** --- 642,650 ---- } IoOFP(io) = IoIFP(io) = Nullfp; } + else { + SETERRNO(EBADF,SS$_IVCHAN); + } return retval; } *************** *** 624,629 **** --- 653,659 ---- do_eof(gv) GV *gv; { + dTHR; register IO *io; int ch; *************** *** 717,722 **** --- 747,795 ---- return -1L; } + int + do_binmode(fp, iotype, flag) + PerlIO *fp; + int iotype; + int flag; + { + if (flag != TRUE) + croak("panic: unsetting binmode"); /* Not implemented yet */ + #ifdef DOSISH + #ifdef atarist + if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) + return 1; + else + return 0; + #else + if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) { + #if defined(WIN32) && defined(__BORLANDC__) + /* The translation mode of the stream is maintained independent + * of the translation mode of the fd in the Borland RTL (heavy + * digging through their runtime sources reveal). User has to + * set the mode explicitly for the stream (though they don't + * document this anywhere). GSAR 97-5-24 + */ + PerlIO_seek(fp,0L,0); + ((FILE*)fp)->flags |= _F_BIN; + #endif + return 1; + } + else + return 0; + #endif + #else + #if defined(USEMYBINMODE) + if (my_binmode(fp,iotype) != NULL) + return 1; + else + return 0; + #else + return 1; + #endif + #endif + } + #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) /* code courtesy of William Kucharski */ #define HAS_CHSIZE *************** *** 818,829 **** my_stat(ARGS) dARGS { ! dSP; IO *io; GV* tmpgv; if (op->op_flags & OPf_REF) { ! EXTEND(sp,1); tmpgv = cGVOP->op_gv; do_fstat: io = GvIO(tmpgv); --- 891,902 ---- my_stat(ARGS) dARGS { ! djSP; IO *io; GV* tmpgv; if (op->op_flags & OPf_REF) { ! EXTEND(SP,1); tmpgv = cGVOP->op_gv; do_fstat: io = GvIO(tmpgv); *************** *** 846,851 **** --- 919,925 ---- } else { SV* sv = POPs; + char *s; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; *************** *** 856,866 **** goto do_fstat; } statgv = Nullgv; ! sv_setpv(statname,SvPV(sv, na)); laststype = OP_STAT; ! laststatval = Stat(SvPV(sv, na),&statcache); ! if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n')) warn(warn_nl, "stat"); return laststatval; } --- 930,941 ---- goto do_fstat; } + s = SvPV(sv, na); statgv = Nullgv; ! sv_setpv(statname, s); laststype = OP_STAT; ! laststatval = Stat(s, &statcache); ! if (laststatval < 0 && dowarn && strchr(s, '\n')) warn(warn_nl, "stat"); return laststatval; } *************** *** 870,879 **** my_lstat(ARGS) dARGS { ! dSP; SV *sv; if (op->op_flags & OPf_REF) { ! EXTEND(sp,1); if (cGVOP->op_gv == defgv) { if (laststype != OP_LSTAT) croak("The stat preceding -l _ wasn't an lstat"); --- 945,954 ---- my_lstat(ARGS) dARGS { ! djSP; SV *sv; if (op->op_flags & OPf_REF) { ! EXTEND(SP,1); if (cGVOP->op_gv == defgv) { if (laststype != OP_LSTAT) croak("The stat preceding -l _ wasn't an lstat"); *************** *** 907,912 **** --- 982,988 ---- char *tmps; if (sp > mark) { + dTHR; New(401,Argv, sp - mark + 1, char*); a = Argv; while (++mark <= sp) { *************** *** 1041,1052 **** --- 1117,1134 ---- register SV **mark; register SV **sp; { + dTHR; register I32 val; register I32 val2; register I32 tot = 0; + char *what; char *s; SV **oldmark = mark; + #define APPLY_TAINT_PROPER() \ + if (!tainted) {} else { TAINT_PROPER(what); } + + /* This is a first heuristic; it doesn't catch tainting magic. */ if (tainting) { while (++mark <= sp) { if (SvTAINTED(*mark)) { *************** *** 1058,1082 **** } switch (type) { case OP_CHMOD: ! TAINT_PROPER("chmod"); if (++mark <= sp) { - tot = sp - mark; val = SvIVx(*mark); while (++mark <= sp) { ! if (chmod(SvPVx(*mark, na),val)) tot--; } } break; #ifdef HAS_CHOWN case OP_CHOWN: ! TAINT_PROPER("chown"); if (sp - mark > 2) { val = SvIVx(*++mark); val2 = SvIVx(*++mark); tot = sp - mark; while (++mark <= sp) { ! if (chown(SvPVx(*mark, na),val,val2)) tot--; } } --- 1140,1172 ---- } switch (type) { case OP_CHMOD: ! what = "chmod"; ! APPLY_TAINT_PROPER(); if (++mark <= sp) { val = SvIVx(*mark); + APPLY_TAINT_PROPER(); + tot = sp - mark; while (++mark <= sp) { ! char *name = SvPVx(*mark, na); ! APPLY_TAINT_PROPER(); ! if (chmod(name, val)) tot--; } } break; #ifdef HAS_CHOWN case OP_CHOWN: ! what = "chown"; ! APPLY_TAINT_PROPER(); if (sp - mark > 2) { val = SvIVx(*++mark); val2 = SvIVx(*++mark); + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { ! char *name = SvPVx(*mark, na); ! APPLY_TAINT_PROPER(); ! if (chown(name, val, val2)) tot--; } } *************** *** 1084,1094 **** #endif #ifdef HAS_KILL case OP_KILL: ! TAINT_PROPER("kill"); if (mark == sp) break; s = SvPVx(*++mark, na); - tot = sp - mark; if (isUPPER(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; --- 1174,1184 ---- #endif #ifdef HAS_KILL case OP_KILL: ! what = "kill"; ! APPLY_TAINT_PROPER(); if (mark == sp) break; s = SvPVx(*++mark, na); if (isUPPER(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; *************** *** 1097,1102 **** --- 1187,1194 ---- } else val = SvIVx(*mark); + APPLY_TAINT_PROPER(); + tot = sp - mark; #ifdef VMS /* kill() doesn't do process groups (job trees?) under VMS */ if (val < 0) val = -val; *************** *** 1109,1114 **** --- 1201,1207 ---- while (++mark <= sp) { I32 proc = SvIVx(*mark); register unsigned long int __vmssts; + APPLY_TAINT_PROPER(); if (!((__vmssts = sys$delprc(&proc,0)) & 1)) { tot--; switch (__vmssts) { *************** *** 1131,1136 **** --- 1224,1230 ---- val = -val; while (++mark <= sp) { I32 proc = SvIVx(*mark); + APPLY_TAINT_PROPER(); #ifdef HAS_KILLPG if (killpg(proc,val)) /* BSD */ #else *************** *** 1141,1157 **** } else { while (++mark <= sp) { ! if (kill(SvIVx(*mark),val)) tot--; } } break; #endif case OP_UNLINK: ! TAINT_PROPER("unlink"); tot = sp - mark; while (++mark <= sp) { s = SvPVx(*mark, na); if (euid || unsafe) { if (UNLINK(s)) tot--; --- 1235,1255 ---- } else { while (++mark <= sp) { ! I32 proc = SvIVx(*mark); ! APPLY_TAINT_PROPER(); ! if (kill(proc, val)) tot--; } } break; #endif case OP_UNLINK: ! what = "unlink"; ! APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { s = SvPVx(*mark, na); + APPLY_TAINT_PROPER(); if (euid || unsafe) { if (UNLINK(s)) tot--; *************** *** 1172,1178 **** break; #ifdef HAS_UTIME case OP_UTIME: ! TAINT_PROPER("utime"); if (sp - mark > 2) { #if defined(I_UTIME) || defined(VMS) struct utimbuf utbuf; --- 1270,1277 ---- break; #ifdef HAS_UTIME case OP_UTIME: ! what = "utime"; ! APPLY_TAINT_PROPER(); if (sp - mark > 2) { #if defined(I_UTIME) || defined(VMS) struct utimbuf utbuf; *************** *** 1191,1199 **** utbuf.actime = SvIVx(*++mark); /* time accessed */ utbuf.modtime = SvIVx(*++mark); /* time modified */ #endif tot = sp - mark; while (++mark <= sp) { ! if (utime(SvPVx(*mark, na),&utbuf)) tot--; } } --- 1290,1301 ---- utbuf.actime = SvIVx(*++mark); /* time accessed */ utbuf.modtime = SvIVx(*++mark); /* time modified */ #endif + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { ! char *name = SvPVx(*mark, na); ! APPLY_TAINT_PROPER(); ! if (utime(name, &utbuf)) tot--; } } *************** *** 1203,1208 **** --- 1305,1312 ---- #endif } return tot; + + #undef APPLY_TAINT_PROPER } /* Do the permissions allow some operation? Assumes statcache already set. */ *************** *** 1294,1299 **** --- 1398,1404 ---- SV **mark; SV **sp; { + dTHR; key_t key; I32 n, flags; *************** *** 1329,1341 **** SV **mark; SV **sp; { SV *astr; char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; - #ifdef __linux__ /* XXX Need metaconfig test */ - union semun unsemds; - #endif id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; --- 1434,1444 ---- SV **mark; SV **sp; { + dTHR; SV *astr; char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; *************** *** 1365,1390 **** else if (cmd == GETALL || cmd == SETALL) { struct semid_ds semds; ! #ifdef __linux__ /* XXX Need metaconfig test */ ! /* linux (and Solaris2?) uses : ! int semctl (int semid, int semnum, int cmd, union semun arg) ! union semun { ! int val; ! struct semid_ds *buf; ! ushort *array; ! }; ! */ ! union semun semun; semun.buf = &semds; ! if (semctl(id, 0, IPC_STAT, semun) == -1) ! #else ! if (semctl(id, 0, IPC_STAT, &semds) == -1) ! #endif return -1; getinfo = (cmd == GETALL); ! infosize = semds.sem_nsems * sizeof(short); ! /* "short" is technically wrong but much more portable ! than guessing about u_?short(_t)? */ } break; #endif --- 1468,1480 ---- else if (cmd == GETALL || cmd == SETALL) { struct semid_ds semds; ! union semun semun; ! semun.buf = &semds; ! if (Semctl(id, 0, IPC_STAT, semun) == -1) return -1; getinfo = (cmd == GETALL); ! infosize = semds.sem_nsems * sizeof(unsigned short); } break; #endif *************** *** 1424,1436 **** break; #endif #ifdef HAS_SEM ! case OP_SEMCTL: ! #ifdef __linux__ /* XXX Need metaconfig test */ ! unsemds.buf = (struct semid_ds *)a; ! ret = semctl(id, n, cmd, unsemds); ! #else ! ret = semctl(id, n, cmd, (struct semid_ds *)a); ! #endif break; #endif #ifdef HAS_SHM --- 1514,1525 ---- break; #endif #ifdef HAS_SEM ! case OP_SEMCTL: { ! union semun unsemds; ! ! unsemds.buf = (struct semid_ds *)a; ! ret = Semctl(id, n, cmd, unsemds); ! } break; #endif #ifdef HAS_SHM *************** *** 1453,1458 **** --- 1542,1548 ---- SV **sp; { #ifdef HAS_MSG + dTHR; SV *mstr; char *mbuf; I32 id, msize, flags; *************** *** 1477,1482 **** --- 1567,1573 ---- SV **sp; { #ifdef HAS_MSG + dTHR; SV *mstr; char *mbuf; long mtype; *************** *** 1515,1520 **** --- 1606,1612 ---- SV **sp; { #ifdef HAS_SEM + dTHR; SV *opstr; char *opbuf; I32 id; *************** *** 1542,1547 **** --- 1634,1640 ---- SV **sp; { #ifdef HAS_SHM + dTHR; SV *mstr; char *mbuf, *shm; I32 id, mpos, msize; diff -c 'perl5.004_04/doop.c' 'perl5.004_05/doop.c' Index: ./doop.c *** ./doop.c Wed Oct 8 09:18:24 1997 --- ./doop.c Sun Nov 22 10:08:38 1998 *************** *** 23,28 **** --- 23,29 ---- SV *sv; OP *arg; { + dTHR; register short *tbl; register U8 *s; register U8 *send; *************** *** 30,38 **** register I32 ch; register I32 matches = 0; register I32 squash = op->op_private & OPpTRANS_SQUASH; STRLEN len; ! if (SvREADONLY(sv)) croak(no_modify); tbl = (short*)cPVOP->op_pv; s = (U8*)SvPV(sv, len); --- 31,40 ---- register I32 ch; register I32 matches = 0; register I32 squash = op->op_private & OPpTRANS_SQUASH; + register U8 *p; STRLEN len; ! if (SvREADONLY(sv) && !(op->op_private & OPpTRANS_COUNTONLY)) croak(no_modify); tbl = (short*)cPVOP->op_pv; s = (U8*)SvPV(sv, len); *************** *** 53,69 **** } s++; } } else { d = s; while (s < send) { if ((ch = tbl[*s]) >= 0) { *d = ch; ! if (matches++ && squash) { ! if (d[-1] == *d) matches--; else ! d++; } else d++; --- 55,81 ---- } s++; } + SvSETMAGIC(sv); + } + else if (op->op_private & OPpTRANS_COUNTONLY) { + while (s < send) { + if (tbl[*s] >= 0) + matches++; + s++; + } } else { d = s; + p = send; while (s < send) { if ((ch = tbl[*s]) >= 0) { *d = ch; ! matches++; ! if (squash) { ! if (p == d - 1 && *p == *d) matches--; else ! p = d++; } else d++; *************** *** 75,82 **** matches += send - d; /* account for disappeared chars */ *d = '\0'; SvCUR_set(sv, d - (U8*)SvPVX(sv)); } - SvSETMAGIC(sv); return matches; } --- 87,94 ---- matches += send - d; /* account for disappeared chars */ *d = '\0'; SvCUR_set(sv, d - (U8*)SvPVX(sv)); + SvSETMAGIC(sv); } return matches; } *************** *** 96,106 **** mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); ! if (SvTYPE(sv) < SVt_PV) ! sv_upgrade(sv, SVt_PV); if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { ! if (*mark) { SvPV(*mark, tmplen); len += tmplen; } --- 108,117 ---- mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); ! (void)SvUPGRADE(sv, SVt_PV); if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { ! if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) { SvPV(*mark, tmplen); len += tmplen; } *************** *** 256,261 **** --- 267,273 ---- do_chomp(sv) register SV *sv; { + dTHR; register I32 count; STRLEN len; char *s; *************** *** 333,338 **** --- 345,351 ---- SV *left; SV *right; { + dTHR; /* just for taint */ #ifdef LIBERAL register long *dl; register long *ll; *************** *** 447,453 **** do_kv(ARGS) dARGS { ! dSP; HV *hv = (HV*)POPs; register HE *entry; SV *tmpstr; --- 460,466 ---- do_kv(ARGS) dARGS { ! djSP; HV *hv = (HV*)POPs; register HE *entry; SV *tmpstr; *************** *** 474,480 **** RETURN; if (gimme == G_SCALAR) { ! I32 i; dTARGET; if (op->op_flags & OPf_MOD) { /* lvalue */ --- 487,493 ---- RETURN; if (gimme == G_SCALAR) { ! IV i; dTARGET; if (op->op_flags & OPf_MOD) { /* lvalue */ *************** *** 483,489 **** sv_magic(TARG, Nullsv, 'k', Nullch, 0); } LvTYPE(TARG) = 'k'; ! LvTARG(TARG) = (SV*)hv; PUSHs(TARG); RETURN; } --- 496,506 ---- sv_magic(TARG, Nullsv, 'k', Nullch, 0); } LvTYPE(TARG) = 'k'; ! if (LvTARG(TARG) != (SV*)hv) { ! if (LvTARG(TARG)) ! SvREFCNT_dec(LvTARG(TARG)); ! LvTARG(TARG) = SvREFCNT_inc(hv); ! } PUSHs(TARG); RETURN; } *************** *** 502,508 **** } /* Guess how much room we need. hv_max may be a few too many. Oh well. */ ! EXTEND(sp, HvMAX(hv) * (dokeys + dovalues)); PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ while (entry = hv_iternext(hv)) { --- 519,525 ---- } /* Guess how much room we need. hv_max may be a few too many. Oh well. */ ! EXTEND(SP, HvMAX(hv) * (dokeys + dovalues)); PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ while (entry = hv_iternext(hv)) { diff -c 'perl5.004_04/dosish.h' 'perl5.004_05/dosish.h' Index: ./dosish.h *** ./dosish.h Thu Jul 31 13:38:06 1997 --- ./dosish.h Wed Mar 4 07:12:27 1998 *************** *** 24,34 **** #define dXSUB_SYS #define TMPPATH "plXXXXXX" - #ifdef WIN32 - #define HAS_UTIME - #define HAS_KILL - #endif - /* * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were * running on DOS, *and* if we had to cope with 16 bit memory addressing --- 24,29 ---- *************** *** 54,59 **** --- 49,62 ---- */ #undef USEMYBINMODE + /* Stat_t: + * This symbol holds the type used to declare buffers for information + * returned by stat(). It's usually just struct stat. It may be necessary + * to include and to get any typedef'ed + * information. + */ + #define Stat_t struct stat + /* USE_STAT_RDEV: * This symbol is defined if this system has a stat structure declaring * st_rdev *************** *** 94,105 **** #ifndef WIN32 # define Stat(fname,bufptr) stat((fname),(bufptr)) #else ! # define Stat(fname,bufptr) win32_stat((fname),(bufptr)) ! # define my_getenv(var) getenv(var) /* ! * the following are standard library calls (stdio in particular) ! * that is being redirected to the perl DLL. This is needed for ! * Dynaloading any modules that called stdio functions */ ! # include #endif /* WIN32 */ --- 97,112 ---- #ifndef WIN32 # define Stat(fname,bufptr) stat((fname),(bufptr)) #else ! # define HAS_IOCTL ! # define HAS_UTIME ! # define HAS_KILL ! # define HAS_WAIT ! # define HAS_CHOWN /* ! * This provides a layer of functions and macros to ensure extensions will ! * get to use the same RTL functions as the core. */ ! # ifndef HASATTRIBUTE ! # include ! # endif #endif /* WIN32 */ diff -c 'perl5.004_04/dump.c' 'perl5.004_05/dump.c' Index: ./dump.c *** ./dump.c Tue May 13 15:25:54 1997 --- ./dump.c Mon Jul 6 19:03:16 1998 *************** *** 31,36 **** --- 31,37 ---- void dump_all() { + dTHR; PerlIO_setlinebuf(Perl_debug_log); if (main_root) dump_op(main_root); *************** *** 41,46 **** --- 42,48 ---- dump_packsubs(stash) HV* stash; { + dTHR; I32 i; HE *entry; *************** *** 100,135 **** } void ! dump_op(op) ! register OP *op; { dump("{\n"); ! if (op->op_seq) ! PerlIO_printf(Perl_debug_log, "%-4d", op->op_seq); else PerlIO_printf(Perl_debug_log, " "); ! dump("TYPE = %s ===> ", op_name[op->op_type]); ! if (op->op_next) { ! if (op->op_seq) ! PerlIO_printf(Perl_debug_log, "%d\n", op->op_next->op_seq); else ! PerlIO_printf(Perl_debug_log, "(%d)\n", op->op_next->op_seq); } else PerlIO_printf(Perl_debug_log, "DONE\n"); dumplvl++; ! if (op->op_targ) { ! if (op->op_type == OP_NULL) ! dump(" (was %s)\n", op_name[op->op_targ]); else ! dump("TARG = %d\n", op->op_targ); } #ifdef DUMPADDR ! dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next); #endif ! if (op->op_flags) { SV *tmpsv = newSVpv("", 0); ! switch (op->op_flags & OPf_WANT) { case OPf_WANT_VOID: sv_catpv(tmpsv, ",VOID"); break; --- 102,137 ---- } void ! dump_op(o) ! register OP *o; { dump("{\n"); ! if (o->op_seq) ! PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq); else PerlIO_printf(Perl_debug_log, " "); ! dump("TYPE = %s ===> ", op_name[o->op_type]); ! if (o->op_next) { ! if (o->op_seq) ! PerlIO_printf(Perl_debug_log, "%d\n", o->op_next->op_seq); else ! PerlIO_printf(Perl_debug_log, "(%d)\n", o->op_next->op_seq); } else PerlIO_printf(Perl_debug_log, "DONE\n"); dumplvl++; ! if (o->op_targ) { ! if (o->op_type == OP_NULL) ! dump(" (was %s)\n", op_name[o->op_targ]); else ! dump("TARG = %d\n", o->op_targ); } #ifdef DUMPADDR ! dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next); #endif ! if (o->op_flags) { SV *tmpsv = newSVpv("", 0); ! switch (o->op_flags & OPf_WANT) { case OPf_WANT_VOID: sv_catpv(tmpsv, ",VOID"); break; *************** *** 143,200 **** sv_catpv(tmpsv, ",UNKNOWN"); break; } ! if (op->op_flags & OPf_KIDS) sv_catpv(tmpsv, ",KIDS"); ! if (op->op_flags & OPf_PARENS) sv_catpv(tmpsv, ",PARENS"); ! if (op->op_flags & OPf_STACKED) sv_catpv(tmpsv, ",STACKED"); ! if (op->op_flags & OPf_REF) sv_catpv(tmpsv, ",REF"); ! if (op->op_flags & OPf_MOD) sv_catpv(tmpsv, ",MOD"); ! if (op->op_flags & OPf_SPECIAL) sv_catpv(tmpsv, ",SPECIAL"); dump("FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); SvREFCNT_dec(tmpsv); } ! if (op->op_private) { SV *tmpsv = newSVpv("", 0); ! if (op->op_type == OP_AASSIGN) { ! if (op->op_private & OPpASSIGN_COMMON) sv_catpv(tmpsv, ",COMMON"); } ! else if (op->op_type == OP_SASSIGN) { ! if (op->op_private & OPpASSIGN_BACKWARDS) sv_catpv(tmpsv, ",BACKWARDS"); } ! else if (op->op_type == OP_TRANS) { ! if (op->op_private & OPpTRANS_SQUASH) sv_catpv(tmpsv, ",SQUASH"); ! if (op->op_private & OPpTRANS_DELETE) sv_catpv(tmpsv, ",DELETE"); ! if (op->op_private & OPpTRANS_COMPLEMENT) sv_catpv(tmpsv, ",COMPLEMENT"); } ! else if (op->op_type == OP_REPEAT) { ! if (op->op_private & OPpREPEAT_DOLIST) sv_catpv(tmpsv, ",DOLIST"); } ! else if (op->op_type == OP_ENTERSUB || ! op->op_type == OP_RV2SV || ! op->op_type == OP_RV2AV || ! op->op_type == OP_RV2HV || ! op->op_type == OP_RV2GV || ! op->op_type == OP_AELEM || ! op->op_type == OP_HELEM ) { ! if (op->op_type == OP_ENTERSUB) { ! if (op->op_private & OPpENTERSUB_AMPER) sv_catpv(tmpsv, ",AMPER"); ! if (op->op_private & OPpENTERSUB_DB) sv_catpv(tmpsv, ",DB"); } ! switch (op->op_private & OPpDEREF) { case OPpDEREF_SV: sv_catpv(tmpsv, ",SV"); break; --- 145,202 ---- sv_catpv(tmpsv, ",UNKNOWN"); break; } ! if (o->op_flags & OPf_KIDS) sv_catpv(tmpsv, ",KIDS"); ! if (o->op_flags & OPf_PARENS) sv_catpv(tmpsv, ",PARENS"); ! if (o->op_flags & OPf_STACKED) sv_catpv(tmpsv, ",STACKED"); ! if (o->op_flags & OPf_REF) sv_catpv(tmpsv, ",REF"); ! if (o->op_flags & OPf_MOD) sv_catpv(tmpsv, ",MOD"); ! if (o->op_flags & OPf_SPECIAL) sv_catpv(tmpsv, ",SPECIAL"); dump("FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); SvREFCNT_dec(tmpsv); } ! if (o->op_private) { SV *tmpsv = newSVpv("", 0); ! if (o->op_type == OP_AASSIGN) { ! if (o->op_private & OPpASSIGN_COMMON) sv_catpv(tmpsv, ",COMMON"); } ! else if (o->op_type == OP_SASSIGN) { ! if (o->op_private & OPpASSIGN_BACKWARDS) sv_catpv(tmpsv, ",BACKWARDS"); } ! else if (o->op_type == OP_TRANS) { ! if (o->op_private & OPpTRANS_SQUASH) sv_catpv(tmpsv, ",SQUASH"); ! if (o->op_private & OPpTRANS_DELETE) sv_catpv(tmpsv, ",DELETE"); ! if (o->op_private & OPpTRANS_COMPLEMENT) sv_catpv(tmpsv, ",COMPLEMENT"); } ! else if (o->op_type == OP_REPEAT) { ! if (o->op_private & OPpREPEAT_DOLIST) sv_catpv(tmpsv, ",DOLIST"); } ! else if (o->op_type == OP_ENTERSUB || ! o->op_type == OP_RV2SV || ! o->op_type == OP_RV2AV || ! o->op_type == OP_RV2HV || ! o->op_type == OP_RV2GV || ! o->op_type == OP_AELEM || ! o->op_type == OP_HELEM ) { ! if (o->op_type == OP_ENTERSUB) { ! if (o->op_private & OPpENTERSUB_AMPER) sv_catpv(tmpsv, ",AMPER"); ! if (o->op_private & OPpENTERSUB_DB) sv_catpv(tmpsv, ",DB"); } ! switch (o->op_private & OPpDEREF) { case OPpDEREF_SV: sv_catpv(tmpsv, ",SV"); break; *************** *** 205,246 **** sv_catpv(tmpsv, ",HV"); break; } ! if (op->op_type == OP_AELEM || op->op_type == OP_HELEM) { ! if (op->op_private & OPpLVAL_DEFER) sv_catpv(tmpsv, ",LVAL_DEFER"); } else { ! if (op->op_private & HINT_STRICT_REFS) sv_catpv(tmpsv, ",STRICT_REFS"); } } ! else if (op->op_type == OP_CONST) { ! if (op->op_private & OPpCONST_BARE) sv_catpv(tmpsv, ",BARE"); } ! else if (op->op_type == OP_FLIP) { ! if (op->op_private & OPpFLIP_LINENUM) sv_catpv(tmpsv, ",LINENUM"); } ! else if (op->op_type == OP_FLOP) { ! if (op->op_private & OPpFLIP_LINENUM) sv_catpv(tmpsv, ",LINENUM"); } ! if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO) sv_catpv(tmpsv, ",INTRO"); if (SvCUR(tmpsv)) dump("PRIVATE = (%s)\n", SvPVX(tmpsv) + 1); SvREFCNT_dec(tmpsv); } ! switch (op->op_type) { case OP_GVSV: case OP_GV: ! if (cGVOP->op_gv) { SV *tmpsv = NEWSV(0,0); ENTER; SAVEFREESV(tmpsv); ! gv_fullname3(tmpsv, cGVOP->op_gv, Nullch); dump("GV = %s\n", SvPV(tmpsv, na)); LEAVE; } --- 207,248 ---- sv_catpv(tmpsv, ",HV"); break; } ! if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) { ! if (o->op_private & OPpLVAL_DEFER) sv_catpv(tmpsv, ",LVAL_DEFER"); } else { ! if (o->op_private & HINT_STRICT_REFS) sv_catpv(tmpsv, ",STRICT_REFS"); } } ! else if (o->op_type == OP_CONST) { ! if (o->op_private & OPpCONST_BARE) sv_catpv(tmpsv, ",BARE"); } ! else if (o->op_type == OP_FLIP) { ! if (o->op_private & OPpFLIP_LINENUM) sv_catpv(tmpsv, ",LINENUM"); } ! else if (o->op_type == OP_FLOP) { ! if (o->op_private & OPpFLIP_LINENUM) sv_catpv(tmpsv, ",LINENUM"); } ! if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) sv_catpv(tmpsv, ",INTRO"); if (SvCUR(tmpsv)) dump("PRIVATE = (%s)\n", SvPVX(tmpsv) + 1); SvREFCNT_dec(tmpsv); } ! switch (o->op_type) { case OP_GVSV: case OP_GV: ! if (cGVOPo->op_gv) { SV *tmpsv = NEWSV(0,0); ENTER; SAVEFREESV(tmpsv); ! gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); dump("GV = %s\n", SvPV(tmpsv, na)); LEAVE; } *************** *** 248,288 **** dump("GV = NULL\n"); break; case OP_CONST: ! dump("SV = %s\n", SvPEEK(cSVOP->op_sv)); break; case OP_NEXTSTATE: case OP_DBSTATE: ! if (cCOP->cop_line) ! dump("LINE = %d\n",cCOP->cop_line); ! if (cCOP->cop_label) ! dump("LABEL = \"%s\"\n",cCOP->cop_label); break; case OP_ENTERLOOP: dump("REDO ===> "); ! if (cLOOP->op_redoop) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); dump("NEXT ===> "); ! if (cLOOP->op_nextop) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); dump("LAST ===> "); ! if (cLOOP->op_lastop) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_COND_EXPR: dump("TRUE ===> "); ! if (cCONDOP->op_true) ! PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); dump("FALSE ===> "); ! if (cCONDOP->op_false) ! PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); break; --- 250,290 ---- dump("GV = NULL\n"); break; case OP_CONST: ! dump("SV = %s\n", SvPEEK(cSVOPo->op_sv)); break; case OP_NEXTSTATE: case OP_DBSTATE: ! if (cCOPo->cop_line) ! dump("LINE = %d\n",cCOPo->cop_line); ! if (cCOPo->cop_label) ! dump("LABEL = \"%s\"\n",cCOPo->cop_label); break; case OP_ENTERLOOP: dump("REDO ===> "); ! if (cLOOPo->op_redoop) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_redoop->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); dump("NEXT ===> "); ! if (cLOOPo->op_nextop) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_nextop->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); dump("LAST ===> "); ! if (cLOOPo->op_lastop) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_lastop->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_COND_EXPR: dump("TRUE ===> "); ! if (cCONDOPo->op_true) ! PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_true->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); dump("FALSE ===> "); ! if (cCONDOPo->op_false) ! PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_false->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); break; *************** *** 291,312 **** case OP_OR: case OP_AND: dump("OTHER ===> "); ! if (cLOGOP->op_other) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_PUSHRE: case OP_MATCH: case OP_SUBST: ! dump_pm((PMOP*)op); break; default: break; } ! if (op->op_flags & OPf_KIDS) { OP *kid; ! for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) dump_op(kid); } dumplvl--; --- 293,314 ---- case OP_OR: case OP_AND: dump("OTHER ===> "); ! if (cLOGOPo->op_other) ! PerlIO_printf(Perl_debug_log, "%d\n", cLOGOPo->op_other->op_seq); else PerlIO_printf(Perl_debug_log, "DONE\n"); break; case OP_PUSHRE: case OP_MATCH: case OP_SUBST: ! dump_pm(cPMOPo); break; default: break; } ! if (o->op_flags & OPf_KIDS) { OP *kid; ! for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) dump_op(kid); } dumplvl--; *************** *** 368,375 **** } if (pm->op_pmflags) { SV *tmpsv = newSVpv("", 0); ! if (pm->op_pmflags & PMf_USED) sv_catpv(tmpsv, ",USED"); if (pm->op_pmflags & PMf_ONCE) sv_catpv(tmpsv, ",ONCE"); if (pm->op_pmflags & PMf_SCANFIRST) --- 370,379 ---- } if (pm->op_pmflags) { SV *tmpsv = newSVpv("", 0); ! if (pm->op_pmdynflags & PMdf_USED) sv_catpv(tmpsv, ",USED"); + if (pm->op_pmdynflags & PMdf_TAINTED) + sv_catpv(tmpsv, ",TAINTED"); if (pm->op_pmflags & PMf_ONCE) sv_catpv(tmpsv, ",ONCE"); if (pm->op_pmflags & PMf_SCANFIRST) *************** *** 386,391 **** --- 390,397 ---- sv_catpv(tmpsv, ",GLOBAL"); if (pm->op_pmflags & PMf_CONTINUE) sv_catpv(tmpsv, ",CONTINUE"); + if (pm->op_pmflags & PMf_RETAINT) + sv_catpv(tmpsv, ",RETAINT"); if (pm->op_pmflags & PMf_EVAL) sv_catpv(tmpsv, ",EVAL"); dump("PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); diff -c /dev/null 'perl5.004_05/eg/cgi/caution.xbm' Index: ./eg/cgi/caution.xbm *** ./eg/cgi/caution.xbm Wed Dec 31 19:00:00 1969 --- ./eg/cgi/caution.xbm Sun Nov 22 16:12:04 1998 *************** *** 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 -c /dev/null 'perl5.004_05/eg/cgi/dna.small.gif.uu' Index: ./eg/cgi/dna.small.gif.uu *** ./eg/cgi/dna.small.gif.uu Wed Dec 31 19:00:00 1969 --- ./eg/cgi/dna.small.gif.uu Thu Dec 3 10:49:32 1998 *************** *** 0 **** --- 1,64 ---- + 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() { $lines++; --- 33,44 ---- # Process the form if there is a file name entered if ($file = param('filename')) { $tmpfile=tmpFileName($file); + $mimetype = uploadInfo($file)->{'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++; *************** *** 51,56 **** --- 55,62 ---- print strong("No statistics selected."); } } + + # print cite("URL parameters: "),url_param(); print hr(), a({href=>"../cgi_docs.html"},"CGI documentation"), diff -c 'perl5.004_04/eg/cgi/index.html' 'perl5.004_05/eg/cgi/index.html' Index: ./eg/cgi/index.html *** ./eg/cgi/index.html Sat Mar 29 18:39:14 1997 --- ./eg/cgi/index.html Sun Nov 22 16:12:04 1998 *************** *** 23,28 **** --- 23,34 ----
  • Look at its source code +

    Server Push

    + +

    Read the coordinates from a clickable image map

    Echo fatal script errors to the browser

    + This script deliberately generates a compile-time error. !

    Permanently customize the appearance of a page

    !

    Permanently customize the appearance of a page with a cookie

    • Try the script
    • Look at its source code *************** *** 100,111 ****
    • 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: Mon Dec 2 06:23:25 EST 1996 --- 107,118 ----
    • 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 -c 'perl5.004_04/eg/cgi/monty.cgi' 'perl5.004_05/eg/cgi/monty.cgi' Index: ./eg/cgi/monty.cgi *** ./eg/cgi/monty.cgi Sat Mar 29 18:39:14 1997 --- ./eg/cgi/monty.cgi Sun Nov 22 16:12:04 1998 *************** *** 1,6 **** --- 1,7 ---- #!/usr/local/bin/perl use CGI; + use CGI::Carp qw/fatalsToBrowser/; $query = new CGI; *************** *** 15,21 **** sub print_prompt { my($query) = @_; ! print $query->start_multipart_form; print "What's your name?
      "; print $query->textfield('name'); print $query->checkbox('Not my real name'); --- 16,22 ---- 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'); *************** *** 23,41 **** 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'); --- 24,42 ---- 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'); *************** *** 43,49 **** 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'); --- 44,50 ---- 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'); diff -c /dev/null 'perl5.004_05/eg/cgi/nph-multipart.cgi' Index: ./eg/cgi/nph-multipart.cgi *** ./eg/cgi/nph-multipart.cgi Wed Dec 31 19:00:00 1969 --- ./eg/cgi/nph-multipart.cgi Sun Nov 22 16:12:04 1998 *************** *** 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 -c 'perl5.004_04/eg/cgi/save_state.cgi' 'perl5.004_05/eg/cgi/save_state.cgi' Index: ./eg/cgi/save_state.cgi *** ./eg/cgi/save_state.cgi Sat Mar 29 18:39:14 1997 --- ./eg/cgi/save_state.cgi Sun Nov 22 16:12:04 1998 *************** *** 12,18 **** $query = &restore_parameters($query) if $query->param('action') eq 'RESTORE'; # Here's where we create the form ! print $query->startform; 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 "

      "; --- 12,18 ---- $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 "

      "; diff -c 'perl5.004_04/emacs/cperl-mode.el' 'perl5.004_05/emacs/cperl-mode.el' Index: ./emacs/cperl-mode.el Prereq: 1.39 *** ./emacs/cperl-mode.el Tue Oct 14 08:44:21 1997 --- ./emacs/cperl-mode.el Sun Nov 22 10:08:38 1998 *************** *** 1,14 **** ! ;;; This code started from the following message of long time ago (IZ): ;;; From: olson@mcs.anl.gov (Bob Olson) ;;; Newsgroups: comp.lang.perl ;;; Subject: cperl-mode: Another perl mode for Gnuemacs ;;; Date: 14 Aug 91 15:20:01 GMT ! ;; Perl code editing commands for Emacs ! ;; Copyright (C) 1985-1996 Bob Olson, Ilya Zakharevich ! ;; This file is not (yet) part of GNU Emacs. It may be distributed ;; either under the same terms as GNU Emacs, or under the same terms ;; as Perl. You should have received a copy of Perl Artistic license ;; along with the Perl distribution. --- 1,27 ---- ! ;;; cperl-mode.el --- Perl code editing commands for Emacs ! ! ;;;; The following message is relative to GNU version of the module: ! ! ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 1997 ! ;; Free Software Foundation, Inc. ! ! ;; Author: Ilya Zakharevich and Bob Olson ! ;; Maintainer: Ilya Zakharevich ! ;; Keywords: languages, Perl ! ! ;; This file is part of GNU Emacs. ! ! ;;; This code started from the following message of long time ago ! ;;; (IZ), but Bob does not maintain this mode any more: ;;; From: olson@mcs.anl.gov (Bob Olson) ;;; Newsgroups: comp.lang.perl ;;; Subject: cperl-mode: Another perl mode for Gnuemacs ;;; Date: 14 Aug 91 15:20:01 GMT ! ;; Copyright (C) Ilya Zakharevich and Bob Olson ! ;; This file may be distributed ;; either under the same terms as GNU Emacs, or under the same terms ;; as Perl. You should have received a copy of Perl Artistic license ;; along with the Perl distribution. *************** *** 28,40 **** ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. - ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de ! ;; $Id: cperl-mode.el,v 1.39 1997/10/14 08:28:00 ilya Exp ilya $ ! ;;; To use this mode put the following into your .emacs file: ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t) --- 41,55 ---- ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de ! ;;; Commentary: ! ! ;; $Id: cperl-mode.el 4.5 1998/07/28 08:55:41 vera Exp vera $ ! ;;; Before (future?) RMS Emacs 20.3: To use this mode put the following into ! ;;; your .emacs file: ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t) *************** *** 43,56 **** ;; (setq cperl-hairy t) ! ;;; in your .emacs file. (Emacs rulers do not consider it politically ;;; correct to make whistles enabled by default.) ! ;;; DO NOT FORGET to read micro-docs. (available from `Perl' menu). <<<<<< ;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< ! ;;; `cperl-non-problems', `cperl-praise'. <<<<<< ! ;;; Additional useful commands to put into your .emacs file: ;; (setq auto-mode-alist ;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) --- 58,72 ---- ;; (setq cperl-hairy t) ! ;;; in your .emacs file. (Emacs rulers do not consider it politically ;;; correct to make whistles enabled by default.) ! ;;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< ;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< ! ;;; `cperl-non-problems', `cperl-praise', `cperl-speed'. <<<<<< ! ;;; Additional useful commands to put into your .emacs file (before ! ;;; (future?) RMS Emacs 20.3): ;; (setq auto-mode-alist ;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) *************** *** 59,84 **** ;;; The mode information (on C-h m) provides some customization help. ;;; If you use font-lock feature of this mode, it is advisable to use ! ;;; either lazy-lock-mode or fast-lock-mode (available on ELisp ! ;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock. ;;; Faces used now: three faces for first-class and second-class keywords ;;; and control flow words, one for each: comments, string, labels, ;;; functions definitions and packages, arrays, hashes, and variable ! ;;; definitions. If you do not see all these faces, your font-lock does ! ;;; not define them, so you need to define them manually. Maybe you have ! ;;; an obsolete font-lock from 19.28 or earlier. Upgrade. ;;; If you have a grayscale monitor, and do not have the variable ;;; font-lock-display-type bound to 'grayscale, insert ;;; (setq font-lock-display-type 'grayscale) ! ;;; into your .emacs file. ! ;;;; This mode supports font-lock, imenu and mode-compile. In the ;;;; hairy version font-lock is on, but you should activate imenu ! ;;;; yourself (note that mode-compile is not standard yet). Well, you ;;;; can use imenu from keyboard anyway (M-x imenu), but it is better ;;;; to bind it like that: --- 75,99 ---- ;;; The mode information (on C-h m) provides some customization help. ;;; If you use font-lock feature of this mode, it is advisable to use ! ;;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. ;;; Faces used now: three faces for first-class and second-class keywords ;;; and control flow words, one for each: comments, string, labels, ;;; functions definitions and packages, arrays, hashes, and variable ! ;;; definitions. If you do not see all these faces, your font-lock does ! ;;; not define them, so you need to define them manually. Maybe you have ! ;;; an obsolete font-lock from 19.28 or earlier. Upgrade. ;;; If you have a grayscale monitor, and do not have the variable ;;; font-lock-display-type bound to 'grayscale, insert ;;; (setq font-lock-display-type 'grayscale) ! ;;; into your .emacs file (this is relevant before RMS Emacs 20). ! ;;;; This mode supports font-lock, imenu and mode-compile. In the ;;;; hairy version font-lock is on, but you should activate imenu ! ;;;; yourself (note that mode-compile is not standard yet). Well, you ;;;; can use imenu from keyboard anyway (M-x imenu), but it is better ;;;; to bind it like that: *************** *** 463,471 **** ;;; `cperl-find-pods-heres' somehow maybe called when string-face is undefined ;;; - put a stupid workaround for 20.1 ! (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) ! (defvar cperl-extra-newline-before-brace nil "*Non-nil means that if, elsif, while, until, else, for, foreach and do constructs look like: --- 478,902 ---- ;;; `cperl-find-pods-heres' somehow maybe called when string-face is undefined ;;; - put a stupid workaround for 20.1 ! ;;;; After 1.39: ! ;;; Could indent here-docs for comments; ! ;;; These problems fixed: ! ;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into two chunk) ! ;;;;;;; s[foo] e - "e" part delimited by "different" <> (will match) ! ;;; Matching brackets honor prefices, may expand abbreviations; ! ;;; When expanding abbrevs, will remove last char only after ! ;;; self-inserted whitespace; ! ;;; More convenient "Refress hard constructs" in menu; ! ;;; `cperl-add-tags-recurse', `cperl-add-tags-recurse-noxs' ! ;;; added (for -batch mode); ! ;;; Better handling of errors when scanning for Perl constructs; ! ;;;;;;; Possible "problem" with class hierarchy in Perl distribution ! ;;;;;;; directory: ./ext duplicates ./lib; ! ;;; Write relative paths for generated TAGS; ! ! ;;;; After 1.40: ! ;;; s /// may be separated by "\n\f" too; ! ;;; `s #blah' recognized as a comment; ! ;;; Would highlight s/abc//s wrong; ! ;;; Debugging code in `cperl-electric-keywords' was leaking a message; ! ! ;;;; After 1.41: ! ;;; RMS changes for (future?) 20.3 merged ! ! ;;;; 2.0.1.0: RMS mode (has 3 misprints) ! ! ;;;; After 2.0: ! ;;; RMS whitespace changes for (future?) 20.3 merged ! ! ;;;; After 2.1: ! ;;; History updated ! ! ;;;; After 2.2: ! ;;; Merge `c-style-alist' since `c-mode' is no more. (Somebody who ! ;;; uses the styles should check that they work OK!) ! ;;; All the variable warnings go away, some undef functions too. ! ! ;;;; After 2.3: ! ;;; Added `cperl-perldoc' (thanks to Anthony Foiani ) ! ;;; Added `cperl-pod-to-manpage' (thanks to Nick Roberts ) ! ;;; All the function warnings go away. ! ! ;;;; After 2.4: ! ;;; `Perl doc', `Regexp' submenus created (latter to allow short displays). ! ;;; `cperl-clobber-lisp-bindings' added. ! ;;; $a->y() is not y///. ! ;;; `cperl-after-block-p' was missing a `save-excursion' => wrong results. ! ;;; `cperl-val' was defined too late. ! ;;; `cperl-init-faces' was failing. ! ;;; Init faces when loading `ps-print'. ! ! ;;;; After 2.4: ! ;;; `cperl-toggle-autohelp' implemented. ! ;;; `while SPACE LESS' was buggy. ! ;;; `-text' in `[-text => 1]' was not highlighted. ! ;;; `cperl-after-block-p' was FALSE after `sub f {}'. ! ! ;;;; After 2.5: ! ;;; `foreachmy', `formy' expanded too. ! ;;; Expand `=pod-directive'. ! ;;; `cperl-linefeed' behaves reasonable in POD-directive lines. ! ;;; `cperl-electric-keyword' prints a message, governed by ! ;;; `cperl-message-electric-keyword'. ! ! ;;;; After 2.6: ! ;;; Typing `}' was not checking for being block or not. ! ;;; Beautifying levels in RE: Did not know about lookbehind; ! ;;; finding *which* level was not intuitive; ! ;;; `cperl-beautify-levels' added. ! ;;; Allow here-docs contain `=head1' and friends (at least for keywords). ! ! ;;;; After 2.7: ! ;;; Fix for broken `font-lock-unfontify-region-function'. Should ! ;;; preserve `syntax-table' properties even with `lazy-lock'. ! ! ;;;; After 2.8: ! ;;; Some more compile time warnings crept in. ! ;;; `cperl-indent-region-fix-else' implemented. ! ;;; `cperl-fix-line-spacing' implemented. ! ;;; `cperl-invert-if-unless' implemented (C-c C-t and in Menu). ! ;;; Upgraded hints to mention 20.2's goods/bads. ! ;;; Started to use `cperl-extra-newline-before-brace-multiline', ! ;;; `cperl-break-one-line-blocks-when-indent', ! ;;; `cperl-fix-hanging-brace-when-indent', `cperl-merge-trailing-else'. ! ! ;;;; After 2.9: ! ;;; Workaround for another `font-lock's `syntax-table' text-property bug. ! ;;; `zerop' could be applied to nil. ! ;;; At last, may work with `font-lock' without setting `cperl-font-lock'. ! ;;; (We expect that starting from 19.33, `font-lock' supports keywords ! ;;; being a function - what is a correct version?) ! ;;; Rename `cperl-indent-region-fix-else' to ! ;;; `cperl-indent-region-fix-constructs'. ! ;;; `cperl-fix-line-spacing' could be triggered inside strings, would not ! ;;; know what to do with BLOCKs of map/printf/etc. ! ;;; `cperl-merge-trailing-else' and `cperl-fix-line-spacing' handle ! ;;; `continue' too. ! ;;; Indentation after {BLOCK} knows about map/printf/etc. ! ;;; Finally: treat after-comma lines as continuation lines. ! ! ;;;; After 2.10: ! ;;; `continue' made electric. ! ;;; Electric `do' inserts `do/while'. ! ;;; Some extra compile-time warnings crept in. ! ;;; `font-lock' of 19.33 could not handle font-lock-keywords being a function ! ;;; returning a symbol. ! ! ;;;; After 2.11: ! ;;; Changes to make syntaxification to be autoredone via `font-lock'. ! ;;; Switched on by `cperl-syntaxify-by-font-lock', off by default so far. ! ! ;;;; After 2.12: ! ;;; Remove some commented out chunks. ! ;;; Styles are slightly updated (a lot of work is needed, especially ! ;;; with new `cperl-fix-line-spacing'). ! ! ;;;; After 2.13: ! ;;; Old value of style is memorized when choosing a new style, may be ! ;;; restored from the same menu. ! ;;; Mode-documentation added to micro-docs. ! ;;; `cperl-praise' updated. ! ;;; `cperl-toggle-construct-fix' added on C-c C-w and menu. ! ;;; `auto-fill-mode' added on C-c C-f and menu. ! ;;; `PerlStyle' style added. ! ;;; Message for termination of scan corrected. ! ! ;;;; After 2.14: ! ! ;;; Did not work with -q ! ! ;;;; After 2.15: ! ! ;;; `cperl-speed' hints added. ! ;;; Minor style fixes. ! ! ;;;; After 2.15: ! ;;; Make backspace electric after expansion of `else/continue' too. ! ! ;;;; After 2.16: ! ;;; Starting to merge changes to RMS emacs version. ! ! ;;;; After 2.17: ! ;;; Merged custom stuff and darn `font-lock-constant-face'. ! ! ;;;; After 2.18: ! ;;; Bumped the version to 3.1 ! ! ;;;; After 3.1: ! ;;; Fixed customization to honor cperl-hairy. ! ;;; Created customization groups. Sent to RMS to include into 2.3. ! ! ;;;; After 3.2: ! ;;; Interaction of `font-lock-hot-pass' and `cperl-syntaxify-by-font-lock'. ! ;;; (`cperl-after-block-and-statement-beg'): ! ;;; (`cperl-after-block-p'): ! ;;; (`cperl-after-expr-p'): It is BLOCK if we reach lim when backup sexp. ! ;;; (`cperl-indent-region'): Make a marker for END - text added/removed. ! ;;; (`cperl-style-alist', `cperl-styles-entries') ! ;;; Include `cperl-merge-trailing-else' where the value is clear. ! ! ;;;; After 3.3: ! ;;; (`cperl-tips'): ! ;;; (`cperl-problems'): Improvements to docs. ! ! ;;;; After 3.4: ! ;;; (`cperl-mode'): Make lazy syntaxification possible. ! ;;; (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to ! ;;; restart syntaxification. ! ;;; (`cperl-syntaxify-by-font-lock'): Set to t, should be safe now. ! ! ;;;; After 3.5: ! ;;; (`cperl-syntaxify-by-font-lock'): Better default, customizes to ! ;;; `message' too. ! ! ;;;; After 3.6: ! ;;; (`cperl-find-pods-heres'): changed so that -d ?foo? is a RE. ! ;;; (`cperl-array-face'): changed name from `font-lock-emphasized-face'. ! ;;; (`cperl-hash-face'): changed name from `font-lock-other-emphasized-face'. ! ;;; Use `defface' to define these two extra faces. ! ! ;;;; After 3.7: ! ;;; Can use linear algorithm for indentation if Emacs supports it: ! ;;; indenting DB::DB (800+ lines) improved from 69 sec to 11 sec ! ;;; (73 vs 15 with imenu). ! ;;; (`cperl-emacs-can-parse'): New state. ! ;;; (`cperl-indent-line'): Corrected to use global state. ! ;;; (`cperl-calculate-indent'): Likewise. ! ;;; (`cperl-fix-line-spacing'): Likewise (not used yet). ! ! ;;;; After 3.8: ! ;;; (`cperl-choose-color'): Converted to a function (to be compilable in text-mode). ! ! ;;;; After 3.9: ! ;;; (`cperl-dark-background '): Disable without window-system. ! ! ;;;; After 3.10: ! ;;; Do `defface' only if window-system. ! ! ;;;; After 3.11: ! ;;; (`cperl-fix-line-spacing'): sped up to bail out early. ! ;;; (`cperl-indent-region'): Disable hooks during the call (how to call them later?). ! ! ;;; Now indents 820-line-long function in 6.5 sec (including syntaxification) the first time ! ;;; (when buffer has few properties), 7.1 sec the second time. ! ! ;;;Function Name Call Count Elapsed Time Average Time ! ;;;========================================= ========== ============ ============ ! ;;;cperl-indent-exp 1 10.039999999 10.039999999 ! ;;;cperl-indent-region 1 10.0 10.0 ! ;;;cperl-indent-line 821 6.2100000000 0.0075639464 ! ;;;cperl-calculate-indent 821 5.0199999999 0.0061144945 ! ;;;cperl-backward-to-noncomment 2856 2.0500000000 0.0007177871 ! ;;;cperl-fontify-syntaxically 2 1.78 0.8900000000 ! ;;;cperl-find-pods-heres 2 1.78 0.8900000000 ! ;;;cperl-update-syntaxification 1 1.78 1.78 ! ;;;cperl-fix-line-spacing 769 1.4800000000 0.0019245773 ! ;;;cperl-after-block-and-statement-beg 163 1.4100000000 0.0086503067 ! ;;;cperl-block-p 775 1.1800000000 0.0015225806 ! ;;;cperl-to-comment-or-eol 3652 1.1200000000 0.0003066812 ! ;;;cperl-after-block-p 165 1.0500000000 0.0063636363 ! ;;;cperl-commentify 141 0.22 0.0015602836 ! ;;;cperl-get-state 813 0.16 0.0001968019 ! ;;;cperl-backward-to-start-of-continued-exp 26 0.12 0.0046153846 ! ;;;cperl-delay-update-hook 2107 0.0899999999 4.271...e-05 ! ;;;cperl-protect-defun-start 141 0.0700000000 0.0004964539 ! ;;;cperl-after-label 407 0.0599999999 0.0001474201 ! ;;;cperl-forward-re 139 0.0299999999 0.0002158273 ! ;;;cperl-comment-indent 26 0.0299999999 0.0011538461 ! ;;;cperl-use-region-p 8 0.0 0.0 ! ;;;cperl-lazy-hook 15 0.0 0.0 ! ;;;cperl-after-expr-p 8 0.0 0.0 ! ;;;cperl-font-lock-unfontify-region-function 1 0.0 0.0 ! ! ;;;Function Name Call Count Elapsed Time Average Time ! ;;;========================================= ========== ============ ============ ! ;;;cperl-fix-line-spacing 769 1.4500000000 0.0018855656 ! ;;;cperl-indent-line 13 0.3100000000 0.0238461538 ! ;;;cperl-after-block-and-statement-beg 69 0.2700000000 0.0039130434 ! ;;;cperl-after-block-p 69 0.2099999999 0.0030434782 ! ;;;cperl-calculate-indent 13 0.1000000000 0.0076923076 ! ;;;cperl-backward-to-noncomment 177 0.0700000000 0.0003954802 ! ;;;cperl-get-state 13 0.0 0.0 ! ;;;cperl-to-comment-or-eol 179 0.0 0.0 ! ;;;cperl-get-help-defer 1 0.0 0.0 ! ;;;cperl-lazy-hook 11 0.0 0.0 ! ;;;cperl-after-expr-p 2 0.0 0.0 ! ;;;cperl-block-p 13 0.0 0.0 ! ;;;cperl-after-label 5 0.0 0.0 ! ! ;;;; After 3.12: ! ;;; (`cperl-find-pods-heres'): do not warn on `=cut' if doing a chunk only. ! ! ;;;; After 3.13: ! ;;; (`cperl-mode'): load pseudo-faces on `cperl-find-pods-heres' (for 19.30). ! ;;; (`x-color-defined-p'): was not compiling on XEmacs ! ;;; (`cperl-find-pods-heres'): 1 << 6 was OK, but 1<<6 was considered as HERE ! ;;; made into a string. ! ! ;;;; After 3.14: ! ;;; (`cperl-find-pods-heres'): Postpone addition of faces after syntactic step ! ;;; Recognition of was wrong. ! ;;; (`cperl-clobber-lisp-bindings'): if set, C-c variants are the old ones ! ;;; (`cperl-unwind-to-safe'): New function. ! ;;; (`cperl-fontify-syntaxically'): Use `cperl-unwind-to-safe' to start at reasonable position. ! ! ;;;; After 3.15: ! ;;; (`cperl-forward-re'): Highlight the trailing / in s/foo// as string. ! ;;; Highlight the starting // in s//foo/ as function-name. ! ! ;;;; After 3.16: ! ;;; (`cperl-find-pods-heres'): Highlight `gem' in s///gem as a keyword. ! ! ;;;; After 4.0: ! ;;; (`cperl-find-pods-heres'): `qr' added ! ;;; (`cperl-electric-keyword'): Likewise ! ;;; (`cperl-electric-else'): Likewise ! ;;; (`cperl-to-comment-or-eol'): Likewise ! ;;; (`cperl-make-regexp-x'): Likewise ! ;;; (`cperl-init-faces'): Likewise, and `lock' (as overridable?). ! ;;; (`cperl-find-pods-heres'): Knows that split// is null-RE. ! ;;; Highlights separators in 3-parts expressions ! ;;; as labels. ! ! ;;;; After 4.1: ! ;;; (`cperl-find-pods-heres'): <> was considered as a glob ! ;;; (`cperl-syntaxify-unwind'): New configuration variable ! ;;; (`cperl-fontify-m-as-s'): New configuration variable ! ! ;;;; After 4.2: ! ;;; (`cperl-find-pods-heres'): of the last line being `=head1' fixed. ! ! ;;; Handling of a long construct is still buggy if only the part of ! ;;; construct touches the updated region (we unwind to the start of ! ;;; long construct, but the end may have residual properties). ! ! ;;; (`cperl-unwind-to-safe'): would not go to beginning of buffer. ! ;;; (`cperl-electric-pod'): check for after-expr was performed ! ;;; inside of POD too. ! ! ;;;; After 4.3: ! ;;; (`cperl-backward-to-noncomment'): better treatment of PODs and HEREs. ! ! ;;; Indent-line works good, but indent-region does not - at toplevel... ! ;;; (`cperl-unwind-to-safe'): Signature changed. ! ;;; (`x-color-defined-p'): was defmacro'ed with a tick. Remove another def. ! ;;; (`cperl-clobber-mode-lists'): New configuration variable. ! ;;; (`cperl-array-face'): One of definitions was garbled. ! ! ;;;; After 4.4: ! ;;; (`cperl-not-bad-regexp'): Updated. ! ;;; (`cperl-make-regexp-x'): Misprint in a message. ! ;;; (`cperl-find-pods-heres'): $a-1 ? foo : bar; was a regexp. ! ;;; `<< (' was considered a start of POD. ! ;;; Init: `cperl-is-face' was busted. ! ;;; (`cperl-make-face'): New macros. ! ;;; (`cperl-force-face'): New macros. ! ;;; (`cperl-init-faces'): Corrected to use new macros; ! ;;; `if' for copying `reference-face' to ! ;;; `constant-face' was backward. ! ;;; (`font-lock-other-type-face'): Done via `defface' too. ! ! ;;; Code: ! ! ! (if (fboundp 'eval-when-compile) ! (eval-when-compile ! (condition-case nil ! (require 'custom) ! (error nil)) ! (or (fboundp 'defgroup) ! (defmacro defgroup (name val doc &rest arr) ! nil)) ! (or (fboundp 'custom-declare-variable) ! (defmacro defcustom (name val doc &rest arr) ! (` (defvar (, name) (, val) (, doc))))) ! (or (and (fboundp 'custom-declare-variable) ! (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work ! (defmacro defface (&rest arr) ! nil)) ! ;; Avoid warning (tmp definitions) ! (or (fboundp 'x-color-defined-p) ! (defmacro x-color-defined-p (col) ! (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col)))) ! ;; XEmacs >= 19.12 ! ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) ! ;; XEmacs 19.11 ! (t (` (x-valid-color-name-p (, col))))))) ! (defmacro cperl-is-face (arg) ; Takes quoted arg ! (cond ((fboundp 'find-face) ! (` (find-face (, arg)))) ! (;;(and (fboundp 'face-list) ! ;; (face-list)) ! (fboundp 'face-list) ! (` (member (, arg) (and (fboundp 'face-list) ! (face-list))))) ! (t ! (` (boundp (, arg)))))) ! (defmacro cperl-make-face (arg descr) ; Takes unquoted arg ! (cond ((fboundp 'make-face) ! (` (make-face (quote (, arg))))) ! (t ! (` (defconst (, arg) (quote (, arg)) (, descr)))))) ! (defmacro cperl-force-face (arg descr) ; Takes unquoted arg ! (` (progn ! (or (cperl-is-face (quote (, arg))) ! (cperl-make-face (, arg) (, descr))) ! (or (boundp (quote (, arg))) ; We use unquoted variants too ! (defconst (, arg) (quote (, arg)) (, descr)))))))) ! ! (require 'custom) ! (defun cperl-choose-color (&rest list) ! (let (answer) ! (while list ! (or answer ! (if (or (x-color-defined-p (car list)) ! (null (cdr list))) ! (setq answer (car list)))) ! (setq list (cdr list))) ! answer)) ! ! (defgroup cperl nil ! "Major mode for editing Perl code." ! :prefix "cperl-" ! :group 'languages) ! ! (defgroup cperl-indentation-details nil ! "Indentation." ! :prefix "cperl-" ! :group 'cperl) ! ! (defgroup cperl-affected-by-hairy nil ! "Variables affected by `cperl-hairy'." ! :prefix "cperl-" ! :group 'cperl) ! ! (defgroup cperl-autoinsert-details nil ! "Auto-insert tuneup." ! :prefix "cperl-" ! :group 'cperl) ! ! (defgroup cperl-faces nil ! "Fontification colors." ! :prefix "cperl-" ! :group 'cperl) ! ! (defgroup cperl-speed nil ! "Speed vs. validity tuneup." ! :prefix "cperl-" ! :group 'cperl) ! ! (defgroup cperl-help-system nil ! "Help system tuneup." ! :prefix "cperl-" ! :group 'cperl) ! ! ! (defcustom cperl-extra-newline-before-brace nil "*Non-nil means that if, elsif, while, until, else, for, foreach and do constructs look like: *************** *** 477,628 **** if () { } ! ") ! (defvar cperl-indent-level 2 ! "*Indentation of CPerl statements with respect to containing block.") ! (defvar cperl-lineup-step nil "*`cperl-lineup' will always lineup at multiple of this number. ! If `nil', the value of `cperl-indent-level' will be used.") ! (defvar cperl-brace-imaginary-offset 0 "*Imagined indentation of a Perl open brace that actually follows a statement. An open brace following other text is treated as if it were this far ! to the right of the start of its line.") ! (defvar cperl-brace-offset 0 ! "*Extra indentation for braces, compared with other text in same context.") ! (defvar cperl-label-offset -2 ! "*Offset of CPerl label lines relative to usual indentation.") ! (defvar cperl-min-label-indent 1 ! "*Minimal offset of CPerl label lines.") ! (defvar cperl-continued-statement-offset 2 ! "*Extra indent for lines not starting new statements.") ! (defvar cperl-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. ! This is in addition to cperl-continued-statement-offset.") ! (defvar cperl-close-paren-offset -1 ! "*Extra indent for substatements that start with close-parenthesis.") ! (defvar cperl-auto-newline nil "*Non-nil means automatically newline before and after braces, ! and after colons and semicolons, inserted in CPerl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and ! `cperl-auto-newline-after-colon' set.") ! (defvar cperl-auto-newline-after-colon nil "*Non-nil means automatically newline even after colons. ! Subject to `cperl-auto-newline' setting.") ! (defvar cperl-tab-always-indent t "*Non-nil means TAB in CPerl mode should always reindent the current line, ! regardless of where in the line point is when the TAB command is used.") ! (defvar cperl-font-lock nil "*Non-nil (and non-null) means CPerl buffers will use font-lock-mode. ! Can be overwritten by `cperl-hairy' if nil.") ! (defvar cperl-electric-lbrace-space nil "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '. ! Can be overwritten by `cperl-hairy' if nil.") ! (defvar cperl-electric-parens-string "({[]})<" "*String of parentheses that should be electric in CPerl. ! Closing ones are electric only if the region is highlighted.") ! (defvar cperl-electric-parens nil "*Non-nil (and non-null) means parentheses should be electric in CPerl. ! Can be overwritten by `cperl-hairy' if nil.") ! (defvar cperl-electric-parens-mark (and window-system (or (and (boundp 'transient-mark-mode) ; For Emacs transient-mark-mode) (and (boundp 'zmacs-regions) ; For XEmacs zmacs-regions))) "*Not-nil means that electric parens look for active mark. ! Default is yes if there is visual feedback on mark.") ! (defvar cperl-electric-linefeed nil "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy. In any case these two mean plain and hairy linefeeds together. ! Can be overwritten by `cperl-hairy' if nil.") ! (defvar cperl-electric-keywords nil "*Not-nil (and non-null) means keywords are electric in CPerl. ! Can be overwritten by `cperl-hairy' if nil.") ! ! (defvar cperl-hairy nil ! "*Not-nil means all the bells and whistles are enabled in CPerl.") ! ! (defvar cperl-comment-column 32 ! "*Column to put comments in CPerl (use \\[cperl-indent]' to lineup with code).") ! ! (defvar cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;") ! (RCS "$rcs = ' $Id\$ ' ;")) ! "*What to use as `vc-header-alist' in CPerl.") ! (defvar cperl-info-on-command-no-prompt nil "*Not-nil (and non-null) means not to prompt on C-h f. The opposite behaviour is always available if prefixed with C-c. ! Can be overwritten by `cperl-hairy' if nil.") ! (defvar cperl-lazy-help-time nil ! "*Not-nil (and non-null) means to show lazy help after given idle time.") ! ! (defvar cperl-pod-face 'font-lock-comment-face ! "*The result of evaluation of this expression is used for pod highlighting.") ! ! (defvar cperl-pod-head-face 'font-lock-variable-name-face "*The result of evaluation of this expression is used for pod highlighting. ! Font for POD headers.") ! ! (defvar cperl-here-face 'font-lock-string-face ! "*The result of evaluation of this expression is used for here-docs highlighting.") ! ! (defvar cperl-pod-here-fontify '(featurep 'font-lock) ! "*Not-nil after evaluation means to highlight pod and here-docs sections.") ! (defvar cperl-pod-here-scan t "*Not-nil means look for pod and here-docs sections during startup. ! You can always make lookup from menu or using \\[cperl-find-pods-heres].") ! (defvar cperl-imenu-addback nil "*Not-nil means add backreferences to generated `imenu's. ! May require patched `imenu' and `imenu-go'.") ! (defvar cperl-max-help-size 66 ! "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents.") ! ! (defvar cperl-shrink-wrap-info-frame t ! "*Non-nil means shrink-wrapping of info-buffer-frame allowed.") ! ! (defvar cperl-info-page "perl" "*Name of the info page containing perl docs. ! Older version of this page was called `perl5', newer `perl'.") ! (defvar cperl-use-syntax-table-text-property (boundp 'parse-sexp-lookup-properties) ! "*Non-nil means CPerl sets up and uses `syntax-table' text property.") ! (defvar cperl-use-syntax-table-text-property-for-tags cperl-use-syntax-table-text-property ! "*Non-nil means: set up and use `syntax-table' text property generating TAGS.") ! ! (defvar cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$" ! "*Regexp to match files to scan when generating TAGS.") ! ! (defvar cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$" ! "*Regexp to match files/dirs to skip when generating TAGS.") ! (defvar cperl-regexp-indent-step nil ! "*indentation used when beautifying regexps. ! If `nil', the value of `cperl-indent-level' will be used.") ! ! (defvar cperl-indent-left-aligned-comments t ! "*Non-nil means that the comment starting in leftmost column should indent.") ! ! (defvar cperl-under-as-char t ! "*Non-nil means that the _ (underline) should be treated as word char.") --- 908,1277 ---- if () { } ! " ! :type 'boolean ! :group 'cperl-autoinsert-details) ! ! (defcustom cperl-extra-newline-before-brace-multiline ! cperl-extra-newline-before-brace ! "*Non-nil means the same as `cperl-extra-newline-before-brace', but ! for constructs with multiline if/unless/while/until/for/foreach condition." ! :type 'boolean ! :group 'cperl-autoinsert-details) ! ! (defcustom cperl-indent-level 2 ! "*Indentation of CPerl statements with respect to containing block." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-lineup-step nil "*`cperl-lineup' will always lineup at multiple of this number. ! If `nil', the value of `cperl-indent-level' will be used." ! :type '(choice (const nil) integer) ! :group 'cperl-indentation-details) ! ! (defcustom cperl-brace-imaginary-offset 0 "*Imagined indentation of a Perl open brace that actually follows a statement. An open brace following other text is treated as if it were this far ! to the right of the start of its line." ! :type 'integer ! :group 'cperl-indentation-details) ! ! (defcustom cperl-brace-offset 0 ! "*Extra indentation for braces, compared with other text in same context." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-label-offset -2 ! "*Offset of CPerl label lines relative to usual indentation." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-min-label-indent 1 ! "*Minimal offset of CPerl label lines." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-continued-statement-offset 2 ! "*Extra indent for lines not starting new statements." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. ! This is in addition to cperl-continued-statement-offset." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-close-paren-offset -1 ! "*Extra indent for substatements that start with close-parenthesis." ! :type 'integer ! :group 'cperl-indentation-details) ! (defcustom cperl-auto-newline nil "*Non-nil means automatically newline before and after braces, ! and after colons and semicolons, inserted in CPerl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and ! `cperl-auto-newline-after-colon' set." ! :type 'boolean ! :group 'cperl-autoinsert-details) ! (defcustom cperl-auto-newline-after-colon nil "*Non-nil means automatically newline even after colons. ! Subject to `cperl-auto-newline' setting." ! :type 'boolean ! :group 'cperl-autoinsert-details) ! (defcustom cperl-tab-always-indent t "*Non-nil means TAB in CPerl mode should always reindent the current line, ! regardless of where in the line point is when the TAB command is used." ! :type 'boolean ! :group 'cperl-indentation-details) ! (defcustom cperl-font-lock nil "*Non-nil (and non-null) means CPerl buffers will use font-lock-mode. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! (defcustom cperl-electric-lbrace-space nil "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! (defcustom cperl-electric-parens-string "({[]})<" "*String of parentheses that should be electric in CPerl. ! Closing ones are electric only if the region is highlighted." ! :type 'string ! :group 'cperl-affected-by-hairy) ! (defcustom cperl-electric-parens nil "*Non-nil (and non-null) means parentheses should be electric in CPerl. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! ! (defvar zmacs-regions) ; Avoid warning ! ! (defcustom cperl-electric-parens-mark (and window-system (or (and (boundp 'transient-mark-mode) ; For Emacs transient-mark-mode) (and (boundp 'zmacs-regions) ; For XEmacs zmacs-regions))) "*Not-nil means that electric parens look for active mark. ! Default is yes if there is visual feedback on mark." ! :type 'boolean ! :group 'cperl-autoinsert-details) ! (defcustom cperl-electric-linefeed nil "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy. In any case these two mean plain and hairy linefeeds together. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! (defcustom cperl-electric-keywords nil "*Not-nil (and non-null) means keywords are electric in CPerl. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! ! (defcustom cperl-hairy nil ! "*Not-nil means most of the bells and whistles are enabled in CPerl. ! Affects: `cperl-font-lock', `cperl-electric-lbrace-space', ! `cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords', ! `cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings', ! `cperl-lazy-help-time'." ! :type 'boolean ! :group 'cperl-affected-by-hairy) ! ! (defcustom cperl-comment-column 32 ! "*Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)." ! :type 'integer ! :group 'cperl-indentation-details) ! ! (defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;") ! (RCS "$rcs = ' $Id\$ ' ;")) ! "*What to use as `vc-header-alist' in CPerl." ! :type '(repeat (list symbol string)) ! :group 'cperl) ! ! (defcustom cperl-clobber-mode-lists ! (not ! (and ! (boundp 'interpreter-mode-alist) ! (assoc "miniperl" interpreter-mode-alist) ! (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) ! "*Whether to install us into `interpreter-' and `extension' mode lists." ! :type 'boolean ! :group 'cperl) ! (defcustom cperl-info-on-command-no-prompt nil "*Not-nil (and non-null) means not to prompt on C-h f. The opposite behaviour is always available if prefixed with C-c. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! ! (defcustom cperl-clobber-lisp-bindings nil ! "*Not-nil (and non-null) means not overwrite C-h f. ! The function is available on \\[cperl-info-on-command], \\[cperl-get-help]. ! Can be overwritten by `cperl-hairy' if nil." ! :type '(choice (const null) boolean) ! :group 'cperl-affected-by-hairy) ! ! (defcustom cperl-lazy-help-time nil ! "*Not-nil (and non-null) means to show lazy help after given idle time. ! Can be overwritten by `cperl-hairy' to be 5 sec if nil." ! :type '(choice (const null) integer) ! :group 'cperl-affected-by-hairy) ! ! (defcustom cperl-pod-face 'font-lock-comment-face ! "*The result of evaluation of this expression is used for pod highlighting." ! :type 'face ! :group 'cperl-faces) ! (defcustom cperl-pod-head-face 'font-lock-variable-name-face "*The result of evaluation of this expression is used for pod highlighting. ! Font for POD headers." ! :type 'face ! :group 'cperl-faces) ! ! (defcustom cperl-here-face 'font-lock-string-face ! "*The result of evaluation of this expression is used for here-docs highlighting." ! :type 'face ! :group 'cperl-faces) ! ! (defcustom cperl-pod-here-fontify '(featurep 'font-lock) ! "*Not-nil after evaluation means to highlight pod and here-docs sections." ! :type 'boolean ! :group 'cperl-faces) ! ! (defcustom cperl-fontify-m-as-s t ! "*Not-nil means highlight 1arg regular expressions operators same as 2arg." ! :type 'boolean ! :group 'cperl-faces) ! (defcustom cperl-pod-here-scan t "*Not-nil means look for pod and here-docs sections during startup. ! You can always make lookup from menu or using \\[cperl-find-pods-heres]." ! :type 'boolean ! :group 'cperl-speed) ! (defcustom cperl-imenu-addback nil "*Not-nil means add backreferences to generated `imenu's. ! May require patched `imenu' and `imenu-go'. Obsolete." ! :type 'boolean ! :group 'cperl-help-system) ! ! (defcustom cperl-max-help-size 66 ! "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents." ! :type '(choice integer (const nil)) ! :group 'cperl-help-system) ! ! (defcustom cperl-shrink-wrap-info-frame t ! "*Non-nil means shrink-wrapping of info-buffer-frame allowed." ! :type 'boolean ! :group 'cperl-help-system) ! (defcustom cperl-info-page "perl" "*Name of the info page containing perl docs. ! Older version of this page was called `perl5', newer `perl'." ! :type 'string ! :group 'cperl-help-system) ! (defcustom cperl-use-syntax-table-text-property (boundp 'parse-sexp-lookup-properties) ! "*Non-nil means CPerl sets up and uses `syntax-table' text property." ! :type 'boolean ! :group 'cperl-speed) ! (defcustom cperl-use-syntax-table-text-property-for-tags cperl-use-syntax-table-text-property ! "*Non-nil means: set up and use `syntax-table' text property generating TAGS." ! :type 'boolean ! :group 'cperl-speed) ! ! (defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$" ! "*Regexp to match files to scan when generating TAGS." ! :type 'regexp ! :group 'cperl) ! ! (defcustom cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$" ! "*Regexp to match files/dirs to skip when generating TAGS." ! :type 'regexp ! :group 'cperl) ! ! (defcustom cperl-regexp-indent-step nil ! "*Indentation used when beautifying regexps. ! If `nil', the value of `cperl-indent-level' will be used." ! :type '(choice integer (const nil)) ! :group 'cperl-indentation-details) ! ! (defcustom cperl-indent-left-aligned-comments t ! "*Non-nil means that the comment starting in leftmost column should indent." ! :type 'boolean ! :group 'cperl-indentation-details) ! ! (defcustom cperl-under-as-char t ! "*Non-nil means that the _ (underline) should be treated as word char." ! :type 'boolean ! :group 'cperl) ! ! (defcustom cperl-extra-perl-args "" ! "*Extra arguments to use when starting Perl. ! Currently used with `cperl-check-syntax' only." ! :type 'string ! :group 'cperl) ! ! (defcustom cperl-message-electric-keyword t ! "*Non-nil means that the `cperl-electric-keyword' prints a help message." ! :type 'boolean ! :group 'cperl-help-system) ! ! (defcustom cperl-indent-region-fix-constructs 1 ! "*Amount of space to insert between `}' and `else' or `elsif' ! in `cperl-indent-region'. Set to nil to leave as is. Values other ! than 1 and nil will probably not work." ! :type '(choice (const nil) (const 1)) ! :group 'cperl-indentation-details) ! ! (defcustom cperl-break-one-line-blocks-when-indent t ! "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs ! need to be reformated into multiline ones when indenting a region." ! :type 'boolean ! :group 'cperl-indentation-details) ! ! (defcustom cperl-fix-hanging-brace-when-indent t ! "*Non-nil means that BLOCK-end `}' may be put on a separate line ! when indenting a region. ! Braces followed by else/elsif/while/until are excepted." ! :type 'boolean ! :group 'cperl-indentation-details) ! ! (defcustom cperl-merge-trailing-else t ! "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue ! may be merged to be on the same line when indenting a region." ! :type 'boolean ! :group 'cperl-indentation-details) ! (defcustom cperl-syntaxify-by-font-lock ! (boundp 'parse-sexp-lookup-properties) ! "*Non-nil means that CPerl uses `font-lock's routines for syntaxification. ! Having it TRUE may be not completely debugged yet." ! :type '(choice (const message) boolean) ! :group 'cperl-speed) ! ! (defcustom cperl-syntaxify-unwind ! t ! "*Non-nil means that CPerl unwinds to a start of along construction ! when syntaxifying a chunk of buffer." ! :type 'boolean ! :group 'cperl-speed) + (if window-system + (progn + (defvar cperl-dark-background + (cperl-choose-color "navy" "os2blue" "darkgreen")) + (defvar cperl-dark-foreground + (cperl-choose-color "orchid1" "orange")) + + (defface font-lock-other-type-face + (` ((((class grayscale) (background light)) + (:background "Gray90" :italic t :underline t)) + (((class grayscale) (background dark)) + (:foreground "Gray80" :italic t :underline t :bold t)) + (((class color) (background light)) + (:foreground "chartreuse3")) + (((class color) (background dark)) + (:foreground (, cperl-dark-foreground))) + (t (:bold t :underline t)))) + "Font Lock mode face used to highlight array names." + :group 'cperl-faces) + + (defface cperl-array-face + (` ((((class grayscale) (background light)) + (:background "Gray90" :bold t)) + (((class grayscale) (background dark)) + (:foreground "Gray80" :bold t)) + (((class color) (background light)) + (:foreground "Blue" :background "lightyellow2" :bold t)) + (((class color) (background dark)) + (:foreground "yellow" :background (, cperl-dark-background) :bold t)) + (t (:bold t)))) + "Font Lock mode face used to highlight array names." + :group 'cperl-faces) + + (defface cperl-hash-face + (` ((((class grayscale) (background light)) + (:background "Gray90" :bold t :italic t)) + (((class grayscale) (background dark)) + (:foreground "Gray80" :bold t :italic t)) + (((class color) (background light)) + (:foreground "Red" :background "lightyellow2" :bold t :italic t)) + (((class color) (background dark)) + (:foreground "Red" :background (, cperl-dark-background) :bold t :italic t)) + (t (:bold t :italic t)))) + "Font Lock mode face used to highlight hash names." + :group 'cperl-faces))) *************** *** 633,642 **** ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs and/or ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl Get support packages choose-color.el (or font-lock-extra.el before 19.30), imenu-go.el from the same place. \(Look for other files there ! too... ;-) Get a patch for imenu.el in 19.29. Note that for 19.30 and later you should use choose-color.el *instead* of font-lock-extra.el \(and you will not get smart highlighting in C :-(). --- 1282,1293 ---- ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs and/or ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl + Subdirectory `cperl-mode' may contain yet newer development releases and/or + patches to related files. Get support packages choose-color.el (or font-lock-extra.el before 19.30), imenu-go.el from the same place. \(Look for other files there ! too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and later you should use choose-color.el *instead* of font-lock-extra.el \(and you will not get smart highlighting in C :-(). *************** *** 649,655 **** http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz If you use imenu-go, run imenu on perl5-info buffer (you can do it ! from CPerl menu). If many files are related, generate TAGS files from Tools/Tags submenu in CPerl menu. If some class structure is too complicated, use Tools/Hierarchy-view --- 1300,1306 ---- http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz If you use imenu-go, run imenu on perl5-info buffer (you can do it ! from CPerl menu). If many files are related, generate TAGS files from Tools/Tags submenu in CPerl menu. If some class structure is too complicated, use Tools/Hierarchy-view *************** *** 665,722 **** know about them.") (defvar cperl-problems 'please-ignore-this-line ! "Emacs has a _very_ restricted syntax parsing engine. ! ! It may be corrected on the level of C code, please look in the ! `non-problems' section if you want to volunteer. ! ! CPerl mode tries to corrects some Emacs misunderstandings, however, ! for efficiency reasons the degree of correction is different for ! different operations. The partially corrected problems are: POD ! sections, here-documents, regexps. The operations are: highlighting, ! indentation, electric keywords, electric braces. This may be confusing, since the regexp s#//#/#\; may be highlighted as a comment, but it will be recognized as a regexp by the indentation ! code. Or the opposite case, when a pod section is highlighted, but may break the indentation of the following code (though indentation should work if the balance of delimiters is not broken by POD). The main trick (to make $ a \"backslash\") makes constructions like ! ${aaa} look like unbalanced braces. The only trick I can think of is to insert it as $ {aaa} (legal in perl5, not in perl4). Similar problems arise in regexps, when /(\\s|$)/ should be rewritten ! as /($|\\s)/. Note that such a transposition is not always possible ! :-(. " ) (defvar cperl-non-problems 'please-ignore-this-line ! "As you know from `problems' section, Perl syntax is too hard for CPerl. ! Most the time, if you write your own code, you may find an equivalent ! \(and almost as readable) expression. Try to help CPerl: add comments with embedded quotes to fix CPerl misunderstandings about the end of quotation: $a='500$'; # '; ! You won't need it too often. The reason: $ \"quotes\" the following character (this saves a life a lot of times in CPerl), thus due to Emacs parsing rules it does not consider tick (i.e., ' ) after a ! dollar as a closing one, but as a usual character. ! Now the indentation code is pretty wise. The only drawback is that it ! relies on Emacs parsing to find matching parentheses. And Emacs ! *cannot* match parentheses in Perl 100% correctly. So 1 if s#//#/#; ! will not break indentation, but 1 if ( s#//#/# ); ! will. By similar reasons s\"abc\"def\"; ! will confuse CPerl a lot. If you still get wrong indentation in situation that you think the code should be able to parse, try: --- 1316,1394 ---- know about them.") (defvar cperl-problems 'please-ignore-this-line ! "Some faces will not be shown on some versions of Emacs unless you ! install choose-color.el, available from ! ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/ ! ! Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs ! 20.1. Most problems below are corrected starting from this version of ! Emacs, and all of them should go with (future) RMS's version 20.3. ! ! Note that even with newer Emacsen interaction of `font-lock' and ! syntaxification is not cleaned up. You may get slightly different ! colors basing on the order of fontification and syntaxification. This ! might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but ! the corresponding code is still extremely buggy. ! ! Even with older Emacsen CPerl mode tries to corrects some Emacs ! misunderstandings, however, for efficiency reasons the degree of ! correction is different for different operations. The partially ! corrected problems are: POD sections, here-documents, regexps. The ! operations are: highlighting, indentation, electric keywords, electric ! braces. This may be confusing, since the regexp s#//#/#\; may be highlighted as a comment, but it will be recognized as a regexp by the indentation ! code. Or the opposite case, when a pod section is highlighted, but may break the indentation of the following code (though indentation should work if the balance of delimiters is not broken by POD). The main trick (to make $ a \"backslash\") makes constructions like ! ${aaa} look like unbalanced braces. The only trick I can think of is to insert it as $ {aaa} (legal in perl5, not in perl4). Similar problems arise in regexps, when /(\\s|$)/ should be rewritten ! as /($|\\s)/. Note that such a transposition is not always possible. ! ! The solution is to upgrade your Emacs. Note that RMS's 20.2 has some ! bugs related to `syntax-table' text properties. Patches are available ! on the main CPerl download site, and on CPAN. ! ! If these bugs cannot be fixed on your machine (say, you have an inferior ! environment and cannot recompile), you may still disable all the fancy stuff ! via `cperl-use-syntax-table-text-property'." ) (defvar cperl-non-problems 'please-ignore-this-line ! "As you know from `problems' section, Perl syntax is too hard for CPerl on ! older Emacsen. ! Most of the time, if you write your own code, you may find an equivalent ! \(and almost as readable) expression (what is discussed below is usually ! not relevant on newer Emacsen, since they can do it automatically). Try to help CPerl: add comments with embedded quotes to fix CPerl misunderstandings about the end of quotation: $a='500$'; # '; ! You won't need it too often. The reason: $ \"quotes\" the following character (this saves a life a lot of times in CPerl), thus due to Emacs parsing rules it does not consider tick (i.e., ' ) after a ! dollar as a closing one, but as a usual character. This is usually ! correct, but not in the above context. ! Even with older Emacsen the indentation code is pretty wise. The only ! drawback is that it relied on Emacs parsing to find matching ! parentheses. And Emacs *could not* match parentheses in Perl 100% ! correctly. So 1 if s#//#/#; ! would not break indentation, but 1 if ( s#//#/# ); ! would. Upgrade. By similar reasons s\"abc\"def\"; ! would confuse CPerl a lot. If you still get wrong indentation in situation that you think the code should be able to parse, try: *************** *** 724,733 **** a) Check what Emacs thinks about balance of your parentheses. b) Supply the code to me (IZ). ! Pods are treated _very_ rudimentally. Here-documents are not treated ! at all (except highlighting and inhibiting indentation). (This may ! change some time. RMS approved making syntax lookup recognize text ! attributes, but volunteers are needed to change Emacs C code.) To speed up coloring the following compromises exist: a) sub in $mypackage::sub may be highlighted. --- 1396,1403 ---- a) Check what Emacs thinks about balance of your parentheses. b) Supply the code to me (IZ). ! Pods were treated _very_ rudimentally. Here-documents were not ! treated at all (except highlighting and inhibiting indentation). Upgrade. To speed up coloring the following compromises exist: a) sub in $mypackage::sub may be highlighted. *************** *** 735,746 **** c) if your regexp contains a keyword (like \"s\"), it may be highlighted. ! Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove `car' before `imenu-choose-buffer-index' in `imenu'. ! ") (defvar cperl-praise 'please-ignore-this-line ! "RMS asked me to list good things about CPerl. Here they go: 0) It uses the newest `syntax-table' property ;-); --- 1405,1419 ---- c) if your regexp contains a keyword (like \"s\"), it may be highlighted. ! Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove `car' before `imenu-choose-buffer-index' in `imenu'. ! `imenu-add-to-menubar' in 20.2 is broken. ! A lot of things on XEmacs may be broken too, judging by bug reports I ! recieve. Note that some releases of XEmacs are better than the others ! as far as bugs reports I see are concerned.") (defvar cperl-praise 'please-ignore-this-line ! "RMS asked me to list good things about CPerl. Here they go: 0) It uses the newest `syntax-table' property ;-); *************** *** 749,755 **** without `syntax-table' property; When using this property, it should handle 99.995% of lines correct - or somesuch. ! 2) It is generally belived to be \"the most user-friendly Emacs package\" whatever it may mean (I doubt that the people who say similar things tried _all_ the rest of Emacs ;-), but this was not a lonely voice); --- 1422,1428 ---- without `syntax-table' property; When using this property, it should handle 99.995% of lines correct - or somesuch. ! 2) It is generally believed to be \"the most user-friendly Emacs package\" whatever it may mean (I doubt that the people who say similar things tried _all_ the rest of Emacs ;-), but this was not a lonely voice); *************** *** 780,786 **** namespaces in Perl have different colors); i) Can construct TAGS basing on its knowledge of Perl syntax, the standard menu has 6 different way to generate ! TAGS (if by directory, .xs files - with C-language bindings - are included in the scan); j) Can build a hierarchical view of classes (via imenu) basing on generated TAGS file; --- 1453,1459 ---- namespaces in Perl have different colors); i) Can construct TAGS basing on its knowledge of Perl syntax, the standard menu has 6 different way to generate ! TAGS (if \"by directory\", .xs files - with C-language bindings - are included in the scan); j) Can build a hierarchical view of classes (via imenu) basing on generated TAGS file; *************** *** 788,831 **** for electric logical constructs while () {} with different styles of expansion (context sensitive ! to be not so bothering). Electric parentheses behave \"as they should\" in a presence of a visible region. l) Changes msb.el \"on the fly\" to insert a group \"Perl files\"; 5) The indentation engine was very smart, but most of tricks may be ! not needed anymore with the support for `syntax-table' property. Has progress indicator for indentation (with `imenu' loaded). ! 6) Indent-region improves inline-comments as well; 7) Fill-paragraph correctly handles multi-line comments; ") ;;; Portability stuff: ! (defmacro cperl-define-key (fsf-key definition &optional xemacs-key) (` (define-key cperl-mode-map (, (if xemacs-key ! (` (if cperl-xemacs-p (, xemacs-key) (, fsf-key))) ! fsf-key)) (, definition)))) ! (defvar del-back-ch (car (append (where-is-internal 'delete-backward-char) ! (where-is-internal 'backward-delete-char-untabify))) "Character generated by key bound to delete-backward-char.") ! (and (vectorp del-back-ch) (= (length del-back-ch) 1) ! (setq del-back-ch (aref del-back-ch 0))) (if cperl-xemacs-p (progn ;; "Active regions" are on: use region only if active ;; "Active regions" are off: use region unconditionally (defun cperl-use-region-p () ! (if zmacs-regions (mark) t)) ! (defun cperl-mark-active () (mark))) (defun cperl-use-region-p () (if transient-mark-mode mark-active t)) (defun cperl-mark-active () mark-active)) --- 1461,1566 ---- for electric logical constructs while () {} with different styles of expansion (context sensitive ! to be not so bothering). Electric parentheses behave \"as they should\" in a presence of a visible region. l) Changes msb.el \"on the fly\" to insert a group \"Perl files\"; + m) Can convert from + if (A) { B } + to + B if A; + + n) Highlights (by user-choice) either 3-delimiters constructs + (such as tr/a/b/), or regular expressions and `y/tr'. 5) The indentation engine was very smart, but most of tricks may be ! not needed anymore with the support for `syntax-table' property. Has progress indicator for indentation (with `imenu' loaded). ! 6) Indent-region improves inline-comments as well; also corrects ! whitespace *inside* the conditional/loop constructs. 7) Fill-paragraph correctly handles multi-line comments; + + 8) Can switch to different indentation styles by one command, and restore + the settings present before the switch. + + 9) When doing indentation of control constructs, may correct + line-breaks/spacing between elements of the construct. + ") + + (defvar cperl-speed 'please-ignore-this-line + "This is an incomplete compendium of what is available in other parts + of CPerl documentation. (Please inform me if I skept anything.) + + There is a perception that CPerl is slower than alternatives. This part + of documentation is designed to overcome this misconception. + + *By default* CPerl tries to enable the most comfortable settings. + From most points of view, correctly working package is infinitely more + comfortable than a non-correctly working one, thus by default CPerl + prefers correctness over speed. Below is the guide how to change + settings if your preferences are different. + + A) Speed of loading the file. When loading file, CPerl may perform a + scan which indicates places which cannot be parsed by primitive Emacs + syntax-parsing routines, and marks them up so that either + + A1) CPerl may work around these deficiencies (for big chunks, mostly + PODs and HERE-documents), or + A2) On capable Emaxen CPerl will use improved syntax-handlings + which reads mark-up hints directly. + + The scan in case A2 is much more comprehensive, thus may be slower. + + User can disable syntax-engine-helping scan of A2 by setting + `cperl-use-syntax-table-text-property' + variable to nil (if it is set to t). + + One can disable the scan altogether (both A1 and A2) by setting + `cperl-pod-here-scan' + to nil. + + B) Speed of editing operations. + + One can add a (minor) speedup to editing operations by setting + `cperl-use-syntax-table-text-property' + variable to nil (if it is set to t). This will disable + syntax-engine-helping scan, thus will make many more Perl + constructs be wrongly recognized by CPerl, thus may lead to + wrongly matched parentheses, wrong indentation, etc. + + One can unset `cperl-syntaxify-unwind'. This might speed up editing + of, say, long POD sections. ") ;;; Portability stuff: ! (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) ! ! (defmacro cperl-define-key (emacs-key definition &optional xemacs-key) (` (define-key cperl-mode-map (, (if xemacs-key ! (` (if cperl-xemacs-p (, xemacs-key) (, emacs-key))) ! emacs-key)) (, definition)))) ! (defvar cperl-del-back-ch ! (car (append (where-is-internal 'delete-backward-char) ! (where-is-internal 'backward-delete-char-untabify))) "Character generated by key bound to delete-backward-char.") ! (and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) ! (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) + (defun cperl-mark-active () (mark)) ; Avoid undefined warning (if cperl-xemacs-p (progn ;; "Active regions" are on: use region only if active ;; "Active regions" are off: use region unconditionally (defun cperl-use-region-p () ! (if zmacs-regions (mark) t))) (defun cperl-use-region-p () (if transient-mark-mode mark-active t)) (defun cperl-mark-active () mark-active)) *************** *** 833,846 **** (defsubst cperl-enable-font-lock () (or cperl-xemacs-p window-system)) (if (boundp 'unread-command-events) (if cperl-xemacs-p (defun cperl-putback-char (c) ; XEmacs >= 19.12 ! (setq unread-command-events (list (character-to-event c)))) ! (defun cperl-putback-char (c) ; Emacs 19 ! (setq unread-command-events (list c)))) (defun cperl-putback-char (c) ; XEmacs <= 19.11 ! (setq unread-command-event (character-to-event c)))) (or (fboundp 'uncomment-region) (defun uncomment-region (beg end) --- 1568,1582 ---- (defsubst cperl-enable-font-lock () (or cperl-xemacs-p window-system)) + (defun cperl-putback-char (c) ; Emacs 19 + (set 'unread-command-events (list c))) ; Avoid undefined warning + (if (boundp 'unread-command-events) (if cperl-xemacs-p (defun cperl-putback-char (c) ; XEmacs >= 19.12 ! (setq unread-command-events (list (eval '(character-to-event c)))))) (defun cperl-putback-char (c) ; XEmacs <= 19.11 ! (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings (or (fboundp 'uncomment-region) (defun uncomment-region (beg end) *************** *** 853,873 **** 'lazy-lock) "Text property which inhibits refontification.") ! (defsubst cperl-put-do-not-fontify (from to) ! (put-text-property (max (point-min) (1- from)) ! to cperl-do-not-fontify t)) ! ! (defvar cperl-mode-hook nil ! "Hook run by `cperl-mode'.") ! ;;; Probably it is too late to set these guys already, but it can help later: ! (setq auto-mode-alist (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) ! (and (boundp 'interpreter-mode-alist) ! (setq interpreter-mode-alist (append interpreter-mode-alist ! '(("miniperl" . perl-mode))))) (if (fboundp 'eval-when-compile) (eval-when-compile (condition-case nil --- 1589,1626 ---- 'lazy-lock) "Text property which inhibits refontification.") ! (defsubst cperl-put-do-not-fontify (from to &optional post) ! ;; If POST, do not do it with postponed fontification ! (if (and post cperl-syntaxify-by-font-lock) ! nil ! (put-text-property (max (point-min) (1- from)) ! to cperl-do-not-fontify t))) ! ! (defcustom cperl-mode-hook nil ! "Hook run by `cperl-mode'." ! :type 'hook ! :group 'cperl) ! ! (defvar cperl-syntax-state nil) ! (defvar cperl-syntax-done-to nil) ! (defvar cperl-emacs-can-parse (> (length (save-excursion ! (parse-partial-sexp 1 1))) 9)) ! ! ;; Make customization possible "in reverse" ! (defsubst cperl-val (symbol &optional default hairy) ! (cond ! ((eq (symbol-value symbol) 'null) default) ! (cperl-hairy (or hairy t)) ! (t (symbol-value symbol)))) ;;; Probably it is too late to set these guys already, but it can help later: ! (and cperl-clobber-mode-lists ! (setq auto-mode-alist (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) ! (and (boundp 'interpreter-mode-alist) ! (setq interpreter-mode-alist (append interpreter-mode-alist ! '(("miniperl" . perl-mode)))))) (if (fboundp 'eval-when-compile) (eval-when-compile (condition-case nil *************** *** 876,889 **** (condition-case nil (require 'easymenu) (error nil)) ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, ;; macros instead of defsubsts don't work on Emacs, so we do the ! ;; expansion manually. Any other suggestions? (if (or (string-match "XEmacs\\|Lucid" emacs-version) window-system) (require 'font-lock)) ! (require 'cl) ! )) (defvar cperl-mode-abbrev-table nil "Abbrev table in use in Cperl-mode buffers.") --- 1629,1653 ---- (condition-case nil (require 'easymenu) (error nil)) + (condition-case nil + (require 'etags) + (error nil)) + (condition-case nil + (require 'timer) + (error nil)) + (condition-case nil + (require 'man) + (error nil)) + (condition-case nil + (require 'info) + (error nil)) ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, ;; macros instead of defsubsts don't work on Emacs, so we do the ! ;; expansion manually. Any other suggestions? (if (or (string-match "XEmacs\\|Lucid" emacs-version) window-system) (require 'font-lock)) ! (require 'cl))) (defvar cperl-mode-abbrev-table nil "Abbrev table in use in Cperl-mode buffers.") *************** *** 905,913 **** --- 1669,1681 ---- (cperl-define-key ":" 'cperl-electric-terminator) (cperl-define-key "\C-j" 'newline-and-indent) (cperl-define-key "\C-c\C-j" 'cperl-linefeed) + (cperl-define-key "\C-c\C-t" 'cperl-invert-if-unless) (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline) (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev) + (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix) + (cperl-define-key "\C-c\C-f" 'auto-fill-mode) (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric) + (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp) (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound (cperl-define-key [?\C-\M-\|] 'cperl-lineup [(control meta |)]) *************** *** 916,931 **** (cperl-define-key "\177" 'cperl-electric-backspace) (cperl-define-key "\t" 'cperl-indent-command) ;; don't clobber the backspace binding: ! (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command ! [(control c) (control h) f]) ! (cperl-define-key "\C-hf" ! ;;(concat (char-to-string help-char) "f") ; does not work ! 'cperl-info-on-command ! [(control h) f]) ! (cperl-define-key "\C-hv" ! ;;(concat (char-to-string help-char) "v") ; does not work ! 'cperl-get-help ! [(control h) v]) (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn --- 1684,1715 ---- (cperl-define-key "\177" 'cperl-electric-backspace) (cperl-define-key "\t" 'cperl-indent-command) ;; don't clobber the backspace binding: ! (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command ! [(control c) (control h) F]) ! (if (cperl-val 'cperl-clobber-lisp-bindings) ! (progn ! (cperl-define-key "\C-hf" ! ;;(concat (char-to-string help-char) "f") ; does not work ! 'cperl-info-on-command ! [(control h) f]) ! (cperl-define-key "\C-hv" ! ;;(concat (char-to-string help-char) "v") ; does not work ! 'cperl-get-help ! [(control h) v]) ! (cperl-define-key "\C-c\C-hf" ! ;;(concat (char-to-string help-char) "f") ; does not work ! (key-binding "\C-hf") ! [(control c) (control h) f]) ! (cperl-define-key "\C-c\C-hv" ! ;;(concat (char-to-string help-char) "v") ; does not work ! (key-binding "\C-hv") ! [(control c) (control h) v])) ! (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command ! [(control c) (control h) f]) ! (cperl-define-key "\C-c\C-hv" ! ;;(concat (char-to-string help-char) "v") ; does not work ! 'cperl-get-help ! [(control c) (control h) v])) (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn *************** *** 947,952 **** --- 1731,1738 ---- cperl-mode-map global-map))) (defvar cperl-menu) + (defvar cperl-lazy-installed) + (defvar cperl-old-style nil) (condition-case nil (progn (require 'easymenu) *************** *** 959,970 **** ["Fill paragraph/comment" cperl-fill-paragraph t] "----" ["Line up a construction" cperl-lineup (cperl-use-region-p)] ! ["Beautify a regexp" cperl-beautify-regexp ! cperl-use-syntax-table-text-property] ! ["Beautify a group in regexp" cperl-beautify-level ! cperl-use-syntax-table-text-property] ! ["Contract a group in regexp" cperl-contract-level ! cperl-use-syntax-table-text-property] "----" ["Indent region" cperl-indent-region (cperl-use-region-p)] ["Comment region" cperl-comment-region (cperl-use-region-p)] --- 1745,1761 ---- ["Fill paragraph/comment" cperl-fill-paragraph t] "----" ["Line up a construction" cperl-lineup (cperl-use-region-p)] ! ["Invert if/unless/while/until" cperl-invert-if-unless t] ! ("Regexp" ! ["Beautify" cperl-beautify-regexp ! cperl-use-syntax-table-text-property] ! ["Beautify a group" cperl-beautify-level ! cperl-use-syntax-table-text-property] ! ["Contract a group" cperl-contract-level ! cperl-use-syntax-table-text-property] ! ["Contract groups" cperl-contract-levels ! cperl-use-syntax-table-text-property]) ! ["Refresh \"hard\" constructions" cperl-find-pods-heres t] "----" ["Indent region" cperl-indent-region (cperl-use-region-p)] ["Comment region" cperl-comment-region (cperl-use-region-p)] *************** *** 1003,1034 **** ["Create tags for Perl files in (sub)directories" (cperl-write-tags nil t t t) t] ["Add tags for Perl files in (sub)directories" ! (cperl-write-tags nil nil t t) t]) ! ["Recalculate \"hard\" constructions" cperl-find-pods-heres t] ["Define word at point" imenu-go-find-at-position (fboundp 'imenu-go-find-at-position)] ["Help on function" cperl-info-on-command t] ["Help on function at point" cperl-info-on-current-command t] ["Help on symbol at point" cperl-get-help t] ! ["Auto-help on" cperl-lazy-install (fboundp 'run-with-idle-timer)] ! ["Auto-help off" cperl-lazy-unstall ! (fboundp 'run-with-idle-timer)]) ("Toggle..." ["Auto newline" cperl-toggle-auto-newline t] ["Electric parens" cperl-toggle-electric t] ["Electric keywords" cperl-toggle-abbrev t] ! ) ("Indent styles..." ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] ["FSF" (cperl-set-style "FSF") t] ["BSD" (cperl-set-style "BSD") t] ! ["Whitesmith" (cperl-set-style "Whitesmith") t]) ("Micro-docs" ["Tips" (describe-variable 'cperl-tips) t] ["Problems" (describe-variable 'cperl-problems) t] ["Non-problems" (describe-variable 'cperl-non-problems) t] ! ["Praise" (describe-variable 'cperl-praise) t])))) (error nil)) (autoload 'c-macro-expand "cmacexp" --- 1794,1838 ---- ["Create tags for Perl files in (sub)directories" (cperl-write-tags nil t t t) t] ["Add tags for Perl files in (sub)directories" ! (cperl-write-tags nil nil t t) t])) ! ("Perl docs" ["Define word at point" imenu-go-find-at-position (fboundp 'imenu-go-find-at-position)] ["Help on function" cperl-info-on-command t] ["Help on function at point" cperl-info-on-current-command t] ["Help on symbol at point" cperl-get-help t] ! ["Perldoc" cperl-perldoc t] ! ["Perldoc on word at point" cperl-perldoc-at-point t] ! ["View manpage of POD in this file" cperl-pod-to-manpage t] ! ["Auto-help on" cperl-lazy-install ! (and (fboundp 'run-with-idle-timer) ! (not cperl-lazy-installed))] ! ["Auto-help off" (eval '(cperl-lazy-unstall)) ! (and (fboundp 'run-with-idle-timer) ! cperl-lazy-installed)]) ("Toggle..." ["Auto newline" cperl-toggle-auto-newline t] ["Electric parens" cperl-toggle-electric t] ["Electric keywords" cperl-toggle-abbrev t] ! ["Fix whitespace on indent" cperl-toggle-construct-fix t] ! ["Auto fill" auto-fill-mode t]) ("Indent styles..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PerlStyle" (cperl-set-style "PerlStyle") t] ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] ["FSF" (cperl-set-style "FSF") t] ["BSD" (cperl-set-style "BSD") t] ! ["Whitesmith" (cperl-set-style "Whitesmith") t] ! ["Current" (cperl-set-style "Current") t] ! ["Memorized" (cperl-set-style-back) cperl-old-style]) ("Micro-docs" ["Tips" (describe-variable 'cperl-tips) t] ["Problems" (describe-variable 'cperl-problems) t] ["Non-problems" (describe-variable 'cperl-non-problems) t] ! ["Speed" (describe-variable 'cperl-speed) t] ! ["Praise" (describe-variable 'cperl-praise) t] ! ["CPerl mode" (describe-function 'cperl-mode) t])))) (error nil)) (autoload 'c-macro-expand "cmacexp" *************** *** 1071,1091 **** - ;; Make customization possible "in reverse" - ;;(defun cperl-set (symbol to) - ;; (or (eq (symbol-value symbol) 'null) (set symbol to))) - (defsubst cperl-val (symbol &optional default hairy) - (cond - ((eq (symbol-value symbol) 'null) default) - (cperl-hairy (or hairy t)) - (t (symbol-value symbol)))) - ;; provide an alias for working with emacs 19. the perl-mode that comes ;; with it is really bad, and this lets us seamlessly replace it. (fset 'perl-mode 'cperl-mode) ! (defvar cperl-faces-init) ;; Fix for msb.el (defvar cperl-msb-fixed nil) (defun cperl-mode () "Major mode for editing Perl code. Expression and list commands understand all C brackets. --- 1875,1892 ---- ;; provide an alias for working with emacs 19. the perl-mode that comes ;; with it is really bad, and this lets us seamlessly replace it. + ;;;###autoload (fset 'perl-mode 'cperl-mode) ! (defvar cperl-faces-init nil) ;; Fix for msb.el (defvar cperl-msb-fixed nil) + (defvar font-lock-syntactic-keywords) + (defvar perl-font-lock-keywords) + (defvar perl-font-lock-keywords-1) + (defvar perl-font-lock-keywords-2) + ;;;###autoload (defun cperl-mode () "Major mode for editing Perl code. Expression and list commands understand all C brackets. *************** *** 1094,1171 **** Delete converts tabs to spaces as it moves back. Various characters in Perl almost always come in pairs: {}, (), [], ! sometimes <>. When the user types the first, she gets the second as well, with optional special formatting done on {}. (Disabled by default.) You can always quote (with \\[quoted-insert]) the left ! \"paren\" to avoid the expansion. The processing of < is special, ! since most the time you mean \"less\". Cperl mode tries to guess whether you want to type pair <>, and inserts is if it ! appropriate. You can set `cperl-electric-parens-string' to the string that contains the parenths from the above list you want to be electrical. Electricity of parenths is controlled by `cperl-electric-parens'. You may also set `cperl-electric-parens-mark' to have electric parens look for active mark and \"embrace\" a region if possible.' CPerl mode provides expansion of the Perl control constructs: ! if, else, elsif, unless, while, until, for, and foreach. ! =========(Disabled by default, see `cperl-electric-keywords'.) ! The user types the keyword immediately followed by a space, which causes ! the construct to be expanded, and the user is positioned where she is most ! likely to want to be. ! eg. when the user types a space following \"if\" the following appears in ! the buffer: ! if () { or if () ! } { ! } ! and the cursor is between the parentheses. The user can then type some ! boolean expression within the parens. Having done that, typing ! \\[cperl-linefeed] places you, appropriately indented on a new line ! between the braces. If CPerl decides that you want to insert ! \"English\" style construct like bite if angry; ! it will not do any expansion. See also help on variable ! `cperl-extra-newline-before-brace'. \\[cperl-linefeed] is a convenience replacement for typing carriage ! return. It places you in the next line with proper indentation, or if you type it inside the inline block of control construct, like foreach (@lines) {print; print} and you are on a boundary of a statement inside braces, it will transform the construct into a multiline and will place you into an ! appropriately indented blank line. If you need a usual `newline-and-indent' behaviour, it is on \\[newline-and-indent], see documentation on `cperl-electric-linefeed'. \\{cperl-mode-map} ! Setting the variable `cperl-font-lock' to t switches on ! font-lock-mode, `cperl-electric-lbrace-space' to t switches on ! electric space between $ and {, `cperl-electric-parens-string' is the ! string that contains parentheses that should be electric in CPerl (see ! also `cperl-electric-parens-mark' and `cperl-electric-parens'), setting `cperl-electric-keywords' enables electric expansion of ! control structures in CPerl. `cperl-electric-linefeed' governs which ! one of two linefeed behavior is preferable. You can enable all these options simultaneously (recommended mode of use) by setting ! `cperl-hairy' to t. In this case you can switch separate options off ! by setting them to `null'. Note that one may undo the extra whitespace ! inserted by semis and braces in `auto-newline'-mode by consequent ! \\[cperl-electric-backspace]. If your site has perl5 documentation in info format, you can use commands \\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it. These keys run commands `cperl-info-on-current-command' and `cperl-info-on-command', which one is which is controlled by variable ! `cperl-info-on-command-no-prompt' (in turn affected by `cperl-hairy'). Even if you have no info-format documentation, short one-liner-style ! help is available on \\[cperl-get-help]. ! It is possible to show this help automatically after some idle ! time. This is regulated by variable `cperl-lazy-help-time'. Default ! with `cperl-hairy' is 5 secs idle time if the value of this variable ! is nil. It is also possible to switch this on/off from the ! menu. Requires `run-with-idle-timer'. Use \\[cperl-lineup] to vertically lineup some construction - put the beginning of the region at the start of construction, and make region --- 1895,1990 ---- Delete converts tabs to spaces as it moves back. Various characters in Perl almost always come in pairs: {}, (), [], ! sometimes <>. When the user types the first, she gets the second as well, with optional special formatting done on {}. (Disabled by default.) You can always quote (with \\[quoted-insert]) the left ! \"paren\" to avoid the expansion. The processing of < is special, ! since most the time you mean \"less\". Cperl mode tries to guess whether you want to type pair <>, and inserts is if it ! appropriate. You can set `cperl-electric-parens-string' to the string that contains the parenths from the above list you want to be electrical. Electricity of parenths is controlled by `cperl-electric-parens'. You may also set `cperl-electric-parens-mark' to have electric parens look for active mark and \"embrace\" a region if possible.' CPerl mode provides expansion of the Perl control constructs: ! ! if, else, elsif, unless, while, until, continue, do, ! for, foreach, formy and foreachmy. ! ! and POD directives (Disabled by default, see `cperl-electric-keywords'.) ! ! The user types the keyword immediately followed by a space, which ! causes the construct to be expanded, and the point is positioned where ! she is most likely to want to be. eg. when the user types a space ! following \"if\" the following appears in the buffer: if () { or if () ! } { } and the cursor is between the parentheses. The user can then ! type some boolean expression within the parens. Having done that, ! typing \\[cperl-linefeed] places you - appropriately indented - on a ! new line between the braces (if you typed \\[cperl-linefeed] in a POD ! directive line, then appropriate number of new lines is inserted). ! ! If CPerl decides that you want to insert \"English\" style construct like ! bite if angry; ! ! it will not do any expansion. See also help on variable ! `cperl-extra-newline-before-brace'. (Note that one can switch the ! help message on expansion by setting `cperl-message-electric-keyword' ! to nil.) \\[cperl-linefeed] is a convenience replacement for typing carriage ! return. It places you in the next line with proper indentation, or if you type it inside the inline block of control construct, like + foreach (@lines) {print; print} + and you are on a boundary of a statement inside braces, it will transform the construct into a multiline and will place you into an ! appropriately indented blank line. If you need a usual `newline-and-indent' behaviour, it is on \\[newline-and-indent], see documentation on `cperl-electric-linefeed'. + Use \\[cperl-invert-if-unless] to change a construction of the form + + if (A) { B } + + into + + B if A; + \\{cperl-mode-map} ! Setting the variable `cperl-font-lock' to t switches on font-lock-mode ! \(even with older Emacsen), `cperl-electric-lbrace-space' to t switches ! on electric space between $ and {, `cperl-electric-parens-string' is ! the string that contains parentheses that should be electric in CPerl ! \(see also `cperl-electric-parens-mark' and `cperl-electric-parens'), setting `cperl-electric-keywords' enables electric expansion of ! control structures in CPerl. `cperl-electric-linefeed' governs which ! one of two linefeed behavior is preferable. You can enable all these options simultaneously (recommended mode of use) by setting ! `cperl-hairy' to t. In this case you can switch separate options off ! by setting them to `null'. Note that one may undo the extra ! whitespace inserted by semis and braces in `auto-newline'-mode by ! consequent \\[cperl-electric-backspace]. If your site has perl5 documentation in info format, you can use commands \\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it. These keys run commands `cperl-info-on-current-command' and `cperl-info-on-command', which one is which is controlled by variable ! `cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings' ! \(in turn affected by `cperl-hairy'). Even if you have no info-format documentation, short one-liner-style ! help is available on \\[cperl-get-help], and one can run perldoc or ! man via menu. ! It is possible to show this help automatically after some idle time. ! This is regulated by variable `cperl-lazy-help-time'. Default with ! `cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5 ! secs idle time . It is also possible to switch this on/off from the ! menu, or via \\[cperl-toggle-autohelp]. Requires `run-with-idle-timer'. Use \\[cperl-lineup] to vertically lineup some construction - put the beginning of the region at the start of construction, and make region *************** *** 1173,1188 **** Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', `cperl-pod-face', `cperl-pod-head-face' control processing of pod and ! here-docs sections. In a future version results of scan may be used ! for indentation too, currently they are used for highlighting only. Variables controlling indentation style: `cperl-tab-always-indent' Non-nil means TAB in CPerl mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. `cperl-auto-newline' Non-nil means automatically newline before and after braces, ! and after colons and semicolons, inserted in Perl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and `cperl-auto-newline-after-colon' set. --- 1992,2009 ---- Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', `cperl-pod-face', `cperl-pod-head-face' control processing of pod and ! here-docs sections. With capable Emaxen results of scan are used ! for indentation too, otherwise they are used for highlighting only. Variables controlling indentation style: `cperl-tab-always-indent' Non-nil means TAB in CPerl mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. + `cperl-indent-left-aligned-comments' + Non-nil means that the comment starting in leftmost column should indent. `cperl-auto-newline' Non-nil means automatically newline before and after braces, ! and after colons and semicolons, inserted in Perl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and `cperl-auto-newline-after-colon' set. *************** *** 1215,1239 **** `cperl-brace-offset' -5 -8 `cperl-label-offset' -5 -8 ! If `cperl-indent-level' is 0, the statement after opening brace in column 0 is indented on `cperl-brace-offset'+`cperl-continued-statement-offset'. Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook' ! with no args." (interactive) (kill-all-local-variables) - ;;(if cperl-hairy - ;; (progn - ;; (cperl-set 'cperl-font-lock cperl-hairy) - ;; (cperl-set 'cperl-electric-lbrace-space cperl-hairy) - ;; (cperl-set 'cperl-electric-parens "{[(<") - ;; (cperl-set 'cperl-electric-keywords cperl-hairy) - ;; (cperl-set 'cperl-electric-linefeed cperl-hairy))) (use-local-map cperl-mode-map) (if (cperl-val 'cperl-electric-linefeed) (progn (local-set-key "\C-J" 'cperl-linefeed) (local-set-key "\C-C\C-J" 'newline-and-indent))) ! (if (cperl-val 'cperl-info-on-command-no-prompt) (progn ;; don't clobber the backspace binding: (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) --- 2036,2066 ---- `cperl-brace-offset' -5 -8 `cperl-label-offset' -5 -8 ! CPerl knows several indentation styles, and may bulk set the ! corresponding variables. Use \\[cperl-set-style] to do this. Use ! \\[cperl-set-style-back] to restore the memorized preexisting values ! \(both available from menu). ! ! If `cperl-indent-level' is 0, the statement after opening brace in ! column 0 is indented on ! `cperl-brace-offset'+`cperl-continued-statement-offset'. Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook' ! with no args. ! ! DO NOT FORGET to read micro-docs (available from `Perl' menu) ! or as help on variables `cperl-tips', `cperl-problems', ! `cperl-non-problems', `cperl-praise', `cperl-speed'." (interactive) (kill-all-local-variables) (use-local-map cperl-mode-map) (if (cperl-val 'cperl-electric-linefeed) (progn (local-set-key "\C-J" 'cperl-linefeed) (local-set-key "\C-C\C-J" 'newline-and-indent))) ! (if (and ! (cperl-val 'cperl-clobber-lisp-bindings) ! (cperl-val 'cperl-info-on-command-no-prompt)) (progn ;; don't clobber the backspace binding: (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) *************** *** 1250,1258 **** ("until" "until" cperl-electric-keyword 0) ("unless" "unless" cperl-electric-keyword 0) ("else" "else" cperl-electric-else 0) ("for" "for" cperl-electric-keyword 0) ("foreach" "foreach" cperl-electric-keyword 0) ! ("do" "do" cperl-electric-keyword 0))) (setq abbrevs-changed prev-a-c))) (setq local-abbrev-table cperl-mode-abbrev-table) (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0)) --- 2077,2092 ---- ("until" "until" cperl-electric-keyword 0) ("unless" "unless" cperl-electric-keyword 0) ("else" "else" cperl-electric-else 0) + ("continue" "continue" cperl-electric-else 0) ("for" "for" cperl-electric-keyword 0) ("foreach" "foreach" cperl-electric-keyword 0) ! ("formy" "formy" cperl-electric-keyword 0) ! ("foreachmy" "foreachmy" cperl-electric-keyword 0) ! ("do" "do" cperl-electric-keyword 0) ! ("pod" "pod" cperl-electric-pod 0) ! ("over" "over" cperl-electric-pod 0) ! ("head1" "head1" cperl-electric-pod 0) ! ("head2" "head2" cperl-electric-pod 0))) (setq abbrevs-changed prev-a-c))) (setq local-abbrev-table cperl-mode-abbrev-table) (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0)) *************** *** 1290,1314 **** (make-local-variable 'imenu-sort-function) (setq imenu-sort-function nil) (make-local-variable 'vc-header-alist) ! (setq vc-header-alist cperl-vc-header-alist) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults ! (if (string< emacs-version "19.30") ! '(perl-font-lock-keywords-2) '((perl-font-lock-keywords perl-font-lock-keywords-1 ! perl-font-lock-keywords-2)))) (if cperl-use-syntax-table-text-property (progn (make-variable-buffer-local 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! ! (set 'parse-sexp-lookup-properties t))) (or (fboundp 'cperl-old-auto-fill-mode) (progn (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) (defun auto-fill-mode (&optional arg) (interactive "P") ! (cperl-old-auto-fill-mode arg) (and auto-fill-function (eq major-mode 'perl-mode) (setq auto-fill-function 'cperl-do-auto-fill))))) (if (cperl-enable-font-lock) --- 2124,2173 ---- (make-local-variable 'imenu-sort-function) (setq imenu-sort-function nil) (make-local-variable 'vc-header-alist) ! (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning (make-local-variable 'font-lock-defaults) (setq font-lock-defaults ! (cond ! ((string< emacs-version "19.30") ! '(perl-font-lock-keywords-2)) ! ((string< emacs-version "19.33") ; Which one to use? '((perl-font-lock-keywords perl-font-lock-keywords-1 ! perl-font-lock-keywords-2))) ! (t ! '((cperl-load-font-lock-keywords ! cperl-load-font-lock-keywords-1 ! cperl-load-font-lock-keywords-2))))) ! (make-local-variable 'cperl-syntax-state) (if cperl-use-syntax-table-text-property (progn (make-variable-buffer-local 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! ! (set 'parse-sexp-lookup-properties t) ! ;; Fix broken font-lock: ! (or (boundp 'font-lock-unfontify-region-function) ! (set 'font-lock-unfontify-region-function ! 'font-lock-default-unfontify-buffer)) ! (make-variable-buffer-local 'font-lock-unfontify-region-function) ! (set 'font-lock-unfontify-region-function ! 'cperl-font-lock-unfontify-region-function) ! (make-variable-buffer-local 'cperl-syntax-done-to) ! ;; Another bug: unless font-lock-syntactic-keywords, font-lock ! ;; ignores syntax-table text-property. (t) is a hack ! ;; to make font-lock think that font-lock-syntactic-keywords ! ;; are defined ! (make-variable-buffer-local 'font-lock-syntactic-keywords) ! (setq font-lock-syntactic-keywords ! (if cperl-syntaxify-by-font-lock ! '(t (cperl-fontify-syntaxically)) ! '(t))))) ! (make-local-variable 'cperl-old-style) (or (fboundp 'cperl-old-auto-fill-mode) (progn (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) (defun auto-fill-mode (&optional arg) (interactive "P") ! (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning (and auto-fill-function (eq major-mode 'perl-mode) (setq auto-fill-function 'cperl-do-auto-fill))))) (if (cperl-enable-font-lock) *************** *** 1319,1330 **** (not cperl-msb-fixed) (cperl-msb-fix)) (if (featurep 'easymenu) ! (easy-menu-add cperl-menu)) ; A NOP under FSF Emacs. (run-hooks 'cperl-mode-hook) ;; After hooks since fontification will break this ! (if cperl-pod-here-scan (cperl-find-pods-heres))) ;; Fix for perldb - make default reasonable (defun cperl-db () (interactive) (require 'gud) --- 2178,2196 ---- (not cperl-msb-fixed) (cperl-msb-fix)) (if (featurep 'easymenu) ! (easy-menu-add cperl-menu)) ; A NOP in RMS Emacs. (run-hooks 'cperl-mode-hook) ;; After hooks since fontification will break this ! (if cperl-pod-here-scan ! (or ;;(and (boundp 'font-lock-mode) ! ;; (eval 'font-lock-mode) ; Avoid warning ! ;; (boundp 'font-lock-hot-pass) ; Newer font-lock ! cperl-syntaxify-by-font-lock ;;) ! (progn (or cperl-faces-init (cperl-init-faces-weak)) ! (cperl-find-pods-heres))))) ;; Fix for perldb - make default reasonable + (defvar gud-perldb-history) (defun cperl-db () (interactive) (require 'gud) *************** *** 1339,1345 **** nil nil '(gud-perldb-history . 1)))) ! (defun cperl-msb-fix () ;; Adds perl files to msb menu, supposes that msb is already loaded (setq cperl-msb-fixed t) --- 2205,2211 ---- nil nil '(gud-perldb-history . 1)))) ! (defvar msb-menu-cond) (defun cperl-msb-fix () ;; Adds perl files to msb menu, supposes that msb is already loaded (setq cperl-msb-fixed t) *************** *** 1356,1362 **** ;; This is used by indent-for-comment ;; to decide how much to indent a comment in CPerl code ! ;; based on its context. Do fallback if comment is found wrong. (defvar cperl-wrong-comment) --- 2222,2228 ---- ;; This is used by indent-for-comment ;; to decide how much to indent a comment in CPerl code ! ;; based on its context. Do fallback if comment is found wrong. (defvar cperl-wrong-comment) *************** *** 1425,1431 **** (defun cperl-electric-brace (arg &optional only-before) "Insert character and correct line's indentation. If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the ! place (even in empty line), but not after. If after \")\" and the inserted char is \"{\", insert extra newline before only if `cperl-extra-newline-before-brace'." (interactive "P") --- 2291,2297 ---- (defun cperl-electric-brace (arg &optional only-before) "Insert character and correct line's indentation. If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the ! place (even in empty line), but not after. If after \")\" and the inserted char is \"{\", insert extra newline before only if `cperl-extra-newline-before-brace'." (interactive "P") *************** *** 1447,1487 **** (setq last-command-char ?\{) (cperl-electric-lbrace arg insertpos)) (forward-char 1)) ! (if (and (not arg) ; No args, end (of empty line or auto) ! (eolp) ! (or (and (null only-before) ! (save-excursion ! (skip-chars-backward " \t") ! (bolp))) ! (and (eq last-command-char ?\{) ; Do not insert newline ! ;; if after ")" and `cperl-extra-newline-before-brace' ! ;; is nil, do not insert extra newline. ! (not cperl-extra-newline-before-brace) ! (save-excursion ! (skip-chars-backward " \t") ! (eq (preceding-char) ?\)))) ! (if cperl-auto-newline ! (progn (cperl-indent-line) (newline) t) nil))) ! (progn ! (insert last-command-char) ! (cperl-indent-line) ! (if cperl-auto-newline ! (setq insertpos (1- (point)))) ! (if (and cperl-auto-newline (null only-before)) ! (progn ! (newline) ! (cperl-indent-line))) (save-excursion ! (if insertpos (progn (goto-char insertpos) ! (search-forward (make-string ! 1 last-command-char)) ! (setq insertpos (1- (point))))) ! (delete-char -1)))) ! (if insertpos ! (save-excursion ! (goto-char insertpos) ! (self-insert-command (prefix-numeric-value arg))) ! (self-insert-command (prefix-numeric-value arg)))))) (defun cperl-electric-lbrace (arg &optional end) "Insert character, correct line's indentation, correct quoting by space." --- 2313,2364 ---- (setq last-command-char ?\{) (cperl-electric-lbrace arg insertpos)) (forward-char 1)) ! ;: Check whether we close something "usual" with `}' ! (if (and (eq last-command-char ?\}) ! (not ! (condition-case nil ! (save-excursion ! (up-list (- (prefix-numeric-value arg))) ! ;;(cperl-after-block-p (point-min)) ! (cperl-after-expr-p nil "{;)")) ! (error nil)))) ! ;; Just insert the guy ! (self-insert-command (prefix-numeric-value arg)) ! (if (and (not arg) ; No args, end (of empty line or auto) ! (eolp) ! (or (and (null only-before) ! (save-excursion ! (skip-chars-backward " \t") ! (bolp))) ! (and (eq last-command-char ?\{) ; Do not insert newline ! ;; if after ")" and `cperl-extra-newline-before-brace' ! ;; is nil, do not insert extra newline. ! (not cperl-extra-newline-before-brace) ! (save-excursion ! (skip-chars-backward " \t") ! (eq (preceding-char) ?\)))) ! (if cperl-auto-newline ! (progn (cperl-indent-line) (newline) t) nil))) ! (progn ! (self-insert-command (prefix-numeric-value arg)) ! (cperl-indent-line) ! (if cperl-auto-newline ! (setq insertpos (1- (point)))) ! (if (and cperl-auto-newline (null only-before)) ! (progn ! (newline) ! (cperl-indent-line))) ! (save-excursion ! (if insertpos (progn (goto-char insertpos) ! (search-forward (make-string ! 1 last-command-char)) ! (setq insertpos (1- (point))))) ! (delete-char -1)))) ! (if insertpos (save-excursion ! (goto-char insertpos) ! (self-insert-command (prefix-numeric-value arg))) ! (self-insert-command (prefix-numeric-value arg))))))) (defun cperl-electric-lbrace (arg &optional end) "Insert character, correct line's indentation, correct quoting by space." *************** *** 1502,1509 **** (save-excursion (skip-chars-backward "$") (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)")) ! (insert ? )) ! (if (cperl-after-expr-p nil "{;)") nil (setq cperl-auto-newline nil)) (cperl-electric-brace arg) (and (cperl-val 'cperl-electric-parens) (eq last-command-char ?{) --- 2379,2393 ---- (save-excursion (skip-chars-backward "$") (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)")) ! (insert ?\ )) ! ;; Check whether we are in comment ! (if (and ! (save-excursion ! (beginning-of-line) ! (not (looking-at "[ \t]*#"))) ! (cperl-after-expr-p nil "{;)")) ! nil ! (setq cperl-auto-newline nil)) (cperl-electric-brace arg) (and (cperl-val 'cperl-electric-parens) (eq last-command-char ?{) *************** *** 1532,1549 **** (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) ;;(not (save-excursion (search-backward "#" beg t))) (if (eq last-command-char ?<) ! (cperl-after-expr-p nil "{;(,:=") 1)) (progn ! (insert last-command-char) (if other-end (goto-char (marker-position other-end))) ! (insert (cdr (assoc last-command-char '((?{ .?}) ! (?[ . ?]) ! (?( . ?)) ! (?< . ?>))))) ! (forward-char -1)) ! (insert last-command-char) ! ))) (defun cperl-electric-rparen (arg) "Insert a matching pair of parentheses if marking is active. --- 2416,2437 ---- (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) ;;(not (save-excursion (search-backward "#" beg t))) (if (eq last-command-char ?<) ! (progn ! (and abbrev-mode ; later it is too late, may be after `for' ! (expand-abbrev)) ! (cperl-after-expr-p nil "{;(,:=")) 1)) (progn ! (self-insert-command (prefix-numeric-value arg)) (if other-end (goto-char (marker-position other-end))) ! (insert (make-string ! (prefix-numeric-value arg) ! (cdr (assoc last-command-char '((?{ .?}) ! (?[ . ?]) ! (?( . ?)) ! (?< . ?>)))))) ! (forward-char (- (prefix-numeric-value arg)))) ! (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-rparen (arg) "Insert a matching pair of parentheses if marking is active. *************** *** 1566,1620 **** ;;(not (save-excursion (search-backward "#" beg t))) ) (progn ! (insert last-command-char) (setq p (point)) (if other-end (goto-char other-end)) ! (insert (cdr (assoc last-command-char '((?\} . ?\{) (?\] . ?\[) (?\) . ?\() ! (?\> . ?\<))))) (goto-char (1+ p))) ! (call-interactively 'self-insert-command) ! ))) (defun cperl-electric-keyword () ! "Insert a construction appropriate after a keyword." (let ((beg (save-excursion (beginning-of-line) (point))) ! (dollar (eq last-command-char ?$))) (and (save-excursion ! (backward-sexp 1) (cperl-after-expr-p nil "{;:")) (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) ! (looking-at "=cut"))) (progn (and dollar (insert " $")) (cperl-indent-line) ;;(insert " () {\n}") (cond (cperl-extra-newline-before-brace ! (insert " ()\n") (insert "{") (cperl-indent-line) (insert "\n") (cperl-indent-line) ! (insert "\n}")) (t ! (insert " () {\n}")) ) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) (if dollar (progn (search-backward "$") ! (forward-char 1)) (search-backward ")")) ! (cperl-putback-char del-back-ch))))) (defun cperl-electric-else () ! "Insert a construction appropriate after a keyword." (let ((beg (save-excursion (beginning-of-line) (point)))) (and (save-excursion (backward-sexp 1) --- 2454,2617 ---- ;;(not (save-excursion (search-backward "#" beg t))) ) (progn ! (self-insert-command (prefix-numeric-value arg)) (setq p (point)) (if other-end (goto-char other-end)) ! (insert (make-string ! (prefix-numeric-value arg) ! (cdr (assoc last-command-char '((?\} . ?\{) (?\] . ?\[) (?\) . ?\() ! (?\> . ?\<)))))) (goto-char (1+ p))) ! (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-keyword () ! "Insert a construction appropriate after a keyword. ! Help message may be switched off by setting `cperl-message-electric-keyword' ! to nil." (let ((beg (save-excursion (beginning-of-line) (point))) ! (dollar (and (eq last-command-char ?$) ! (eq this-command 'self-insert-command))) ! (delete (and (memq last-command-char '(?\ ?\n ?\t ?\f)) ! (memq this-command '(self-insert-command newline)))) ! my do) (and (save-excursion ! (condition-case nil ! (progn ! (backward-sexp 1) ! (setq do (looking-at "do\\>"))) ! (error nil)) (cperl-after-expr-p nil "{;:")) (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) ! (or ! (looking-at "=cut") ! (and cperl-use-syntax-table-text-property ! (not (eq (get-text-property (point) ! 'syntax-type) ! 'pod)))))) (progn + (and (eq (preceding-char) ?y) + (progn ; "foreachmy" + (forward-char -2) + (insert " ") + (forward-char 2) + (setq my t dollar t + delete + (memq this-command '(self-insert-command newline))))) (and dollar (insert " $")) (cperl-indent-line) ;;(insert " () {\n}") (cond (cperl-extra-newline-before-brace ! (insert (if do "\n" " ()\n")) (insert "{") (cperl-indent-line) (insert "\n") (cperl-indent-line) ! (insert "\n}") ! (and do (insert " while ();"))) (t ! (insert (if do " {\n} while ();" " () {\n}"))) ) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) (if dollar (progn (search-backward "$") ! (if my ! (forward-char 1) ! (delete-char 1))) (search-backward ")")) ! (if delete ! (cperl-putback-char cperl-del-back-ch)) ! (if cperl-message-electric-keyword ! (message "Precede char by C-q to avoid expansion")))))) ! ! (defun cperl-ensure-newlines (n &optional pos) ! "Make sure there are N newlines after the point." ! (or pos (setq pos (point))) ! (if (looking-at "\n") ! (forward-char 1) ! (insert "\n")) ! (if (> n 1) ! (cperl-ensure-newlines (1- n) pos) ! (goto-char pos))) ! ! (defun cperl-electric-pod () ! "Insert a POD chunk appropriate after a =POD directive." ! (let ((delete (and (memq last-command-char '(?\ ?\n ?\t ?\f)) ! (memq this-command '(self-insert-command newline)))) ! head1 notlast name p really-delete over) ! (and (save-excursion ! (condition-case nil ! (backward-sexp 1) ! (error nil)) ! (and ! (eq (preceding-char) ?=) ! (progn ! (setq head1 (looking-at "head1\\>")) ! (setq over (looking-at "over\\>")) ! (forward-char -1) ! (bolp)) ! (or ! (get-text-property (point) 'in-pod) ! (cperl-after-expr-p nil "{;:") ! (and (re-search-backward ! "\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t) ! (not (or ! (looking-at "=cut") ! (and cperl-use-syntax-table-text-property ! (not (eq (get-text-property (point) 'syntax-type) ! 'pod))))))))) ! (progn ! (save-excursion ! (setq notlast (search-forward "\n\n=" nil t))) ! (or notlast ! (progn ! (insert "\n\n=cut") ! (cperl-ensure-newlines 2) ! (forward-sexp -2) ! (if (and head1 ! (not ! (save-excursion ! (forward-char -1) ! (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" ! nil t)))) ; Only one ! (progn ! (forward-sexp 1) ! (setq name (file-name-sans-extension ! (file-name-nondirectory (buffer-file-name))) ! p (point)) ! (insert " NAME\n\n" name ! " - \n\n=head1 SYNOPSYS\n\n\n\n" ! "=head1 DESCRIPTION") ! (cperl-ensure-newlines 4) ! (goto-char p) ! (forward-sexp 2) ! (end-of-line) ! (setq really-delete t)) ! (forward-sexp 1)))) ! (if over ! (progn ! (setq p (point)) ! (insert "\n\n=item \n\n\n\n" ! "=back") ! (cperl-ensure-newlines 2) ! (goto-char p) ! (forward-sexp 1) ! (end-of-line) ! (setq really-delete t))) ! (if (and delete really-delete) ! (cperl-putback-char cperl-del-back-ch)))))) (defun cperl-electric-else () ! "Insert a construction appropriate after a keyword. ! Help message may be switched off by setting `cperl-message-electric-keyword' ! to nil." (let ((beg (save-excursion (beginning-of-line) (point)))) (and (save-excursion (backward-sexp 1) *************** *** 1622,1631 **** (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) ! (looking-at "=cut"))) (progn (cperl-indent-line) ;;(insert " {\n\n}") --- 2619,2632 ---- (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) ! (looking-at "=cut") ! (and cperl-use-syntax-table-text-property ! (not (eq (get-text-property (point) ! 'syntax-type) ! 'pod))))) (progn (cperl-indent-line) ;;(insert " {\n\n}") *************** *** 1642,1655 **** (cperl-indent-line) (forward-line -1) (cperl-indent-line) ! (cperl-putback-char del-back-ch))))) (defun cperl-linefeed () ! "Go to end of line, open a new line and indent appropriately." (interactive) (let ((beg (save-excursion (beginning-of-line) (point))) (end (save-excursion (end-of-line) (point))) ! (pos (point)) start) (if (and ; Check if we need to split: ; i.e., on a boundary and inside "{...}" (save-excursion (cperl-to-comment-or-eol) --- 2643,2660 ---- (cperl-indent-line) (forward-line -1) (cperl-indent-line) ! (cperl-putback-char cperl-del-back-ch) ! (setq this-command 'cperl-electric-else) ! (if cperl-message-electric-keyword ! (message "Precede char by C-q to avoid expansion")))))) (defun cperl-linefeed () ! "Go to end of line, open a new line and indent appropriately. ! If in POD, insert appropriate lines." (interactive) (let ((beg (save-excursion (beginning-of-line) (point))) (end (save-excursion (end-of-line) (point))) ! (pos (point)) start over cut res) (if (and ; Check if we need to split: ; i.e., on a boundary and inside "{...}" (save-excursion (cperl-to-comment-or-eol) *************** *** 1669,1675 **** (progn (backward-sexp 1) (setq start (point-marker)) ! (<= start pos))))) ; Redundant? Are after the ; start of parens group. (progn (skip-chars-backward " \t") --- 2674,2680 ---- (progn (backward-sexp 1) (setq start (point-marker)) ! (<= start pos))))) ; Redundant? Are after the ; start of parens group. (progn (skip-chars-backward " \t") *************** *** 1702,1708 **** (forward-line -1) ; We are on the line before target (end-of-line) (newline-and-indent)) ! (end-of-line) ; else (cond ((and (looking-at "\n[ \t]*{$") (save-excursion --- 2707,2713 ---- (forward-line -1) ; We are on the line before target (end-of-line) (newline-and-indent)) ! (end-of-line) ; else - no splitting (cond ((and (looking-at "\n[ \t]*{$") (save-excursion *************** *** 1711,1716 **** --- 2716,2752 ---- ; with an extra newline. (forward-line 2) (cperl-indent-line)) + ((save-excursion ; In POD header + (forward-paragraph -1) + ;; (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\b") + ;; We are after \n now, so look for the rest + (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+") + (progn + (setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>")) + (setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>")) + t))) + (if (and over + (progn + (forward-paragraph -1) + (forward-word 1) + (setq pos (point)) + (setq cut (buffer-substring (point) + (save-excursion + (end-of-line) + (point)))) + (delete-char (- (save-excursion (end-of-line) (point)) + (point))) + (setq res (expand-abbrev)) + (save-excursion + (goto-char pos) + (insert cut)) + res)) + nil + (cperl-ensure-newlines (if cut 2 4)) + (forward-line 2))) + ((get-text-property (point) 'in-pod) ; In POD section + (cperl-ensure-newlines 4) + (forward-line 2)) ((looking-at "\n[ \t]*$") ; Next line is empty - use it. (forward-line 1) (cperl-indent-line)) *************** *** 1754,1760 **** (let ((pps (parse-partial-sexp (point) end))) (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) (progn ! (insert last-command-char) ;;(forward-char -1) (if auto (setq insertpos (point-marker))) ;;(forward-char 1) --- 2790,2796 ---- (let ((pps (parse-partial-sexp (point) end))) (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) (progn ! (self-insert-command (prefix-numeric-value arg)) ;;(forward-char -1) (if auto (setq insertpos (point-marker))) ;;(forward-char 1) *************** *** 1763,1774 **** (progn (newline) (cperl-indent-line))) - ;; (save-excursion - ;; (if insertpos (progn (goto-char (marker-position insertpos)) - ;; (search-forward (make-string - ;; 1 last-command-char)) - ;; (setq insertpos (1- (point))))) - ;; (delete-char -1)))) (save-excursion (if insertpos (goto-char (1- (marker-position insertpos))) (forward-char -1)) --- 2799,2804 ---- *************** *** 1780,1799 **** (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-backspace (arg) ! "Backspace-untabify, or remove the whitespace inserted by an electric key." (interactive "p") (if (and cperl-auto-newline (memq last-command '(cperl-electric-semi cperl-electric-terminator cperl-electric-lbrace)) ! (memq (preceding-char) '(? ?\t ?\n))) (let (p) (if (eq last-command 'cperl-electric-lbrace) (skip-chars-forward " \t\n")) (setq p (point)) (skip-chars-backward " \t\n") (delete-region (point) p)) ! (backward-delete-char-untabify arg))) (defun cperl-inside-parens-p () (condition-case () --- 2810,2841 ---- (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-backspace (arg) ! "Backspace-untabify, or remove the whitespace around the point inserted ! by an electric key." (interactive "p") (if (and cperl-auto-newline (memq last-command '(cperl-electric-semi cperl-electric-terminator cperl-electric-lbrace)) ! (memq (preceding-char) '(?\ ?\t ?\n))) (let (p) (if (eq last-command 'cperl-electric-lbrace) (skip-chars-forward " \t\n")) (setq p (point)) (skip-chars-backward " \t\n") (delete-region (point) p)) ! (and (eq last-command 'cperl-electric-else) ! ;; We are removing the whitespace *inside* cperl-electric-else ! (setq this-command 'cperl-electric-else-really)) ! (if (and cperl-auto-newline ! (eq last-command 'cperl-electric-else-really) ! (memq (preceding-char) '(?\ ?\t ?\n))) ! (let (p) ! (skip-chars-forward " \t\n") ! (setq p (point)) ! (skip-chars-backward " \t\n") ! (delete-region (point) p)) ! (backward-delete-char-untabify arg)))) (defun cperl-inside-parens-p () (condition-case () *************** *** 1807,1814 **** (defun cperl-indent-command (&optional whole-exp) "Indent current line as Perl code, or in some cases insert a tab character. ! If `cperl-tab-always-indent' is non-nil (the default), always indent current line. ! Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, --- 2849,2856 ---- (defun cperl-indent-command (&optional whole-exp) "Indent current line as Perl code, or in some cases insert a tab character. ! If `cperl-tab-always-indent' is non-nil (the default), always indent current ! line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, *************** *** 1816,1821 **** --- 2858,2864 ---- so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (interactive "P") + (cperl-update-syntaxification (point) (point)) (if whole-exp ;; If arg, always indent this line as Perl ;; and shift remaining lines of expression the same amount. *************** *** 1830,1836 **** (goto-char beg) (forward-line 1) (setq beg (point))) ! (if (> end beg) (indent-code-rigidly beg end shift-amt "#"))) (if (and (not cperl-tab-always-indent) (save-excursion --- 2873,2879 ---- (goto-char beg) (forward-line 1) (setq beg (point))) ! (if (and shift-amt (> end beg)) (indent-code-rigidly beg end shift-amt "#"))) (if (and (not cperl-tab-always-indent) (save-excursion *************** *** 1839,1856 **** (insert-tab) (cperl-indent-line)))) ! (defun cperl-indent-line (&optional symbol) "Indent current line as Perl code. Return the amount the indentation changed by." ! (let (indent ! beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) ! (setq indent (cperl-calculate-indent nil symbol)) (beginning-of-line) (setq beg (point)) (cond ((or (eq indent nil) (eq indent t)) ! (setq indent (current-indentation))) ;;((eq indent t) ; Never? ;; (setq indent (cperl-calculate-indent-within-comment))) ;;((looking-at "[ \t]*#") --- 2882,2899 ---- (insert-tab) (cperl-indent-line)))) ! (defun cperl-indent-line (&optional parse-data) "Indent current line as Perl code. Return the amount the indentation changed by." ! (let (indent i beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) ! (setq indent (cperl-calculate-indent parse-data) ! i indent) (beginning-of-line) (setq beg (point)) (cond ((or (eq indent nil) (eq indent t)) ! (setq indent (current-indentation) i nil)) ;;((eq indent t) ; Never? ;; (setq indent (cperl-calculate-indent-within-comment))) ;;((looking-at "[ \t]*#") *************** *** 1869,1876 **** ((= (following-char) ?{) (setq indent (+ indent cperl-brace-offset)))))) (skip-chars-forward " \t") ! (setq shift-amt (- indent (current-column))) ! (if (zerop shift-amt) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) --- 2912,2920 ---- ((= (following-char) ?{) (setq indent (+ indent cperl-brace-offset)))))) (skip-chars-forward " \t") ! (setq shift-amt (and i (- indent (current-column)))) ! (if (or (not shift-amt) ! (zerop shift-amt)) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) *************** *** 1882,1888 **** shift-amt)) (defun cperl-after-label () ! ;; Returns true if the point is after label. Does not do save-excursion. (and (eq (preceding-char) ?:) (memq (char-syntax (char-after (- (point) 2))) '(?w ?_)) --- 2926,2932 ---- shift-amt)) (defun cperl-after-label () ! ;; Returns true if the point is after label. Does not do save-excursion. (and (eq (preceding-char) ?:) (memq (char-syntax (char-after (- (point) 2))) '(?w ?_)) *************** *** 1893,1906 **** (defun cperl-get-state (&optional parse-start start-state) ;; returns list (START STATE DEPTH PRESTART), START is a good place ;; to start parsing, STATE is what is returned by ! ;; `parse-partial-sexp'. DEPTH is true is we are immediately after ! ;; end of block which contains START. PRESTART is the position ;; basing on which START was found. (save-excursion (let ((start-point (point)) depth state start prestart) ! (if parse-start (goto-char parse-start) ! (beginning-of-defun)) (setq prestart (point)) (if start-state nil ;; Try to go out, if sub is not on the outermost level --- 2937,2952 ---- (defun cperl-get-state (&optional parse-start start-state) ;; returns list (START STATE DEPTH PRESTART), START is a good place ;; to start parsing, STATE is what is returned by ! ;; `parse-partial-sexp'. DEPTH is true is we are immediately after ! ;; end of block which contains START. PRESTART is the position ;; basing on which START was found. (save-excursion (let ((start-point (point)) depth state start prestart) ! (if (and parse-start ! (<= parse-start start-point)) (goto-char parse-start) ! (beginning-of-defun) ! (setq start-state nil)) (setq prestart (point)) (if start-state nil ;; Try to go out, if sub is not on the outermost level *************** *** 1918,1929 **** (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) (list start state depth prestart)))) ! (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! ! ;; Positions is before ?\{. Checks whether it starts a block. ;; No save-excursion! (cperl-backward-to-noncomment (point-min)) ! ;;(skip-chars-backward " \t\n\f") ! (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp ; Label may be mixed up with `$blah :' (save-excursion (cperl-after-label)) (and (memq (char-syntax (preceding-char)) '(?w ?_)) --- 2964,2974 ---- (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) (list start state depth prestart)))) ! (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! ! ;; Positions is before ?\{. Checks whether it starts a block. ;; No save-excursion! (cperl-backward-to-noncomment (point-min)) ! (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp ; Label may be mixed up with `$blah :' (save-excursion (cperl-after-label)) (and (memq (char-syntax (preceding-char)) '(?w ?_)) *************** *** 1931,1937 **** (backward-sexp) ;; Need take into account `bless', `return', `tr',... (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax ! (not (looking-at "\\(bless\\|return\\|qw\\|tr\\|[smy]\\)\\>"))) (progn (skip-chars-backward " \t\n\f") (and (memq (char-syntax (preceding-char)) '(?w ?_)) --- 2976,2982 ---- (backward-sexp) ;; Need take into account `bless', `return', `tr',... (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax ! (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>"))) (progn (skip-chars-backward " \t\n\f") (and (memq (char-syntax (preceding-char)) '(?w ?_)) *************** *** 1942,1948 **** (defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group))) ! (defun cperl-calculate-indent (&optional parse-start symbol) "Return appropriate indentation for current line as Perl code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment." --- 2987,2993 ---- (defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group))) ! (defun cperl-calculate-indent (&optional parse-data) ; was parse-start "Return appropriate indentation for current line as Perl code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment." *************** *** 1966,1972 **** p prop look-prop) (cond (in-pod ! ;; In the verbatim part, probably code example. What to do??? ) (t (save-excursion --- 3011,3017 ---- p prop look-prop) (cond (in-pod ! ;; In the verbatim part, probably code example. What to do??? ) (t (save-excursion *************** *** 1984,1990 **** (setq pre-indent-point (point))))))) (goto-char pre-indent-point) (let* ((case-fold-search nil) ! (s-s (cperl-get-state)) (start (nth 0 s-s)) (state (nth 1 s-s)) (containing-sexp (car (cdr state))) --- 3029,3035 ---- (setq pre-indent-point (point))))))) (goto-char pre-indent-point) (let* ((case-fold-search nil) ! (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) (start (nth 0 s-s)) (state (nth 1 s-s)) (containing-sexp (car (cdr state))) *************** *** 1993,1998 **** --- 3038,3048 ---- (- (current-indentation) (if (nth 2 s-s) cperl-indent-level 0)))) old-indent) + (if parse-data + (progn + (setcar parse-data pre-indent-point) + (setcar (cdr parse-data) state) + (setq old-indent (nth 2 parse-data)))) ;; (or parse-start (null symbol) ;; (setq parse-start (symbol-value symbol) ;; start-indent (nth 2 parse-start) *************** *** 2043,2065 **** ;; in which case this line is the first argument decl. (skip-chars-forward " \t") (+ start-indent ! (if (= (following-char) ?{) cperl-continued-brace-offset 0) (progn ! (cperl-backward-to-noncomment (or parse-start (point-min))) ! ;;(skip-chars-backward " \t\f\n") ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls ;; or function's arg decls. Set basic-indent accordingly. ;; Now add a little if this is a continuation line. (if (or (bobp) ! (memq (preceding-char) (append " ;}" nil)) ; Was ?\) (memq char-after (append ")]}" nil)) (and (eq (preceding-char) ?\:) ; label (progn (forward-sexp -1) (skip-chars-backward " \t") (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) ! 0 cperl-continued-statement-offset)))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: --- 3093,3122 ---- ;; in which case this line is the first argument decl. (skip-chars-forward " \t") (+ start-indent ! (if (= char-after ?{) cperl-continued-brace-offset 0) (progn ! (cperl-backward-to-noncomment (or old-indent (point-min))) ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls ;; or function's arg decls. Set basic-indent accordingly. ;; Now add a little if this is a continuation line. (if (or (bobp) ! (eq (preceding-char) ?\;) ! ;; Had ?\) too ! (and (eq (preceding-char) ?\}) ! (cperl-after-block-and-statement-beg start)) (memq char-after (append ")]}" nil)) (and (eq (preceding-char) ?\:) ; label (progn (forward-sexp -1) (skip-chars-backward " \t") (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) ! (progn ! (if (and parse-data ! (not (eq char-after ?\C-j))) ! (setcdr (cdr parse-data) ! (list pre-indent-point))) ! 0) cperl-continued-statement-offset)))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: *************** *** 2071,2077 **** (skip-chars-forward " \t")) (current-column)) ((progn ! ;; Containing-expr starts with \{. Check whether it is a hash. (goto-char containing-sexp) (not (cperl-block-p))) (goto-char (1+ containing-sexp)) --- 3128,3134 ---- (skip-chars-forward " \t")) (current-column)) ((progn ! ;; Containing-expr starts with \{. Check whether it is a hash. (goto-char containing-sexp) (not (cperl-block-p))) (goto-char (1+ containing-sexp)) *************** *** 2101,2107 **** (beginning-of-line) (cperl-backward-to-noncomment containing-sexp)) ;; Now we get the answer. ! (if (not (memq (preceding-char) (append ", ;}{" '(nil)))) ; Was ?\, ;; This line is continuation of preceding line's statement; ;; indent `cperl-continued-statement-offset' more than the ;; previous line of the statement. --- 3158,3168 ---- (beginning-of-line) (cperl-backward-to-noncomment containing-sexp)) ;; Now we get the answer. ! ;; Had \?, too: ! (if (not (or (memq (preceding-char) (append " ;{" '(nil))) ! (and (eq (preceding-char) ?\}) ! (cperl-after-block-and-statement-beg ! containing-sexp)))) ; Was ?\, ;; This line is continuation of preceding line's statement; ;; indent `cperl-continued-statement-offset' more than the ;; previous line of the statement. *************** *** 2194,2202 **** (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ! (cperl-calculate-indent ! (if (and parse-start (<= parse-start (point))) ! parse-start))) (current-indentation)))))))))))))) (defvar cperl-indent-alist --- 3255,3263 ---- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ! ;; Do not move `parse-data', this should ! ;; be quick anyway: ! (cperl-calculate-indent)) (current-indentation)))))))))))))) (defvar cperl-indent-alist *************** *** 2209,2220 **** "Alist of indentation rules for CPerl mode. The values mean: nil: do not indent; ! number: add this amount of indentation.") (defun cperl-where-am-i (&optional parse-start start-state) ;; Unfinished "Return a list of lists ((TYPE POS)...) of good points before the point. ! POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'." (save-excursion (let* ((start-point (point)) (s-s (cperl-get-state)) --- 3270,3285 ---- "Alist of indentation rules for CPerl mode. The values mean: nil: do not indent; ! number: add this amount of indentation. ! ! Not finished, not used.") (defun cperl-where-am-i (&optional parse-start start-state) ;; Unfinished "Return a list of lists ((TYPE POS)...) of good points before the point. ! POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'. ! ! Not finished, not used." (save-excursion (let* ((start-point (point)) (s-s (cperl-get-state)) *************** *** 2255,2261 **** (point))) (cons (list 'expression containing-sexp) res)))) ((progn ! ;; Containing-expr starts with \{. Check whether it is a hash. (goto-char containing-sexp) (not (cperl-block-p))) (setq res (cons (list 'expression-blanks --- 3320,3326 ---- (point))) (cons (list 'expression containing-sexp) res)))) ((progn ! ;; Containing-expr starts with \{. Check whether it is a hash. (goto-char containing-sexp) (not (cperl-block-p))) (setq res (cons (list 'expression-blanks *************** *** 2354,2362 **** (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ! (cperl-calculate-indent ! (if (and parse-start (<= parse-start (point))) ! parse-start))) (current-indentation)))))))) res))) --- 3419,3425 ---- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ! (cperl-calculate-indent)) (current-indentation)))))))) res))) *************** *** 2390,2402 **** (setq state (parse-partial-sexp (point) lim nil nil nil t)) ; stop at comment ;; If fails (beginning-of-line inside sexp), then contains not-comment - ;; Do simplified processing - ;;(if (re-search-forward "[^$]#" lim 1) - ;; (progn - ;; (forward-char -1) - ;; (skip-chars-backward " \t\n\f" lim)) - ;; (goto-char lim)) ; No `#' at all - ;;) (if (nth 4 state) ; After `#'; ; (nth 2 state) can be ; beginning of m,s,qq and so --- 3453,3458 ---- *************** *** 2411,2417 **** "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" lim 'move) (setq stop-in t))) ! ((looking-at "\\(m\\|q\\([qxw]\\)?\\)\\>") (or (re-search-forward "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" lim 'move) --- 3467,3473 ---- "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" lim 'move) (setq stop-in t))) ! ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>") (or (re-search-forward "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" lim 'move) *************** *** 2435,2440 **** --- 3491,3504 ---- (defvar cperl-st-sfence '(15)) ; String-fence (defvar cperl-st-punct '(1)) (defvar cperl-st-word '(2)) + (defvar cperl-st-bra '(4 . ?\>)) + (defvar cperl-st-ket '(5 . ?\<)) + + (defsubst cperl-modify-syntax-type (at how) + (if (< at (point-max)) + (progn + (put-text-property at (1+ at) 'syntax-table how) + (put-text-property at (1+ at) 'rear-nonsticky t)))) (defun cperl-protect-defun-start (s e) ;; C code looks for "^\\s(" to skip comment backward in "hard" situations *************** *** 2443,2478 **** (while (re-search-forward "^\\s(" e 'to-end) (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct)))) ! (defun cperl-commentify (bb e string) (if cperl-use-syntax-table-text-property ! (progn ;; We suppose that e is _after_ the end of construction, as after eol. (setq string (if string cperl-st-sfence cperl-st-cfence)) ! (put-text-property bb (1+ bb) 'syntax-table string) ! (put-text-property bb (1+ bb) 'rear-nonsticky t) ! (put-text-property (1- e) e 'syntax-table string) ! (put-text-property (1- e) e 'rear-nonsticky t) (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) (put-text-property (1+ bb) (1- e) 'syntax-table cperl-string-syntax-table)) ! (cperl-protect-defun-start bb e)))) ! (defun cperl-forward-re (is-2arg set-st st-l err-l argument ! &optional ostart oend) ! ;; Unfinished ;; Works *before* syntax recognition is done ;; May modify syntax-type text property if the situation is too hard ! (let (b starter ender st i i2) (skip-chars-forward " \t") ;; ender means matching-char matcher. (setq b (point) starter (char-after b) ! ;; ender: ! ender (cdr (assoc starter '(( ?\( . ?\) ) ! ( ?\[ . ?\] ) ! ( ?\{ . ?\} ) ! ( ?\< . ?\> ) ! )))) ;; What if starter == ?\\ ???? (if set-st (if (car st-l) --- 3507,3544 ---- (while (re-search-forward "^\\s(" e 'to-end) (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct)))) ! (defun cperl-commentify (bb e string &optional noface) (if cperl-use-syntax-table-text-property ! (if (eq noface 'n) ; Only immediate ! nil ;; We suppose that e is _after_ the end of construction, as after eol. (setq string (if string cperl-st-sfence cperl-st-cfence)) ! (cperl-modify-syntax-type bb string) ! (cperl-modify-syntax-type (1- e) string) (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) (put-text-property (1+ bb) (1- e) 'syntax-table cperl-string-syntax-table)) ! (cperl-protect-defun-start bb e)) ! ;; Fontify ! (or noface ! (not cperl-pod-here-fontify) ! (put-text-property bb e 'face (if string 'font-lock-string-face ! 'font-lock-comment-face))))) ! (defvar cperl-starters '(( ?\( . ?\) ) ! ( ?\[ . ?\] ) ! ( ?\{ . ?\} ) ! ( ?\< . ?\> ))) ! (defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument ! &optional ostart oend) ;; Works *before* syntax recognition is done ;; May modify syntax-type text property if the situation is too hard ! (let (b starter ender st i i2 go-forward) (skip-chars-forward " \t") ;; ender means matching-char matcher. (setq b (point) starter (char-after b) ! ender (cdr (assoc starter cperl-starters))) ;; What if starter == ?\\ ???? (if set-st (if (car st-l) *************** *** 2494,2499 **** --- 3560,3567 ---- (modify-syntax-entry ender (concat ")" (list starter)) st))) (condition-case bb (progn + ;; We use `$' syntax class to find matching stuff, but $$ + ;; is recognized the same as $, so we need to check this manually. (if (and (eq starter (char-after (cperl-1+ b))) (not ender)) ;; $ has TeXish matching rules, so $$ equiv $... *************** *** 2509,2701 **** (forward-char -2) (= 0 (% (skip-chars-backward "\\\\") 2))) (forward-char -1))) (and is-2arg ; Have trailing part (not ender) (eq (following-char) starter) ; Empty trailing part ! (if (eq (char-syntax (following-char)) ?.) ! (setq is-2arg nil) ; Ignore the tail ! ;; Make trailing letter into punctuation ! (setq is-2arg nil) ; Ignore the tail ! (put-text-property (point) (1+ (point)) ! 'syntax-table cperl-st-punct) ! (put-text-property (point) (1+ (point)) 'rear-nonsticky t))) (if is-2arg ; Not number => have second part (progn (setq i (point) i2 i) (if ender ! (if (eq (char-syntax (following-char)) ?\ ) (progn ! (while (looking-at "\\s *#") ! (beginning-of-line 2)) ! (skip-chars-forward " \t\n\f") (setq i2 (point)))) (forward-char -1)) (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)) (setq set-st nil) ! (setq ! ender ! (cperl-forward-re nil t st-l err-l argument starter ender) ! ender (nth 2 ender))))) ! (error (goto-char (point-max)) ! (message ! "End of `%s%s%c ... %c' string not found: %s" ! argument ! (if ostart (format "%c ... %c" ostart (or oend ostart)) "") ! starter (or ender starter) bb) ! (or (car err-l) (setcar err-l b)))) (if set-st (progn (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)))) ! (list i i2 ender starter))) ! (defun cperl-find-pods-heres (&optional min max) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify the sections using `cperl-pod-head-face', `cperl-pod-face', `cperl-here-face'." (interactive) ! (or min (setq min (point-min))) (or max (setq max (point-max))) ! (let (face head-face here-face b e bb tag qtag b1 e1 argument i c tail state ! (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) ! (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) ! (modified (buffer-modified-p)) ! (after-change-functions nil) ! (state-point (point-min)) ! (st-l '(nil)) (err-l '(nil)) i2 ! ;; Somehow font-lock may be not loaded yet... ! (font-lock-string-face (if (boundp 'font-lock-string-face) ! font-lock-string-face ! 'font-lock-string-face)) ! (search ! (concat ! "\\(\\`\n?\\|\n\n\\)=" ! "\\|" ! ;; One extra () before this: ! "<<" ! "\\(" ! ;; First variant "BLAH" or just ``. ! "\\([\"'`]\\)" ! "\\([^\"'`\n]*\\)" ! "\\3" ! "\\|" ! ;; Second variant: Identifier or empty ! "\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ! ;; Check that we do not have <<= or << 30 or << $blah. ! "\\([^= \t$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ! "\\)" ! "\\|" ! ;; 1+6 extra () before this: ! "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ! (if cperl-use-syntax-table-text-property ! (concat ! "\\|" ! ;; 1+6+2=9 extra () before this: ! "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>" ! "\\|" ! ;; 1+6+2+1=10 extra () before this: ! "\\([?/]\\)" ; /blah/ or ?blah? ! "\\|" ! ;; 1+6+2+1+1=11 extra () before this: ! "\\[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" ! "\\|" ! ;; 1+6+2+1+1+2=13 extra () before this: ! "\\$\\(['{]\\)" ! "\\|" ! ;; 1+6+2+1+1+2+1=14 extra () before this: ! "\\(\\") ! (progn ! (message "=cut is not preceded by a pod section") (or (car err-l) (setcar err-l (point)))) (beginning-of-line) ! (setq b (point) bb b) ! (or (re-search-forward "\n\n=cut\\>" max 'toend) (progn ! (message "Cannot find the end of a pod section") (or (car err-l) (setcar err-l b)))) (beginning-of-line 2) ; An empty line after =cut is not POD! (setq e (point)) ! (put-text-property b e 'in-pod t) ! (goto-char b) ! (while (re-search-forward "\n\n[ \t]" e t) ! ;; We start 'pod 1 char earlier to include the preceding line ! (beginning-of-line) ! (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) ! (cperl-put-do-not-fontify b (point)) ! ;;(put-text-property (max (point-min) (1- b)) ! ;; (point) cperl-do-not-fontify t) ! (if cperl-pod-here-fontify (put-text-property b (point) 'face face)) ! (re-search-forward "\n\n[^ \t\f\n]" e 'toend) ! (beginning-of-line) ! (setq b (point))) ! (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) ! (cperl-put-do-not-fontify (point) e) ! ;;(put-text-property (max (point-min) (1- (point))) ! ;; e cperl-do-not-fontify t) ! (if cperl-pod-here-fontify ! (progn (put-text-property (point) e 'face face) ! (goto-char bb) ! (if (looking-at ! "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ! (put-text-property ! (match-beginning 1) (match-end 1) ! 'face head-face)) ! (while (re-search-forward ! ;; One paragraph ! "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" ! e 'toend) ! (put-text-property ! (match-beginning 1) (match-end 1) ! 'face head-face)))) ! (cperl-commentify bb e nil) ! (goto-char e) ! (or (eq e (point-max)) ! (forward-char -1)))) ; Prepare for immediate pod start. ;; Here document ;; We do only one here-per-line ! ;; 1 () ahead ! ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)" ((match-beginning 2) ; 1 + 1 ;; Abort in comment: (setq b (point)) (setq state (parse-partial-sexp state-point b nil nil state) ! state-point b) ! (if ;;(save-excursion ! ;; (beginning-of-line) ! ;; (search-forward "#" b t)) ! (or (nth 3 state) (nth 4 state)) ! (goto-char (match-end 2)) (if (match-beginning 5) ;4 + 1 (setq b1 (match-beginning 5) ; 4 + 1 e1 (match-end 5)) ; 4 + 1 --- 3577,3875 ---- (forward-char -2) (= 0 (% (skip-chars-backward "\\\\") 2))) (forward-char -1))) + ;; Now we are after the first part. (and is-2arg ; Have trailing part (not ender) (eq (following-char) starter) ; Empty trailing part ! (progn ! (or (eq (char-syntax (following-char)) ?.) ! ;; Make trailing letter into punctuation ! (cperl-modify-syntax-type (point) cperl-st-punct)) ! (setq is-2arg nil go-forward t))) ; Ignore the tail (if is-2arg ; Not number => have second part (progn (setq i (point) i2 i) (if ender ! (if (memq (following-char) '(?\ ?\t ?\n ?\f)) (progn ! (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+") ! (goto-char (match-end 0)) ! (skip-chars-forward " \t\n\f")) (setq i2 (point)))) (forward-char -1)) (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)) (setq set-st nil) ! (setq ender (cperl-forward-re lim end nil t st-l err-l ! argument starter ender) ! ender (nth 2 ender))))) ! (error (goto-char lim) ! (setq set-st nil) ! (or end ! (message ! "End of `%s%s%c ... %c' string/RE not found: %s" ! argument ! (if ostart (format "%c ... %c" ostart (or oend ostart)) "") ! starter (or ender starter) bb) ! (or (car err-l) (setcar err-l b))))) (if set-st (progn (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)))) ! ;; i: have 2 args, after end of the first arg ! ;; i2: start of the second arg, if any (before delim iff `ender'). ! ;; ender: the last arg bounded by parens-like chars, the second one of them ! ;; starter: the starting delimiter of the first arg ! ;; go-forward: has 2 args, and the second part is empth ! (list i i2 ender starter go-forward))) ! ! (defvar font-lock-string-face) ! ;;(defvar font-lock-reference-face) ! (defvar font-lock-constant-face) ! (defsubst cperl-postpone-fontification (b e type val &optional now) ! ;; Do after syntactic fontification? ! (if cperl-syntaxify-by-font-lock ! (or now (put-text-property b e 'cperl-postpone (cons type val))) ! (put-text-property b e type val))) ! ! ;;; Here is how the global structures (those which cannot be ! ;;; recognized locally) are marked: ! ;; a) PODs: ! ;; Start-to-end is marked `in-pod' ==> t ! ;; Each non-literal part is marked `syntax-type' ==> `pod' ! ;; Each literal part is marked `syntax-type' ==> `in-pod' ! ;; b) HEREs: ! ;; Start-to-end is marked `here-doc-group' ==> t ! ;; The body is marked `syntax-type' ==> `here-doc' ! ;; The delimiter is marked `syntax-type' ==> `here-doc-delim' ! ;; a) FORMATs: ! ;; After-initial-line--to-end is marked `syntax-type' ==> `format' ! ! (defun cperl-unwind-to-safe (before) ! (let ((pos (point))) ! (while (and pos (get-text-property pos 'syntax-type)) ! (setq pos (previous-single-property-change pos 'syntax-type)) ! (if pos ! (if before ! (progn ! (goto-char (cperl-1- pos)) ! (beginning-of-line) ! (setq pos (point))) ! (goto-char (setq pos (cperl-1- pos)))) ! ;; Up to the start ! (goto-char (point-min)))))) ! (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify the sections using `cperl-pod-head-face', `cperl-pod-face', `cperl-here-face'." (interactive) ! (or min (setq min (point-min) ! cperl-syntax-state nil ! cperl-syntax-done-to min)) (or max (setq max (point-max))) ! (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb ! (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend ! (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) ! (modified (buffer-modified-p)) ! (after-change-functions nil) ! (use-syntax-state (and cperl-syntax-state ! (>= min (car cperl-syntax-state)))) ! (state-point (if use-syntax-state ! (car cperl-syntax-state) ! (point-min))) ! (state (if use-syntax-state ! (cdr cperl-syntax-state))) ! (st-l '(nil)) (err-l '(nil)) i2 ! ;; Somehow font-lock may be not loaded yet... ! (font-lock-string-face (if (boundp 'font-lock-string-face) ! font-lock-string-face ! 'font-lock-string-face)) ! (font-lock-constant-face (if (boundp 'font-lock-constant-face) ! font-lock-constant-face ! 'font-lock-constant-face)) ! (font-lock-function-name-face ! (if (boundp 'font-lock-function-name-face) ! font-lock-function-name-face ! 'font-lock-function-name-face)) ! (font-lock-other-type-face ! (if (boundp 'font-lock-other-type-face) ! font-lock-other-type-face ! 'font-lock-other-type-face)) ! (stop-point (if ignore-max ! (point-max) ! max)) ! (search ! (concat ! "\\(\\`\n?\\|\n\n\\)=" ! "\\|" ! ;; One extra () before this: ! "<<" ! "\\(" ; 1 + 1 ! ;; First variant "BLAH" or just ``. ! "\\([\"'`]\\)" ; 2 + 1 ! "\\([^\"'`\n]*\\)" ; 3 + 1 ! "\\3" ! "\\|" ! ;; Second variant: Identifier or \ID or empty ! "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 ! ;; Do not have <<= or << 30 or <<30 or << $blah. ! ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 ! "\\(\\)" ; To preserve count of pars :-( 6 + 1 ! "\\)" ! "\\|" ! ;; 1+6 extra () before this: ! "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ! (if cperl-use-syntax-table-text-property ! (concat ! "\\|" ! ;; 1+6+2=9 extra () before this: ! "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ! "\\|" ! ;; 1+6+2+1=10 extra () before this: ! "\\([?/<]\\)" ; /blah/ or ?blah? or ! "\\|" ! ;; 1+6+2+1+1=11 extra () before this: ! "\\[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" ! "\\|" ! ;; 1+6+2+1+1+2=13 extra () before this: ! "\\$\\(['{]\\)" ! "\\|" ! ;; 1+6+2+1+1+2+1=14 extra () before this: ! "\\(\\") ! (if ignore-max ! nil ; Doing a chunk only ! (message "=cut is not preceded by a POD section") (or (car err-l) (setcar err-l (point)))) (beginning-of-line) ! (setq b (point) ! bb b ! tb (match-beginning 0) ! b1 nil) ; error condition ! ;; We do not search to max, since we may be called from ! ;; some hook of fontification, and max is random ! (or (re-search-forward "\n\n=cut\\>" stop-point 'toend) (progn ! (message "End of a POD section not marked by =cut") ! (setq b1 t) (or (car err-l) (setcar err-l b)))) (beginning-of-line 2) ; An empty line after =cut is not POD! (setq e (point)) ! (if (and b1 (eobp)) ! ;; Unrecoverable error ! nil ! (and (> e max) ! (progn ! (remove-text-properties ! max e '(syntax-type t in-pod t syntax-table t ! 'cperl-postpone t)) ! (setq tmpend tb))) ! (put-text-property b e 'in-pod t) ! (put-text-property b e 'syntax-type 'in-pod) ! (goto-char b) ! (while (re-search-forward "\n\n[ \t]" e t) ! ;; We start 'pod 1 char earlier to include the preceding line ! (beginning-of-line) ! (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) ! (cperl-put-do-not-fontify b (point) t) ! ;; mark the non-literal parts as PODs ! (if cperl-pod-here-fontify ! (cperl-postpone-fontification b (point) 'face face t)) ! (re-search-forward "\n\n[^ \t\f\n]" e 'toend) ! (beginning-of-line) ! (setq b (point))) ! (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) ! (cperl-put-do-not-fontify (point) e t) ! (if cperl-pod-here-fontify ! (progn ! ;; mark the non-literal parts as PODs ! (cperl-postpone-fontification (point) e 'face face t) ! (goto-char bb) ! (if (looking-at ! "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ! ;; mark the headers ! (cperl-postpone-fontification ! (match-beginning 1) (match-end 1) ! 'face head-face)) ! (while (re-search-forward ! ;; One paragraph ! "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" ! e 'toend) ! ;; mark the headers ! (cperl-postpone-fontification ! (match-beginning 1) (match-end 1) ! 'face head-face)))) ! (cperl-commentify bb e nil) ! (goto-char e) ! (or (eq e (point-max)) ! (forward-char -1))))) ; Prepare for immediate pod start. ;; Here document ;; We do only one here-per-line ! ;; ;; One extra () before this: ! ;;"<<" ! ;; "\\(" ; 1 + 1 ! ;; ;; First variant "BLAH" or just ``. ! ;; "\\([\"'`]\\)" ; 2 + 1 ! ;; "\\([^\"'`\n]*\\)" ; 3 + 1 ! ;; "\\3" ! ;; "\\|" ! ;; ;; Second variant: Identifier or \ID or empty ! ;; "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 ! ;; ;; Do not have <<= or << 30 or <<30 or << $blah. ! ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 ! ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 ! ;; "\\)" ((match-beginning 2) ; 1 + 1 ;; Abort in comment: (setq b (point)) (setq state (parse-partial-sexp state-point b nil nil state) ! state-point b ! tb (match-beginning 0) ! i (or (nth 3 state) (nth 4 state))) ! (if i ! (setq c t) ! (setq c (and ! (match-beginning 5) ! (not (match-beginning 6)) ; Empty ! (looking-at ! "[ \t]*[=0-9$@%&(]")))) ! (if c ; Not here-doc ! nil ; Skip it. (if (match-beginning 5) ;4 + 1 (setq b1 (match-beginning 5) ; 4 + 1 e1 (match-end 5)) ; 4 + 1 *************** *** 2704,2724 **** (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) (cond (cperl-pod-here-fontify ! (put-text-property b1 e1 'face font-lock-reference-face) ! (cperl-put-do-not-fontify b1 e1))) (forward-line) (setq b (point)) ! (cond ((re-search-forward (concat "^" qtag "$") max 'toend) (if cperl-pod-here-fontify (progn ! (put-text-property (match-beginning 0) (match-end 0) ! 'face font-lock-reference-face) ! (cperl-put-do-not-fontify b (match-end 0)) ! ;;(put-text-property (max (point-min) (1- b)) ! ;; (min (point-max) ! ;; (1+ (match-end 0))) ! ;; cperl-do-not-fontify t) ! (put-text-property b (match-beginning 0) 'face here-face))) (setq e1 (cperl-1+ (match-end 0))) (put-text-property b (match-beginning 0) --- 3878,3900 ---- (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) (cond (cperl-pod-here-fontify ! ;; Highlight the starting delimiter ! (cperl-postpone-fontification b1 e1 'face font-lock-constant-face) ! (cperl-put-do-not-fontify b1 e1 t))) (forward-line) (setq b (point)) ! ;; We do not search to max, since we may be called from ! ;; some hook of fontification, and max is random ! (cond ((re-search-forward (concat "^" qtag "$") ! stop-point 'toend) (if cperl-pod-here-fontify (progn ! ;; Highlight the ending delimiter ! (cperl-postpone-fontification (match-beginning 0) (match-end 0) ! 'face font-lock-constant-face) ! (cperl-put-do-not-fontify b (match-end 0) t) ! ;; Highlight the HERE-DOC ! (cperl-postpone-fontification b (match-beginning 0) 'face here-face))) (setq e1 (cperl-1+ (match-end 0))) (put-text-property b (match-beginning 0) *************** *** 2728,2734 **** (put-text-property b e1 'here-doc-group t) (cperl-commentify b e1 nil) ! (cperl-put-do-not-fontify b (match-end 0))) (t (message "End of here-document `%s' not found." tag) (or (car err-l) (setcar err-l b)))))) ;; format --- 3904,3912 ---- (put-text-property b e1 'here-doc-group t) (cperl-commentify b e1 nil) ! (cperl-put-do-not-fontify b (match-end 0) t) ! (if (> e1 max) ! (setq tmpend tb))) (t (message "End of here-document `%s' not found." tag) (or (car err-l) (setcar err-l b)))))) ;; format *************** *** 2739,2745 **** name (if (match-beginning 8) ; 7 + 1 (buffer-substring (match-beginning 8) ; 7 + 1 (match-end 8)) ; 7 + 1 ! "")) (setq argument nil) (if cperl-pod-here-fontify (while (and (eq (forward-line) 0) --- 3917,3924 ---- name (if (match-beginning 8) ; 7 + 1 (buffer-substring (match-beginning 8) ; 7 + 1 (match-end 8)) ; 7 + 1 ! "") ! tb (match-beginning 0)) (setq argument nil) (if cperl-pod-here-fontify (while (and (eq (forward-line) 0) *************** *** 2756,2794 **** (setq b1 (point)) (setq argument (looking-at "^[^\n]*[@^]")) (end-of-line) ! (put-text-property b1 (point) 'face font-lock-string-face) (cperl-commentify b1 (point) nil) ! (cperl-put-do-not-fontify b1 (point))))) ! (re-search-forward (concat "^[.;]$") max 'toend)) (beginning-of-line) ! (if (looking-at "^[.;]$") (progn ! (put-text-property (point) (+ (point) 2) 'face font-lock-string-face) (cperl-commentify (point) (+ (point) 2) nil) ! (cperl-put-do-not-fontify (point) (+ (point) 2))) (message "End of format `%s' not found." name) (or (car err-l) (setcar err-l b))) (forward-line) ! (put-text-property b (point) 'syntax-type 'format) ! ;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend) ! ;;; (if cperl-pod-here-fontify ! ;;; (progn ! ;;; (put-text-property b (match-end 0) ! ;;; 'face font-lock-string-face) ! ;;; (cperl-put-do-not-fontify b (match-end 0)))) ! ;;; (put-text-property b (match-end 0) ! ;;; 'syntax-type 'format) ! ;;; (cperl-put-do-not-fontify b (match-beginning 0))) ! ;;; (t (message "End of format `%s' not found." name))) ! ) ;; Regexp: ((or (match-beginning 10) (match-beginning 11)) ;; 1+6+2=9 extra () before this: ! ;; "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>" ;; "\\|" ! ;; "\\([?/]\\)" ; /blah/ or ?blah? (setq b1 (if (match-beginning 10) 10 11) argument (buffer-substring (match-beginning b1) (match-end b1)) --- 3935,3968 ---- (setq b1 (point)) (setq argument (looking-at "^[^\n]*[@^]")) (end-of-line) ! ;; Highlight the format line ! (cperl-postpone-fontification b1 (point) 'face font-lock-string-face) (cperl-commentify b1 (point) nil) ! (cperl-put-do-not-fontify b1 (point) t)))) ! ;; We do not search to max, since we may be called from ! ;; some hook of fontification, and max is random ! (re-search-forward "^[.;]$" stop-point 'toend)) (beginning-of-line) ! (if (looking-at "^\\.$") ; ";" is not supported yet (progn ! ;; Highlight the ending delimiter ! (cperl-postpone-fontification (point) (+ (point) 2) 'face font-lock-string-face) (cperl-commentify (point) (+ (point) 2) nil) ! (cperl-put-do-not-fontify (point) (+ (point) 2) t)) (message "End of format `%s' not found." name) (or (car err-l) (setcar err-l b))) (forward-line) ! (if (> (point) max) ! (setq tmpend tb)) ! (put-text-property b (point) 'syntax-type 'format)) ;; Regexp: ((or (match-beginning 10) (match-beginning 11)) ;; 1+6+2=9 extra () before this: ! ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ;; "\\|" ! ;; "\\([?/<]\\)" ; /blah/ or ?blah? or (setq b1 (if (match-beginning 10) 10 11) argument (buffer-substring (match-beginning b1) (match-end b1)) *************** *** 2796,2866 **** i b c (char-after (match-beginning b1)) bb (char-after (1- (match-beginning b1))) ; tmp holder ! bb (and ; user variables/whatever ! (match-beginning 10) ! (or ! (memq bb '(?\$ ?\@ ?\% ?\*)) ! (and (eq bb ?-) (eq c ?s)) ; -s file test ! (and (eq bb ?\&) ; &&m/blah/ ! (not (eq (char-after ! (- (match-beginning b1) 2)) ! ?\&)))))) (or bb ! (if (eq b1 11) ; bare /blah/ or ?blah? (setq argument "" ! bb ; Not a regexp? ! (progn ! (goto-char (match-beginning b1)) ! (cperl-backward-to-noncomment (point-min)) ! (not (or (memq (preceding-char) ! (append (if (eq c ?\?) ! ;; $a++ ? 1 : 2 ! "~{(=|&*!,;" ! "~{(=|&+-*!,;") nil)) ! (and (eq (preceding-char) ?\}) ! (cperl-after-block-p (point-min))) ! (and (eq (char-syntax (preceding-char)) ?w) ! (progn ! (forward-sexp -1) (looking-at ! "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))) ! (and (eq (preceding-char) ?.) ! (eq (char-after (- (point) 2)) ?.)) ! (bobp)))) ! b (1- b)))) (or bb (setq state (parse-partial-sexp state-point b nil nil state) state-point b)) (goto-char b) (if (or bb (nth 3 state) (nth 4 state)) (goto-char i) ! (skip-chars-forward " \t") ;; qtag means two-arg matcher, may be reset to ;; 2 or 3 later if some special quoting is needed. ;; e1 means matching-char matcher. (setq b (point) ! i (cperl-forward-re ! (string-match "^\\([sy]\\|tr\\)$" argument) ! t st-l err-l argument) ! i2 (nth 1 i) ; start of the second part ! e1 (nth 2 i) ; ender, true if matching second part i (car i) ; intermediate point ! tail (if (and i (not e1)) (1- (point)))) ;; Commenting \\ is dangerous, what about ( ? (and i tail (eq (char-after i) ?\\) ! (setq i nil tail nil)) (if (null i) ! (cperl-commentify b (point) t) (cperl-commentify b i t) (if (looking-at "\\sw*e") ; s///e ! (cperl-find-pods-heres i2 (1- (point))) ! (cperl-commentify i2 (point) t) (setq tail nil))) (if (eq (char-syntax (following-char)) ?w) (progn (forward-word 1) ; skip modifiers s///s ! (if tail (cperl-commentify tail (point) t)))))) ((match-beginning 13) ; sub with prototypes (setq b (match-beginning 0)) (if (memq (char-after (1- b)) --- 3970,4135 ---- i b c (char-after (match-beginning b1)) bb (char-after (1- (match-beginning b1))) ; tmp holder ! bb (if (eq b1 10) ; user variables/whatever ! (or ! (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y ! (and (eq bb ?-) (eq c ?s)) ; -s file test ! (and (eq bb ?\&) ; &&m/blah/ ! (not (eq (char-after ! (- (match-beginning b1) 2)) ! ?\&)))) ! ;; or <$file> ! (and (eq c ?\<) ! (save-match-data ! (looking-at ! "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s *\\)?>")))) ! tb (match-beginning 0)) ! (goto-char (match-beginning b1)) ! (cperl-backward-to-noncomment (point-min)) (or bb ! (if (eq b1 11) ; bare /blah/ or ?blah? or (setq argument "" ! bb ; Not a regexp? ! (progn ! (not ! ;; What is below: regexp-p? ! (and ! (or (memq (preceding-char) ! (append (if (eq c ?\?) ! ;; $a++ ? 1 : 2 ! "~{(=|&*!,;" ! "~{(=|&+-*!,;") nil)) ! (and (eq (preceding-char) ?\}) ! (cperl-after-block-p (point-min))) ! (and (eq (char-syntax (preceding-char)) ?w) ! (progn ! (forward-sexp -1) ! ;;; After these keywords `/' starts a RE. One should add all the ! ;;; functions/builtins which expect an argument, but ... ! (if (eq (preceding-char) ?-) ! ;; -d ?foo? is a RE ! (looking-at "[a-zA-Z]\\>") (looking-at ! "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))) ! (and (eq (preceding-char) ?.) ! (eq (char-after (- (point) 2)) ?.)) ! (bobp)) ! ;; m|blah| ? foo : bar; ! (not ! (and (eq c ?\?) ! cperl-use-syntax-table-text-property ! (not (bobp)) ! (progn ! (forward-char -1) ! (looking-at "\\s|"))))))) ! b (1- b)) ! ;; s y tr m ! ;; Check for $a->y ! (if (and (eq (preceding-char) ?>) ! (eq (char-after (- (point) 2)) ?-)) ! ;; Not a regexp ! (setq bb t)))) (or bb (setq state (parse-partial-sexp state-point b nil nil state) state-point b)) (goto-char b) (if (or bb (nth 3 state) (nth 4 state)) (goto-char i) ! (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+") ! (goto-char (match-end 0)) ! (skip-chars-forward " \t\n\f")) ;; qtag means two-arg matcher, may be reset to ;; 2 or 3 later if some special quoting is needed. ;; e1 means matching-char matcher. (setq b (point) ! ;; has 2 args ! i2 (string-match "^\\([sy]\\|tr\\)$" argument) ! ;; We do not search to max, since we may be called from ! ;; some hook of fontification, and max is random ! i (cperl-forward-re stop-point end ! i2 ! t st-l err-l argument) ! ;; Note that if `go', then it is considered as 1-arg ! b1 (nth 1 i) ; start of the second part ! tag (nth 2 i) ; ender-char, true if second part ! ; is with matching chars [] ! go (nth 4 i) ; There is a 1-char part after the end i (car i) ; intermediate point ! e1 (point) ; end ! ;; Before end of the second part if non-matching: /// ! tail (if (and i (not tag)) ! (1- e1)) ! e (if i i e1) ; end of the first part ! qtag nil) ; need to preserve backslashitis ;; Commenting \\ is dangerous, what about ( ? (and i tail (eq (char-after i) ?\\) ! (setq qtag t)) (if (null i) ! ;; Considered as 1arg form ! (progn ! (cperl-commentify b (point) t) ! (and go ! (setq e1 (1+ e1)) ! (forward-char 1))) (cperl-commentify b i t) (if (looking-at "\\sw*e") ; s///e ! (progn ! (and ! ;; silent: ! (cperl-find-pods-heres b1 (1- (point)) t end) ! ;; Error ! (goto-char (1+ max))) ! (if (and tag (eq (preceding-char) ?\>)) ! (progn ! (cperl-modify-syntax-type (1- (point)) cperl-st-ket) ! (cperl-modify-syntax-type i cperl-st-bra)))) ! (cperl-commentify b1 (point) t) ! (if qtag ! (cperl-modify-syntax-type (1+ i) cperl-st-punct)) (setq tail nil))) + ;; Now: tail: if the second part is non-matching without ///e (if (eq (char-syntax (following-char)) ?w) (progn (forward-word 1) ; skip modifiers s///s ! (if tail (cperl-commentify tail (point) t)) ! (cperl-postpone-fontification ! e1 (point) 'face font-lock-other-type-face))) ! ;; Check whether it is m// which means "previous match" ! ;; and highlight differently ! (if (and (eq e (+ 2 b)) ! (string-match "^\\([sm]?\\|qr\\)$" argument) ! ;; <> is already filtered out ! ;; split // *is* using zero-pattern ! (save-excursion ! (condition-case nil ! (progn ! (goto-char tb) ! (forward-sexp -1) ! (not (looking-at "split\\>"))) ! (error t)))) ! (cperl-postpone-fontification ! b e 'face font-lock-function-name-face) ! (if (or i2 ; Has 2 args ! (and cperl-fontify-m-as-s ! (or ! (string-match "^\\(m\\|qr\\)$" argument) ! (and (eq 0 (length argument)) ! (not (eq ?\< (char-after b))))))) ! (progn ! (cperl-postpone-fontification ! b (1+ b) 'face font-lock-constant-face) ! (cperl-postpone-fontification ! (1- e) e 'face font-lock-constant-face)))) ! (if i2 ! (progn ! (cperl-postpone-fontification ! (1- e1) e1 'face font-lock-constant-face) ! (if (assoc (char-after b) cperl-starters) ! (cperl-postpone-fontification ! b1 (1+ b1) 'face font-lock-constant-face)))) ! (if (> (point) max) ! (setq tmpend tb)))) ((match-beginning 13) ; sub with prototypes (setq b (match-beginning 0)) (if (memq (char-after (1- b)) *************** *** 2877,2898 **** ;; 1+6+2+1+1+2=13 extra () before this: ;; "\\$\\(['{]\\)" ((and (match-beginning 14) ! (eq (preceding-char) ?\')) ; $' (setq b (1- (point)) state (parse-partial-sexp state-point (1- b) nil nil state) state-point (1- b)) (if (nth 3 state) ; in string ! (progn ! (put-text-property (1- b) b 'syntax-table cperl-st-punct) ! (put-text-property (1- b) b 'rear-nonsticky t))) (goto-char (1+ b))) ;; 1+6+2+1+1+2=13 extra () before this: ;; "\\$\\(['{]\\)" ((match-beginning 14) ; ${ (setq bb (match-beginning 0)) ! (put-text-property bb (1+ bb) 'syntax-table cperl-st-punct) ! (put-text-property bb (1+ bb) 'rear-nonsticky t)) ;; 1+6+2+1+1+2+1=14 extra () before this: ;; "\\(\\") ! ;;; (progn ! ;;; (message "=cut is not preceded by a pod section") ! ;;; (setq err (point))) ! ;;; (beginning-of-line) ! ! ;;; (setq b (point) bb b) ! ;;; (or (re-search-forward "\n\n=cut\\>" max 'toend) ! ;;; (message "Cannot find the end of a pod section")) ! ;;; (beginning-of-line 3) ! ;;; (setq e (point)) ! ;;; (put-text-property b e 'in-pod t) ! ;;; (goto-char b) ! ;;; (while (re-search-forward "\n\n[ \t]" e t) ! ;;; (beginning-of-line) ! ;;; (put-text-property b (point) 'syntax-type 'pod) ! ;;; (cperl-put-do-not-fontify b (point)) ! ;;; ;;(put-text-property (max (point-min) (1- b)) ! ;;; ;; (point) cperl-do-not-fontify t) ! ;;; (if cperl-pod-here-fontify (put-text-property b (point) 'face face)) ! ;;; (re-search-forward "\n\n[^ \t\f\n]" e 'toend) ! ;;; (beginning-of-line) ! ;;; (setq b (point))) ! ;;; (put-text-property (point) e 'syntax-type 'pod) ! ;;; (cperl-put-do-not-fontify (point) e) ! ;;; ;;(put-text-property (max (point-min) (1- (point))) ! ;;; ;; e cperl-do-not-fontify t) ! ;;; (if cperl-pod-here-fontify ! ;;; (progn (put-text-property (point) e 'face face) ! ;;; (goto-char bb) ! ;;; (if (looking-at ! ;;; "=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ! ;;; (put-text-property ! ;;; (match-beginning 1) (match-end 1) ! ;;; 'face head-face)) ! ;;; (while (re-search-forward ! ;;; ;; One paragraph ! ;;; "\n\n=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" ! ;;; e 'toend) ! ;;; (put-text-property ! ;;; (match-beginning 1) (match-end 1) ! ;;; 'face head-face)))) ! ;;; (goto-char e))) ! ;;; (goto-char min) ! ;;; (while (re-search-forward ! ;;; ;; We exclude \n to avoid misrecognition inside quotes. ! ;;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\2\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)" ! ;;; max t) ! ;;; (if (match-beginning 4) ! ;;; (setq b1 (match-beginning 4) ! ;;; e1 (match-end 4)) ! ;;; (setq b1 (match-beginning 3) ! ;;; e1 (match-end 3))) ! ;;; (setq tag (buffer-substring b1 e1) ! ;;; qtag (regexp-quote tag)) ! ;;; (cond (cperl-pod-here-fontify ! ;;; (put-text-property b1 e1 'face font-lock-reference-face) ! ;;; (cperl-put-do-not-fontify b1 e1))) ! ;;; (forward-line) ! ;;; (setq b (point)) ! ;;; (cond ((re-search-forward (concat "^" qtag "$") max 'toend) ! ;;; (if cperl-pod-here-fontify ! ;;; (progn ! ;;; (put-text-property (match-beginning 0) (match-end 0) ! ;;; 'face font-lock-reference-face) ! ;;; (cperl-put-do-not-fontify b (match-end 0)) ! ;;; ;;(put-text-property (max (point-min) (1- b)) ! ;;; ;; (min (point-max) ! ;;; ;; (1+ (match-end 0))) ! ;;; ;; cperl-do-not-fontify t) ! ;;; (put-text-property b (match-beginning 0) ! ;;; 'face here-face))) ! ;;; (put-text-property b (match-beginning 0) ! ;;; 'syntax-type 'here-doc) ! ;;; (cperl-put-do-not-fontify b (match-beginning 0))) ! ;;; (t (message "End of here-document `%s' not found." tag)))) ! ;;; (goto-char min) ! ;;; (while (re-search-forward ! ;;; "^[ \t]*format[ \t]*\\(\\([a-zA-Z0-9_]+[ \t]*\\)?\\)=[ \t]*$" ! ;;; max t) ! ;;; (setq b (point) ! ;;; name (buffer-substring (match-beginning 1) ! ;;; (match-end 1))) ! ;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend) ! ;;; (if cperl-pod-here-fontify ! ;;; (progn ! ;;; (put-text-property b (match-end 0) ! ;;; 'face font-lock-string-face) ! ;;; (cperl-put-do-not-fontify b (match-end 0)))) ! ;;; (put-text-property b (match-end 0) ! ;;; 'syntax-type 'format) ! ;;; (cperl-put-do-not-fontify b (match-beginning 0))) ! ;;; (t (message "End of format `%s' not found." name)))) ! ) (if (car err-l) (goto-char (car err-l)) ! (message "Scan for \"hard\" Perl constructions completed."))) (and (buffer-modified-p) (not modified) (set-buffer-modified-p nil)) ! (set-syntax-table cperl-mode-syntax-table)))) (defun cperl-backward-to-noncomment (lim) ;; Stops at lim or after non-whitespace that is not in comment ! (let (stop p) (while (and (not stop) (> (point) (or lim 1))) (skip-chars-backward " \t\n\f" lim) (setq p (point)) (beginning-of-line) ! (if (or (looking-at "^[ \t]*\\(#\\|$\\)") ! (progn (cperl-to-comment-or-eol) (bolp))) ! nil ; Only comment, skip ! ;; Else ! (skip-chars-backward " \t") ! (if (< p (point)) (goto-char p)) ! (setq stop t))))) (defun cperl-after-block-p (lim) ;; We suppose that the preceding char is }. --- 4183,4225 ---- nil ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat (cperl-commentify b bb nil) ! (setq end t)) ! (goto-char bb))) ! (if (> (point) stop-point) ! (progn ! (if end ! (message "Garbage after __END__/__DATA__ ignored") ! (message "Unbalanced syntax found while scanning") ! (or (car err-l) (setcar err-l b))) ! (goto-char stop-point)))) ! (setq cperl-syntax-state (cons state-point state) ! cperl-syntax-done-to (or tmpend (max (point) max)))) (if (car err-l) (goto-char (car err-l)) ! (or non-inter ! (message "Scanning for \"hard\" Perl constructions... done")))) (and (buffer-modified-p) (not modified) (set-buffer-modified-p nil)) ! (set-syntax-table cperl-mode-syntax-table)) ! (car err-l))) (defun cperl-backward-to-noncomment (lim) ;; Stops at lim or after non-whitespace that is not in comment ! (let (stop p pr) (while (and (not stop) (> (point) (or lim 1))) (skip-chars-backward " \t\n\f" lim) (setq p (point)) (beginning-of-line) ! (if (memq (setq pr (get-text-property (point) 'syntax-type)) ! '(pod here-doc here-doc-delim)) ! (cperl-unwind-to-safe nil) ! (if (or (looking-at "^[ \t]*\\(#\\|$\\)") ! (progn (cperl-to-comment-or-eol) (bolp))) ! nil ; Only comment, skip ! ;; Else ! (skip-chars-backward " \t") ! (if (< p (point)) (goto-char p)) ! (setq stop t)))))) (defun cperl-after-block-p (lim) ;; We suppose that the preceding char is }. *************** *** 3043,3059 **** (progn (forward-sexp -1) (cperl-backward-to-noncomment lim) ! (or (eq (preceding-char) ?\) ) ; if () {} ! (and (eq (char-syntax (preceding-char)) ?w) ; else {} ! (progn ! (forward-sexp -1) ! (looking-at "\\(else\\|grep\\|map\\)\\>"))) ! (cperl-after-expr-p lim))) (error nil)))) (defun cperl-after-expr-p (&optional lim chars test) "Returns true if the position is good for start of expression. ! TEST is the expression to evaluate at the found position. If absent, CHARS is a string that contains good characters to have before us (however, `}' is treated \"smartly\" if it is not in the list)." (let (stop p --- 4228,4252 ---- (progn (forward-sexp -1) (cperl-backward-to-noncomment lim) ! (or (eq (point) lim) ! (eq (preceding-char) ?\) ) ; if () {} sub f () {} ! (if (eq (char-syntax (preceding-char)) ?w) ; else {} ! (save-excursion ! (forward-sexp -1) ! (or (looking-at "\\(else\\|grep\\|map\\)\\>") ! ;; sub f {} ! (progn ! (cperl-backward-to-noncomment lim) ! (and (eq (char-syntax (preceding-char)) ?w) ! (progn ! (forward-sexp -1) ! (looking-at "sub\\>")))))) ! (cperl-after-expr-p lim)))) (error nil)))) (defun cperl-after-expr-p (&optional lim chars test) "Returns true if the position is good for start of expression. ! TEST is the expression to evaluate at the found position. If absent, CHARS is a string that contains good characters to have before us (however, `}' is treated \"smartly\" if it is not in the list)." (let (stop p *************** *** 3069,3075 **** (skip-chars-backward " \t") (if (< p (point)) (goto-char p)) (setq stop t))) ! (or (bobp) (progn (if test (eval test) (or (memq (preceding-char) (append (or chars "{;") nil)) --- 4262,4269 ---- (skip-chars-backward " \t") (if (< p (point)) (goto-char p)) (setq stop t))) ! (or (bobp) ; ???? Needed ! (eq (point) lim) (progn (if test (eval test) (or (memq (preceding-char) (append (or chars "{;") nil)) *************** *** 3084,3097 **** (goto-char (1+ lim))) (skip-chars-forward " \t")) (defvar innerloop-done nil) (defvar last-depth nil) (defun cperl-indent-exp () "Simple variant of indentation of continued-sexp. ! Should be slow. Will not indent comment if it starts at `comment-indent' ! or looks like continuation of the comment on the previous line." (interactive) (save-excursion (let ((tmp-end (progn (end-of-line) (point))) top done) --- 4278,4310 ---- (goto-char (1+ lim))) (skip-chars-forward " \t")) + (defun cperl-after-block-and-statement-beg (lim) + ;; We assume that we are after ?\} + (and + (cperl-after-block-p lim) + (save-excursion + (forward-sexp -1) + (cperl-backward-to-noncomment (point-min)) + (or (bobp) + (eq (point) lim) + (not (= (char-syntax (preceding-char)) ?w)) + (progn + (forward-sexp -1) + (not + (looking-at + "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>"))))))) + (defvar innerloop-done nil) (defvar last-depth nil) (defun cperl-indent-exp () "Simple variant of indentation of continued-sexp. ! Should be slow. Will not indent comment if it starts at `comment-indent' ! or looks like continuation of the comment on the previous line. ! ! If `cperl-indent-region-fix-constructs', will improve spacing on ! conditional/loop constructs." (interactive) (save-excursion (let ((tmp-end (progn (end-of-line) (point))) top done) *************** *** 3110,3177 **** (setq done t))) (goto-char tmp-end) (setq tmp-end (point-marker))) (cperl-indent-region (point) tmp-end)))) (defun cperl-indent-region (start end) "Simple variant of indentation of region in CPerl mode. ! Should be slow. Will not indent comment if it starts at `comment-indent' or looks like continuation of the comment on the previous line. Indents all the lines whose first character is between START and END ! inclusive." (interactive "r") (save-excursion ! (let (st comm indent-info old-comm-indent new-comm-indent ! (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) ! (goto-char start) ! (setq old-comm-indent (and (cperl-to-comment-or-eol) ! (current-column)) ! new-comm-indent old-comm-indent) ! (goto-char start) ! (or (bolp) (beginning-of-line 2)) ! (or (fboundp 'imenu-progress-message) ! (message "Indenting... For feedback load `imenu'...")) ! (while (and (<= (point) end) (not (eobp))) ; bol to check start ! (and (fboundp 'imenu-progress-message) ! (imenu-progress-message ! pm (/ (* 100 (- (point) start)) (- end start -1)))) ! (setq st (point) ! indent-info nil ! ) ; Believe indentation of the current ! (if (and (setq comm (looking-at "[ \t]*#")) ! (or (eq (current-indentation) (or old-comm-indent ! comment-column)) ! (setq old-comm-indent nil))) ! (if (and old-comm-indent ! (= (current-indentation) old-comm-indent) ! (not (eq (get-text-property (point) 'syntax-type) 'pod))) ! (let ((comment-column new-comm-indent)) ! (indent-for-comment))) ! (progn ! (cperl-indent-line 'indent-info) ! (or comm ! (progn ! (if (setq old-comm-indent (and (cperl-to-comment-or-eol) ! (not (eq (get-text-property (point) 'syntax-type) 'pod)) ! (current-column))) ! (progn (indent-for-comment) ! (skip-chars-backward " \t") ! (skip-chars-backward "#") ! (setq new-comm-indent (current-column)))))))) ! (beginning-of-line 2)) (if (fboundp 'imenu-progress-message) ! (imenu-progress-message pm 100) ! (message nil))))) ! ! ;;(defun cperl-slash-is-regexp (&optional pos) ! ;; (save-excursion ! ;; (goto-char (if pos pos (1- (point)))) ! ;; (and ! ;; (not (memq (get-text-property (point) 'face) ! ;; '(font-lock-string-face font-lock-comment-face))) ! ;; (cperl-after-expr-p nil nil ' ! ;; (or (looking-at "[^]a-zA-Z0-9_)}]") ! ;; (eq (get-text-property (point) 'face) ! ;; 'font-lock-keyword-face)))))) ;; Stolen from lisp-mode with a lot of improvements --- 4323,4585 ---- (setq done t))) (goto-char tmp-end) (setq tmp-end (point-marker))) + (if cperl-indent-region-fix-constructs + (cperl-fix-line-spacing tmp-end)) (cperl-indent-region (point) tmp-end)))) + (defun cperl-fix-line-spacing (&optional end parse-data) + "Improve whitespace in a conditional/loop construct." + (interactive) + (or end + (setq end (point-max))) + (let (p pp ml have-brace + (ee (save-excursion (end-of-line) (point))) + (cperl-indent-region-fix-constructs + (or cperl-indent-region-fix-constructs 1))) + (save-excursion + (beginning-of-line) + ;; }? continue + ;; blah; } + (if (not + (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") + (setq have-brace (save-excursion (search-forward "}" ee t))))) + nil ; Do not need to do anything + ;; Looking at: + ;; } + ;; else + (if (and cperl-merge-trailing-else + (looking-at + "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) + (progn + (search-forward "}") + (setq p (point)) + (skip-chars-forward " \t\n") + (delete-region p (point)) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; } else + (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") + (progn + (search-forward "}") + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; else { + (if (looking-at + "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") + (progn + (forward-word 1) + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; foreach my $var + (if (looking-at + "[ \t]*\\\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") + (progn + (setq ml (match-beginning 8)) + (re-search-forward "[({]") + (forward-char -1) + (setq p (point)) + (if (eq (following-char) ?\( ) + (progn + (forward-sexp 1) + (setq pp (point))) + ;; after `else' or nothing + (if ml ; after `else' + (skip-chars-backward " \t\n") + (beginning-of-line)) + (setq pp nil)) + ;; Now after the sexp before the brace + ;; Multiline expr should be special + (setq ml (and pp (save-excursion (goto-char p) + (search-forward "\n" pp t)))) + (if (and (or (not pp) (< pp end)) + (looking-at "[ \t\n]*{")) + (progn + (cond + ((bolp) ; Were before `{', no if/else/etc + nil) + ((looking-at "\\(\t*\\| [ \t]+\\){") + (delete-horizontal-space) + (if (if ml + cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace) + (progn + (delete-horizontal-space) + (insert "\n") + (if (cperl-indent-line parse-data) + (cperl-fix-line-spacing end parse-data))) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )))) + ((and (looking-at "[ \t]*\n") + (not (if ml + cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace))) + (setq pp (point)) + (skip-chars-forward " \t\n") + (delete-region pp (point)) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )))) + ;; Now we are before `{' + (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") + (progn + (skip-chars-forward " \t\n") + (setq pp (point)) + (forward-sexp 1) + (setq p (point)) + (goto-char pp) + (setq ml (search-forward "\n" p t)) + (if (or cperl-break-one-line-blocks-when-indent ml) + ;; not good: multi-line BLOCK + (progn + (goto-char (1+ pp)) + (delete-horizontal-space) + (insert "\n") + (if (cperl-indent-line parse-data) + (cperl-fix-line-spacing end parse-data)))))))))) + (beginning-of-line) + (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee. + ;; Now check whether there is a hanging `}' + ;; Looking at: + ;; } blah + (if (and + cperl-fix-hanging-brace-when-indent + have-brace + (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)")) + (condition-case nil + (progn + (up-list 1) + (if (and (<= (point) pp) + (eq (preceding-char) ?\} ) + (cperl-after-block-and-statement-beg (point-min))) + t + (goto-char p) + nil)) + (error nil))) + (progn + (forward-char -1) + (skip-chars-backward " \t") + (if (bolp) + ;; `}' was the first thing on the line, insert NL *after* it. + (progn + (cperl-indent-line parse-data) + (search-forward "}") + (delete-horizontal-space) + (insert "\n")) + (delete-horizontal-space) + (or (eq (preceding-char) ?\;) + (bolp) + (and (eq (preceding-char) ?\} ) + (cperl-after-block-p (point-min))) + (insert ";")) + (insert "\n")) + (if (cperl-indent-line parse-data) + (cperl-fix-line-spacing end parse-data)) + (beginning-of-line))))))) + + (defvar cperl-update-start) ; Do not need to make them local + (defvar cperl-update-end) + (defun cperl-delay-update-hook (beg end old-len) + (setq cperl-update-start (min beg (or cperl-update-start (point-max)))) + (setq cperl-update-end (max end (or cperl-update-end (point-min))))) + (defun cperl-indent-region (start end) "Simple variant of indentation of region in CPerl mode. ! Should be slow. Will not indent comment if it starts at `comment-indent' or looks like continuation of the comment on the previous line. Indents all the lines whose first character is between START and END ! inclusive. ! ! If `cperl-indent-region-fix-constructs', will improve spacing on ! conditional/loop constructs." (interactive "r") + (cperl-update-syntaxification end end) (save-excursion ! (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) ! (let (st comm old-comm-indent new-comm-indent p pp i ! (indent-info (if cperl-emacs-can-parse ! (list nil nil) ; Cannot use '(), since will modify ! nil)) ! after-change-functions ; Speed it up! ! (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) ! (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook)) ! (goto-char start) ! (setq old-comm-indent (and (cperl-to-comment-or-eol) ! (current-column)) ! new-comm-indent old-comm-indent) ! (goto-char start) ! (setq end (set-marker (make-marker) end)) ; indentation changes pos ! (or (bolp) (beginning-of-line 2)) ! (or (fboundp 'imenu-progress-message) ! (message "Indenting... For feedback load `imenu'...")) ! (while (and (<= (point) end) (not (eobp))) ; bol to check start ! (and (fboundp 'imenu-progress-message) ! (imenu-progress-message ! pm (/ (* 100 (- (point) start)) (- end start -1)))) ! (setq st (point)) ! (if (and (setq comm (looking-at "[ \t]*#")) ! (or (eq (current-indentation) (or old-comm-indent ! comment-column)) ! (setq old-comm-indent nil))) ! (if (and old-comm-indent ! (= (current-indentation) old-comm-indent) ! (not (eq (get-text-property (point) 'syntax-type) 'pod))) ! (let ((comment-column new-comm-indent)) ! (indent-for-comment))) ! (progn ! (setq i (cperl-indent-line indent-info)) ! (or comm ! (not i) ! (progn ! (if cperl-indent-region-fix-constructs ! (cperl-fix-line-spacing end indent-info)) ! (if (setq old-comm-indent ! (and (cperl-to-comment-or-eol) ! (not (memq (get-text-property (point) ! 'syntax-type) ! '(pod here-doc))) ! (current-column))) ! (progn (indent-for-comment) ! (skip-chars-backward " \t") ! (skip-chars-backward "#") ! (setq new-comm-indent (current-column)))))))) ! (beginning-of-line 2)) (if (fboundp 'imenu-progress-message) ! (imenu-progress-message pm 100) ! (message nil))) ! ;; Now run the update hooks ! (if after-change-functions ! (save-excursion ! (if cperl-update-end ! (progn ! (goto-char cperl-update-end) ! (insert " ") ! (delete-char -1) ! (goto-char cperl-update-start) ! (insert " ") ! (delete-char -1)))))))) ;; Stolen from lisp-mode with a lot of improvements *************** *** 3179,3185 **** "Like \\[fill-paragraph], but handle CPerl comments. If any of the current line is a comment, fill the comment or the block of it that point is in, preserving the comment's initial ! indentation and initial hashes. Behaves usually outside of comment." (interactive "P") (let ( ;; Non-nil if the current line contains a comment. --- 4587,4593 ---- "Like \\[fill-paragraph], but handle CPerl comments. If any of the current line is a comment, fill the comment or the block of it that point is in, preserving the comment's initial ! indentation and initial hashes. Behaves usually outside of comment." (interactive "P") (let ( ;; Non-nil if the current line contains a comment. *************** *** 3292,3298 **** (defun cperl-imenu-addback (lst &optional isback name) ;; We suppose that the lst is a DAG, unless the first element only ! ;; loops back, and ISBACK is set. Thus this function cannot be ;; applied twice without ISBACK set. (cond ((not cperl-imenu-addback) lst) (t --- 4700,4706 ---- (defun cperl-imenu-addback (lst &optional isback name) ;; We suppose that the lst is a DAG, unless the first element only ! ;; loops back, and ISBACK is set. Thus this function cannot be ;; applied twice without ISBACK set. (cond ((not cperl-imenu-addback) lst) (t *************** *** 3319,3332 **** packages ends-ranges p (prev-pos 0) char fchar index index1 name (end-range 0) package) (goto-char (point-min)) ! (imenu-progress-message prev-pos 0) ;; Search for the function (progn ;;save-match-data (while (re-search-forward (or regexp imenu-example--function-name-regexp-perl) nil t) ! (imenu-progress-message prev-pos) ! ;;(backward-up-list 1) (cond ((and ; Skip some noise if building tags (match-beginning 2) ; package or sub --- 4727,4742 ---- packages ends-ranges p (prev-pos 0) char fchar index index1 name (end-range 0) package) (goto-char (point-min)) ! (if noninteractive ! (message "Scanning Perl for index") ! (imenu-progress-message prev-pos 0)) ;; Search for the function (progn ;;save-match-data (while (re-search-forward (or regexp imenu-example--function-name-regexp-perl) nil t) ! (or noninteractive ! (imenu-progress-message prev-pos)) (cond ((and ; Skip some noise if building tags (match-beginning 2) ; package or sub *************** *** 3395,3401 **** (setq index1 (cons (concat "=" name) (cdr index))) (push index index-pod-alist) (push index1 index-unsorted-alist))))) ! (imenu-progress-message prev-pos 100) (setq index-alist (if (default-value 'imenu-sort-function) (sort index-alist (default-value 'imenu-sort-function)) --- 4805,4812 ---- (setq index1 (cons (concat "=" name) (cdr index))) (push index index-pod-alist) (push index1 index-unsorted-alist))))) ! (or noninteractive ! (imenu-progress-message prev-pos 100)) (setq index-alist (if (default-value 'imenu-sort-function) (sort index-alist (default-value 'imenu-sort-function)) *************** *** 3464,3499 **** cperl-compilation-error-regexp-alist))) - (defvar cperl-faces-init nil) - (defun cperl-windowed-init () "Initialization under windowed version." ! (add-hook 'font-lock-mode-hook ! (function ! (lambda () ! (if (or ! (eq major-mode 'perl-mode) ! (eq major-mode 'cperl-mode)) ! (progn ! (or cperl-faces-init (cperl-init-faces)))))))) (defvar perl-font-lock-keywords-1 nil ! "Additional expressions to highlight in Perl mode. Minimal set.") (defvar perl-font-lock-keywords nil ! "Additional expressions to highlight in Perl mode. Default set.") (defvar perl-font-lock-keywords-2 nil ! "Additional expressions to highlight in Perl mode. Maximal set") (defun cperl-init-faces () ! (condition-case nil (progn (require 'font-lock) (and (fboundp 'font-lock-fontify-anchored-keywords) (featurep 'font-lock-extra) ! (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) - ;;(defvar cperl-font-lock-enhanced nil - ;; "Set to be non-nil if font-lock allows active highlights.") (if (fboundp 'font-lock-fontify-anchored-keywords) (setq font-lock-anchored t)) (setq --- 4875,4932 ---- cperl-compilation-error-regexp-alist))) (defun cperl-windowed-init () "Initialization under windowed version." ! (if (or (featurep 'ps-print) cperl-faces-init) ! ;; Need to init anyway: ! (or cperl-faces-init (cperl-init-faces)) ! (add-hook 'font-lock-mode-hook ! (function ! (lambda () ! (if (or ! (eq major-mode 'perl-mode) ! (eq major-mode 'cperl-mode)) ! (progn ! (or cperl-faces-init (cperl-init-faces))))))) ! (if (fboundp 'eval-after-load) ! (eval-after-load ! "ps-print" ! '(or cperl-faces-init (cperl-init-faces)))))) ! ! (defun cperl-load-font-lock-keywords () ! (or cperl-faces-init (cperl-init-faces)) ! perl-font-lock-keywords) ! ! (defun cperl-load-font-lock-keywords-1 () ! (or cperl-faces-init (cperl-init-faces)) ! perl-font-lock-keywords-1) ! ! (defun cperl-load-font-lock-keywords-2 () ! (or cperl-faces-init (cperl-init-faces)) ! perl-font-lock-keywords-2) (defvar perl-font-lock-keywords-1 nil ! "Additional expressions to highlight in Perl mode. Minimal set.") (defvar perl-font-lock-keywords nil ! "Additional expressions to highlight in Perl mode. Default set.") (defvar perl-font-lock-keywords-2 nil ! "Additional expressions to highlight in Perl mode. Maximal set") ! ! (defvar font-lock-background-mode) ! (defvar font-lock-display-type) ! (defun cperl-init-faces-weak () ! ;; Allow `cperl-find-pods-heres' to run. ! (or (boundp 'font-lock-constant-face) ! (setq font-lock-constant-face 'font-lock-constant-face))) (defun cperl-init-faces () ! (condition-case errs (progn (require 'font-lock) (and (fboundp 'font-lock-fontify-anchored-keywords) (featurep 'font-lock-extra) ! (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) (if (fboundp 'font-lock-fontify-anchored-keywords) (setq font-lock-anchored t)) (setq *************** *** 3532,3538 **** ;; "getservbyport" "getservent" "getsockname" ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length" ! ;; "link" "listen" "localtime" "log" "lstat" "lt" ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne" ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe" ;; "quotemeta" "rand" "read" "readdir" "readline" --- 4965,4971 ---- ;; "getservbyport" "getservent" "getsockname" ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length" ! ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt" ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne" ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe" ;; "quotemeta" "rand" "read" "readdir" "readline" *************** *** 3564,3570 **** "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|" "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|" "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e" ! "\\(\\|ngth\\)\\|o\\(caltime\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|" "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|" "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|" "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin" --- 4997,5003 ---- "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|" "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|" "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e" ! "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|" "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|" "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|" "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin" *************** *** 3600,3606 **** "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|" "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|" "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" ! "q\\(\\|q\\|w\\|x\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|" "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|" "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually --- 5033,5039 ---- "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|" "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|" "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" ! "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|" "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|" "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually *************** *** 3630,3641 **** (1 font-lock-string-face t)))) (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 2 font-lock-string-face t))) ! '("[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 ! font-lock-reference-face) ; labels '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets ! 2 font-lock-reference-face) (cond ((featurep 'font-lock-extra) '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" (3 font-lock-variable-name-face) --- 5063,5074 ---- (1 font-lock-string-face t)))) (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 2 font-lock-string-face t))) ! '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 ! font-lock-constant-face) ; labels '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets ! 2 font-lock-constant-face) (cond ((featurep 'font-lock-extra) '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" (3 font-lock-variable-name-face) *************** *** 3661,3675 **** '( ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 (if (eq (char-after (match-beginning 2)) ?%) ! font-lock-other-emphasized-face ! font-lock-emphasized-face) t) ; arrays and hashes ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) (if (eq (char-after (match-beginning 3)) ?{) ! font-lock-other-emphasized-face ! font-lock-emphasized-face) ; arrays and hashes font-lock-variable-name-face) ; Just to put something t) ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") --- 5094,5108 ---- '( ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 (if (eq (char-after (match-beginning 2)) ?%) ! cperl-hash-face ! cperl-array-face) t) ; arrays and hashes ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) (if (eq (char-after (match-beginning 3)) ?{) ! cperl-hash-face ! cperl-array-face) ; arrays and hashes font-lock-variable-name-face) ; Just to put something t) ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") *************** *** 3680,3693 **** ;; (if (cperl-slash-is-regexp) ;; font-lock-function-name-face 'default) nil t)) ))) ! (setq perl-font-lock-keywords-1 t-font-lock-keywords perl-font-lock-keywords perl-font-lock-keywords-1 perl-font-lock-keywords-2 (append ! t-font-lock-keywords t-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) ! (font-lock-require-faces (list ;; Color-light Color-dark Gray-light Gray-dark Mono (list 'font-lock-comment-face --- 5113,5131 ---- ;; (if (cperl-slash-is-regexp) ;; font-lock-function-name-face 'default) nil t)) ))) ! (setq perl-font-lock-keywords-1 ! (if cperl-syntaxify-by-font-lock ! (cons 'cperl-fontify-update ! t-font-lock-keywords) ! t-font-lock-keywords) perl-font-lock-keywords perl-font-lock-keywords-1 perl-font-lock-keywords-2 (append ! perl-font-lock-keywords-1 t-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) ! (eval ; Avoid a warning ! '(font-lock-require-faces (list ;; Color-light Color-dark Gray-light Gray-dark Mono (list 'font-lock-comment-face *************** *** 3733,3739 **** nil [nil nil t t t] ) ! (list 'font-lock-reference-face ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] nil [nil nil t t t] --- 5171,5177 ---- nil [nil nil t t t] ) ! (list 'font-lock-constant-face ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] nil [nil nil t t t] *************** *** 3748,3852 **** [nil nil t t] [nil nil t t t] ) ! (list 'font-lock-emphasized-face ["blue" "yellow" nil "Gray80"] ["lightyellow2" ("navy" "os2blue" "darkgreen") "gray90"] t nil nil) ! (list 'font-lock-other-emphasized-face ["red" "red" nil "Gray80"] ["lightyellow2" ("navy" "os2blue" "darkgreen") "gray90"] t t ! nil))) (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") ! (or (fboundp 'x-color-defined-p) ! (defalias 'x-color-defined-p ! (cond ((fboundp 'color-defined-p) 'color-defined-p) ! ;; XEmacs >= 19.12 ! ((fboundp 'valid-color-name-p) 'valid-color-name-p) ! ;; XEmacs 19.11 ! (t 'x-valid-color-name-p)))) ! (defvar font-lock-reference-face 'font-lock-reference-face) ! (defvar font-lock-variable-name-face 'font-lock-variable-name-face) ! (or (boundp 'font-lock-type-face) ! (defconst font-lock-type-face ! 'font-lock-type-face ! "Face to use for data types.") ! ) ! (or (boundp 'font-lock-other-type-face) ! (defconst font-lock-other-type-face ! 'font-lock-other-type-face ! "Face to use for data types from another group.") ! ) ! (if (not cperl-xemacs-p) nil ! (or (boundp 'font-lock-comment-face) ! (defconst font-lock-comment-face ! 'font-lock-comment-face ! "Face to use for comments.") ! ) ! (or (boundp 'font-lock-keyword-face) ! (defconst font-lock-keyword-face ! 'font-lock-keyword-face ! "Face to use for keywords.") ! ) ! (or (boundp 'font-lock-function-name-face) ! (defconst font-lock-function-name-face ! 'font-lock-function-name-face ! "Face to use for function names.") ! ) ! ) ! ;;(if (featurep 'font-lock) ! (if (face-equal font-lock-type-face font-lock-comment-face) ! (defconst font-lock-type-face ! 'font-lock-type-face ! "Face to use for basic data types.") ! ) ! ;;; (if (fboundp 'eval-after-load) ! ;;; (eval-after-load "font-lock" ! ;;; '(if (face-equal font-lock-type-face ! ;;; font-lock-comment-face) ! ;;; (defconst font-lock-type-face ! ;;; 'font-lock-type-face ! ;;; "Face to use for basic data types.") ! ;;; ))) ; This does not work :-( Why?! ! ;;; ; Workaround: added to font-lock-m-h ! ;;; ) ! (or (boundp 'font-lock-other-emphasized-face) ! (defconst font-lock-other-emphasized-face ! 'font-lock-other-emphasized-face ! "Face to use for another type of emphasizing.") ! ) ! (or (boundp 'font-lock-emphasized-face) ! (defconst font-lock-emphasized-face ! 'font-lock-emphasized-face ! "Face to use for emphasizing.") ! ) ;; Here we try to guess background (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode 'light)) (face-list (and (fboundp 'face-list) (face-list))) ! is-face) ! (fset 'is-face ! (cond ((fboundp 'find-face) ! (symbol-function 'find-face)) ! (face-list ! (function (lambda (face) (member face face-list)))) ! (t ! (function (lambda (face) (boundp face)))))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) 'gray background) "Background as guessed by CPerl mode") ! (if (is-face 'font-lock-type-face) nil (copy-face 'default 'font-lock-type-face) (cond ((eq background 'light) --- 5186,5299 ---- [nil nil t t] [nil nil t t t] ) ! (list 'cperl-array-face ["blue" "yellow" nil "Gray80"] ["lightyellow2" ("navy" "os2blue" "darkgreen") "gray90"] t nil nil) ! (list 'cperl-hash-face ["red" "red" nil "Gray80"] ["lightyellow2" ("navy" "os2blue" "darkgreen") "gray90"] t t ! nil)))) ! ;; Do it the dull way, without choose-color (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") ! ;; (or (fboundp 'x-color-defined-p) ! ;; (defalias 'x-color-defined-p ! ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) ! ;; ;; XEmacs >= 19.12 ! ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) ! ;; ;; XEmacs 19.11 ! ;; (t 'x-valid-color-name-p)))) ! (cperl-force-face font-lock-constant-face ! "Face for constant and label names") ! (cperl-force-face font-lock-variable-name-face ! "Face for variable names") ! (cperl-force-face font-lock-type-face ! "Face for data types") ! (cperl-force-face font-lock-other-type-face ! "Face for data types from another group") ! (cperl-force-face font-lock-comment-face ! "Face for comments") ! (cperl-force-face font-lock-keyword-face ! "Face for keywords") ! (cperl-force-face font-lock-function-name-face ! "Face for function names") ! (cperl-force-face cperl-hash-face ! "Face for hashes") ! (cperl-force-face cperl-array-face ! "Face for arrays") ! ;;(defvar font-lock-constant-face 'font-lock-constant-face) ! ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) ! ;;(or (boundp 'font-lock-type-face) ! ;; (defconst font-lock-type-face ! ;; 'font-lock-type-face ! ;; "Face to use for data types.")) ! ;;(or (boundp 'font-lock-other-type-face) ! ;; (defconst font-lock-other-type-face ! ;; 'font-lock-other-type-face ! ;; "Face to use for data types from another group.")) ! ;;(if (not cperl-xemacs-p) nil ! ;; (or (boundp 'font-lock-comment-face) ! ;; (defconst font-lock-comment-face ! ;; 'font-lock-comment-face ! ;; "Face to use for comments.")) ! ;; (or (boundp 'font-lock-keyword-face) ! ;; (defconst font-lock-keyword-face ! ;; 'font-lock-keyword-face ! ;; "Face to use for keywords.")) ! ;; (or (boundp 'font-lock-function-name-face) ! ;; (defconst font-lock-function-name-face ! ;; 'font-lock-function-name-face ! ;; "Face to use for function names."))) ! (if (and ! (not (cperl-is-face 'cperl-array-face)) ! (cperl-is-face 'font-lock-emphasized-face)) ! (copy-face 'font-lock-emphasized-face 'cperl-array-face)) ! (if (and ! (not (cperl-is-face 'cperl-hash-face)) ! (cperl-is-face 'font-lock-other-emphasized-face)) ! (copy-face 'font-lock-other-emphasized-face ! 'cperl-hash-face)) ! ;;(or (boundp 'cperl-hash-face) ! ;; (defconst cperl-hash-face ! ;; 'cperl-hash-face ! ;; "Face to use for hashes.")) ! ;;(or (boundp 'cperl-array-face) ! ;; (defconst cperl-array-face ! ;; 'cperl-array-face ! ;; "Face to use for arrays.")) ;; Here we try to guess background (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode 'light)) (face-list (and (fboundp 'face-list) (face-list))) ! ;; cperl-is-face ! ) ! ;;;; (fset 'cperl-is-face ! ;;;; (cond ((fboundp 'find-face) ! ;;;; (symbol-function 'find-face)) ! ;;;; (face-list ! ;;;; (function (lambda (face) (member face face-list)))) ! ;;;; (t ! ;;;; (function (lambda (face) (boundp face)))))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) 'gray background) "Background as guessed by CPerl mode") ! (if (and ! (not (cperl-is-face 'font-lock-constant-face)) ! (cperl-is-face 'font-lock-reference-face)) ! (copy-face 'font-lock-reference-face 'font-lock-constant-face)) ! (if (cperl-is-face 'font-lock-type-face) nil (copy-face 'default 'font-lock-type-face) (cond ((eq background 'light) *************** *** 3861,3867 **** "pink"))) (t (set-face-background 'font-lock-type-face "gray90")))) ! (if (is-face 'font-lock-other-type-face) nil (copy-face 'font-lock-type-face 'font-lock-other-type-face) (cond --- 5308,5314 ---- "pink"))) (t (set-face-background 'font-lock-type-face "gray90")))) ! (if (cperl-is-face 'font-lock-other-type-face) nil (copy-face 'font-lock-type-face 'font-lock-other-type-face) (cond *************** *** 3875,3881 **** (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) ! (if (is-face 'font-lock-other-emphasized-face) nil (copy-face 'bold-italic 'font-lock-other-emphasized-face) (cond ((eq background 'light) --- 5322,5328 ---- (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) ! (if (cperl-is-face 'font-lock-other-emphasized-face) nil (copy-face 'bold-italic 'font-lock-other-emphasized-face) (cond ((eq background 'light) *************** *** 3893,3899 **** "darkgreen" "dark green")))) (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) ! (if (is-face 'font-lock-emphasized-face) nil (copy-face 'bold 'font-lock-emphasized-face) (cond ((eq background 'light) --- 5340,5346 ---- "darkgreen" "dark green")))) (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) ! (if (cperl-is-face 'font-lock-emphasized-face) nil (copy-face 'bold 'font-lock-emphasized-face) (cond ((eq background 'light) *************** *** 3909,3920 **** "darkgreen" "dark green")))) (t (set-face-background 'font-lock-emphasized-face "gray90")))) ! (if (is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) ! (if (is-face 'font-lock-reference-face) nil ! (copy-face 'italic 'font-lock-reference-face)))) (setq cperl-faces-init t)) ! (error nil))) (defun cperl-ps-print-init () --- 5356,5367 ---- "darkgreen" "dark green")))) (t (set-face-background 'font-lock-emphasized-face "gray90")))) ! (if (cperl-is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) ! (if (cperl-is-face 'font-lock-constant-face) nil ! (copy-face 'italic 'font-lock-constant-face)))) (setq cperl-faces-init t)) ! (error (message "cperl-init-faces (ignored): %s" errs)))) (defun cperl-ps-print-init () *************** *** 3927,3937 **** --- 5374,5386 ---- (append '(font-lock-emphasized-face font-lock-keyword-face font-lock-variable-name-face + font-lock-constant-face font-lock-reference-face font-lock-other-emphasized-face) ps-bold-faces)) (setq ps-italic-faces (append '(font-lock-other-type-face + font-lock-constant-face font-lock-reference-face font-lock-other-emphasized-face) ps-italic-faces)) *************** *** 3945,3976 **** (if (cperl-enable-font-lock) (cperl-windowed-init)) (defun cperl-set-style (style) "Set CPerl-mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. ! Available styles are GNU, K&R, BSD and Whitesmith." (interactive (let ((list (mapcar (function (lambda (elt) (list (car elt)))) ! c-style-alist))) (list (completing-read "Enter style: " list nil 'insist)))) ! (let ((style (cdr (assoc style c-style-alist))) setting str sym) (while style (setq setting (car style) style (cdr style)) ! (setq str (symbol-name (car setting))) ! (and (string-match "^c-" str) ! (setq str (concat "cperl-" (substring str 2))) ! (setq sym (intern-soft str)) ! (boundp sym) ! (set sym (cdr setting)))))) (defun cperl-check-syntax () (interactive) (require 'mode-compile) ! (let ((perl-dbg-flags "-wc")) ! (mode-compile))) (defun cperl-info-buffer (type) ! ;; Returns buffer with documentation. Creates if missing. ;; If TYPE, this vars buffer. ;; Special care is taken to not stomp over an existing info buffer (let* ((bname (if type "*info-perl-var*" "*info-perl*")) --- 5394,5508 ---- (if (cperl-enable-font-lock) (cperl-windowed-init)) + (defconst cperl-styles-entries + '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset + cperl-label-offset cperl-extra-newline-before-brace + cperl-merge-trailing-else + cperl-continued-statement-offset)) + + (defconst cperl-style-alist + '(("CPerl" ; =GNU without extra-newline-before-brace + (cperl-indent-level . 2) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-extra-newline-before-brace . nil) + (cperl-merge-trailing-else . t) + (cperl-continued-statement-offset . 2)) + ("PerlStyle" ; CPerl with 4 as indent + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -4) + (cperl-extra-newline-before-brace . nil) + (cperl-merge-trailing-else . t) + (cperl-continued-statement-offset . 4)) + ("GNU" + (cperl-indent-level . 2) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-extra-newline-before-brace . t) + (cperl-merge-trailing-else . nil) + (cperl-continued-statement-offset . 2)) + ("K&R" + (cperl-indent-level . 5) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . -5) + (cperl-label-offset . -5) + ;;(cperl-extra-newline-before-brace . nil) ; ??? + (cperl-merge-trailing-else . nil) + (cperl-continued-statement-offset . 5)) + ("BSD" + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . -4) + (cperl-label-offset . -4) + ;;(cperl-extra-newline-before-brace . nil) ; ??? + (cperl-continued-statement-offset . 4)) + ("C++" + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . -4) + (cperl-label-offset . -4) + (cperl-continued-statement-offset . 4) + (cperl-merge-trailing-else . nil) + (cperl-extra-newline-before-brace . t)) + ("Current") + ("Whitesmith" + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -4) + ;;(cperl-extra-newline-before-brace . nil) ; ??? + (cperl-continued-statement-offset . 4))) + "(Experimental) list of variables to set to get a particular indentation style. + Should be used via `cperl-set-style' or via CPerl menu.") + (defun cperl-set-style (style) "Set CPerl-mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. ! The list of styles is in `cperl-style-alist', available styles ! are GNU, K&R, BSD, C++ and Whitesmith. ! ! The current value of style is memorized (unless there is a memorized ! data already), may be restored by `cperl-set-style-back'. ! ! Chosing \"Current\" style will not change style, so this may be used for ! side-effect of memorizing only." (interactive (let ((list (mapcar (function (lambda (elt) (list (car elt)))) ! cperl-style-alist))) (list (completing-read "Enter style: " list nil 'insist)))) ! (or cperl-old-style ! (setq cperl-old-style ! (mapcar (function ! (lambda (name) ! (cons name (eval name)))) ! cperl-styles-entries))) ! (let ((style (cdr (assoc style cperl-style-alist))) setting str sym) (while style (setq setting (car style) style (cdr style)) ! (set (car setting) (cdr setting))))) ! ! (defun cperl-set-style-back () ! "Restore a style memorised by `cperl-set-style'." ! (interactive) ! (or cperl-old-style (error "The style was not changed")) ! (let (setting) ! (while cperl-old-style ! (setq setting (car cperl-old-style) ! cperl-old-style (cdr cperl-old-style)) ! (set (car setting) (cdr setting))))) (defun cperl-check-syntax () (interactive) (require 'mode-compile) ! (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc"))) ! (eval '(mode-compile)))) ; Avoid a warning (defun cperl-info-buffer (type) ! ;; Returns buffer with documentation. Creates if missing. ;; If TYPE, this vars buffer. ;; Special care is taken to not stomp over an existing info buffer (let* ((bname (if type "*info-perl-var*" "*info-perl*")) *************** *** 4250,4255 **** --- 5782,5808 ---- (message "Parentheses will %sbe auto-doubled now." (if (cperl-val 'cperl-electric-parens) "" "not "))) + (defun cperl-toggle-autohelp () + "Toggle the state of automatic help message in CPerl mode. + See `cperl-lazy-help-time' too." + (interactive) + (if (fboundp 'run-with-idle-timer) + (progn + (if cperl-lazy-installed + (eval '(cperl-lazy-unstall)) + (cperl-lazy-install)) + (message "Perl help messages will %sbe automatically shown now." + (if cperl-lazy-installed "" "not "))) + (message "Cannot automatically show Perl help messages - run-with-idle-timer missing."))) + + (defun cperl-toggle-construct-fix () + "Toggle whether `indent-region'/`indent-sexp' fix whitespace too." + (interactive) + (setq cperl-indent-region-fix-constructs + (not cperl-indent-region-fix-constructs)) + (message "indent-region/indent-sexp will %sbe automatically fix whitespace." + (if cperl-indent-region-fix-constructs "" "not "))) + ;;;; Tags file creation. (defvar cperl-tmp-buffer " *cperl-tmp*") *************** *** 4271,4283 **** (let ((index-alist '()) (prev-pos 0) index index1 name package prefix) (goto-char (point-min)) ! (imenu-progress-message prev-pos 0) ;; Search for the function (progn ;;save-match-data (while (re-search-forward "^\\([ \t]*MODULE\\>[^\n]*\\\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)" nil t) ! (imenu-progress-message prev-pos) (cond ((match-beginning 2) ; SECTION (setq package (buffer-substring (match-beginning 2) (match-end 2))) --- 5824,5839 ---- (let ((index-alist '()) (prev-pos 0) index index1 name package prefix) (goto-char (point-min)) ! (if noninteractive ! (message "Scanning XSUB for index") ! (imenu-progress-message prev-pos 0)) ;; Search for the function (progn ;;save-match-data (while (re-search-forward "^\\([ \t]*MODULE\\>[^\n]*\\\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)" nil t) ! (or noninteractive ! (imenu-progress-message prev-pos)) (cond ((match-beginning 2) ; SECTION (setq package (buffer-substring (match-beginning 2) (match-end 2))) *************** *** 4305,4328 **** (setq index (imenu-example--name-and-position)) (setcar index (concat package "::BOOT:")) (push index index-alist))))) ! (imenu-progress-message prev-pos 100) ! ;;(setq index-alist ! ;; (if (default-value 'imenu-sort-function) ! ;; (sort index-alist (default-value 'imenu-sort-function)) ! ;; (nreverse index-alist))) index-alist)) ! (defun cperl-find-tags (file xs) ! (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret (cperl-pod-here-fontify nil)) (save-excursion (if b (set-buffer b) (cperl-setup-tmp-buf)) (erase-buffer) (setq file (car (insert-file-contents file))) ! (message "Scanning file %s..." file) ! (if cperl-use-syntax-table-text-property-for-tags ! (cperl-find-pods-heres)) (if xs (setq lst (cperl-xsub-scan)) (setq ind (imenu-example--create-perl-index)) --- 5861,5884 ---- (setq index (imenu-example--name-and-position)) (setcar index (concat package "::BOOT:")) (push index index-alist))))) ! (or noninteractive ! (imenu-progress-message prev-pos 100)) index-alist)) ! (defun cperl-find-tags (file xs topdir) ! (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel (cperl-pod-here-fontify nil)) (save-excursion (if b (set-buffer b) (cperl-setup-tmp-buf)) (erase-buffer) (setq file (car (insert-file-contents file))) ! (message "Scanning file %s ..." file) ! (if (and cperl-use-syntax-table-text-property-for-tags ! (not xs)) ! (condition-case err ; after __END__ may have garbage ! (cperl-find-pods-heres) ! (error (message "While scanning for syntax: %s" err)))) (if xs (setq lst (cperl-xsub-scan)) (setq ind (imenu-example--create-perl-index)) *************** *** 4370,4388 **** lst)))))) (setq pos (point)) (goto-char 1) ! (insert "\f\n" file "," (number-to-string (1- pos)) "\n") (setq ret (buffer-substring 1 (point-max))) (erase-buffer) ! (message "Scanning file %s finished" file) ret))) ! (defun cperl-write-tags (&optional file erase recurse dir inbuffer) ;; If INBUFFER, do not select buffer, and do not save ;; If ERASE is `ignore', do not erase, and do not try to delete old info. (require 'etags) (if file nil (setq file (if dir default-directory (buffer-file-name))) (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!"))) (let ((tags-file-name "TAGS") (case-fold-search (eq system-type 'emx)) xs) --- 5926,5968 ---- lst)))))) (setq pos (point)) (goto-char 1) ! (setq rel file) ! ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties ! (set-text-properties 0 (length rel) nil rel) ! (and (equal topdir (substring rel 0 (length topdir))) ! (setq rel (substring file (length topdir)))) ! (insert "\f\n" rel "," (number-to-string (1- pos)) "\n") (setq ret (buffer-substring 1 (point-max))) (erase-buffer) ! (or noninteractive ! (message "Scanning file %s finished" file)) ret))) ! (defun cperl-add-tags-recurse-noxs () ! "Add to TAGS data for Perl and XSUB files in the current directory and kids. ! Use as ! emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ ! -f cperl-add-tags-recurse ! " ! (cperl-write-tags nil nil t t nil t)) ! ! (defun cperl-add-tags-recurse () ! "Add to TAGS file data for Perl files in the current directory and kids. ! Use as ! emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ ! -f cperl-add-tags-recurse ! " ! (cperl-write-tags nil nil t t)) ! ! (defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir) ;; If INBUFFER, do not select buffer, and do not save ;; If ERASE is `ignore', do not erase, and do not try to delete old info. (require 'etags) (if file nil (setq file (if dir default-directory (buffer-file-name))) (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!"))) + (or topdir + (setq topdir default-directory)) (let ((tags-file-name "TAGS") (case-fold-search (eq system-type 'emx)) xs) *************** *** 4407,4434 **** nil) ((not (file-directory-p file)) (if (string-match cperl-scan-files-regexp file) ! (cperl-write-tags file erase recurse nil t))) ((not recurse) nil) ! (t (cperl-write-tags file erase recurse t t))))) files)) ) (t (setq xs (string-match "\\.xs$" file)) ! (cond ((eq erase 'ignore) (goto-char (point-max))) ! (erase (erase-buffer)) ! (t ! (goto-char 1) ! (if (search-forward (concat "\f\n" file ",") nil t) ! (progn ! (search-backward "\f\n") ! (delete-region (point) ! (save-excursion ! (forward-char 1) ! (if (search-forward "\f\n" nil 'toend) ! (- (point) 2) ! (point-max))))) ! (goto-char (point-max))))) ! (insert (cperl-find-tags file xs)))) (if inbuffer nil ; Delegate to the caller (save-buffer 0) ; No backup (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? --- 5987,6017 ---- nil) ((not (file-directory-p file)) (if (string-match cperl-scan-files-regexp file) ! (cperl-write-tags file erase recurse nil t noxs topdir))) ((not recurse) nil) ! (t (cperl-write-tags file erase recurse t t noxs topdir))))) files)) ) (t (setq xs (string-match "\\.xs$" file)) ! (if (not (and xs noxs)) ! (progn ! (cond ((eq erase 'ignore) (goto-char (point-max))) ! (erase (erase-buffer)) ! (t ! (goto-char 1) ! (if (search-forward (concat "\f\n" file ",") nil t) ! (progn ! (search-backward "\f\n") ! (delete-region (point) ! (save-excursion ! (forward-char 1) ! (if (search-forward "\f\n" ! nil 'toend) ! (- (point) 2) ! (point-max))))) ! (goto-char (point-max))))) ! (insert (cperl-find-tags file xs topdir)))))) (if inbuffer nil ; Delegate to the caller (save-buffer 0) ; No backup (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? *************** *** 4543,4549 **** (if (eq update -999) (cperl-tags-hier-init t))) (defun cperl-tags-treeify (to level) ! ;; cadr of `to' is read-write. On start it is a cons (let* ((regexp (concat "^\\(" (mapconcat 'identity (make-list level "[_a-zA-Z0-9]+") --- 6126,6132 ---- (if (eq update -999) (cperl-tags-hier-init t))) (defun cperl-tags-treeify (to level) ! ;; cadr of `to' is read-write. On start it is a cons (let* ((regexp (concat "^\\(" (mapconcat 'identity (make-list level "[_a-zA-Z0-9]+") *************** *** 4670,4683 **** "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) "<\\$?\\sw+\\(\\.\\sw+\\)?>" ; ! "-[a-zA-Z][ \t]+[_$\"'`]" ; -f file "-[0-9]" ; -5 "\\+\\+" ; ++var "--" ; --var ".->" ; a->b "->" ; a SPACE ->b "\\[-" ; a[-1] "^=" ; =head "||" "&&" "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C --- 6253,6269 ---- "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) "<\\$?\\sw+\\(\\.\\sw+\\)?>" ; ! "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN "-[0-9]" ; -5 "\\+\\+" ; ++var "--" ; --var ".->" ; a->b "->" ; a SPACE ->b "\\[-" ; a[-1] + "\\\\[&$@*\\\\]" ; \&func "^=" ; =head + "\\$." ; $| + "<<[a-zA-Z_'\"`]" ; <" ; C *************** *** 4828,4834 **** (defun cperl-get-help () "Get one-line docs on the symbol at the point. The data for these docs is a little bit obsolete and may be in fact longer ! than a line. Your contribution to update/shorten it is appreciated." (interactive) (save-match-data ; May be called "inside" query-replace (save-excursion --- 6414,6420 ---- (defun cperl-get-help () "Get one-line docs on the symbol at the point. The data for these docs is a little bit obsolete and may be in fact longer ! than a line. Your contribution to update/shorten it is appreciated." (interactive) (save-match-data ; May be called "inside" query-replace (save-excursion *************** *** 4899,4908 **** ! ... Logical negation. ... != ... Numeric inequality. ... !~ ... Search pattern, substitution, or translation (negated). ! $! In numeric context: errno. In a string context: error string. $\" The separator which joins elements of arrays interpolated in strings. ! $# The output format for printed numbers. Initial value is %.20g. ! $$ Process number of this script. Changes in the fork()ed child process. $% The current page number of the currently selected output channel. The following variables are always local to the current block: --- 6485,6494 ---- ! ... Logical negation. ... != ... Numeric inequality. ... !~ ... Search pattern, substitution, or translation (negated). ! $! In numeric context: errno. In a string context: error string. $\" The separator which joins elements of arrays interpolated in strings. ! $# The output format for printed numbers. Initial value is %.15g or close. ! $$ Process number of this script. Changes in the fork()ed child process. $% The current page number of the currently selected output channel. The following variables are always local to the current block: *************** *** 4928,4938 **** $- The number of lines left on the page. $. The current input line number of the last filehandle that was read. $/ The input record separator, newline by default. ! $0 Name of the file containing the perl script being executed. May be set. $: String may be broken after these characters to fill ^-lines in a format. ! $; Subscript separator for multi-dim array emulation. Default \"\\034\". $< The real uid of this process. ! $= The page length of the current output channel. Default is 60 lines. $> The effective uid of this process. $? The status returned by the last ``, pipe close or `system'. $@ The perl error message from the last eval or do @var{EXPR} command. --- 6514,6524 ---- $- The number of lines left on the page. $. The current input line number of the last filehandle that was read. $/ The input record separator, newline by default. ! $0 Name of the file containing the perl script being executed. May be set. $: String may be broken after these characters to fill ^-lines in a format. ! $; Subscript separator for multi-dim array emulation. Default \"\\034\". $< The real uid of this process. ! $= The page length of the current output channel. Default is 60 lines. $> The effective uid of this process. $? The status returned by the last ``, pipe close or `system'. $@ The perl error message from the last eval or do @var{EXPR} command. *************** *** 4947,4960 **** $^F The highest system file descriptor, ordinarily 2. $^H The current set of syntax checks enabled by `use strict'. $^I The value of the in-place edit extension (perl -i option). ! $^L What formats output to perform a formfeed. Default is \f. $^O The operating system name under which this copy of Perl was built. $^P Internal debugging flag. ! $^T The time the script was started. Used by -A/-M/-C file tests. $^W True if warnings are requested (perl -w flag). $^X The name under which perl was invoked (argv[0] in C-speech). $_ The default input and pattern-searching space. ! $| Auto-flush after write/print on the current output channel? Default 0. $~ The name of the current report format. ... % ... Modulo division. ... %= ... Modulo division assignment. --- 6533,6547 ---- $^F The highest system file descriptor, ordinarily 2. $^H The current set of syntax checks enabled by `use strict'. $^I The value of the in-place edit extension (perl -i option). ! $^L What formats output to perform a formfeed. Default is \f. ! $^M A buffer for emergency memory allocation when running out of memory. $^O The operating system name under which this copy of Perl was built. $^P Internal debugging flag. ! $^T The time the script was started. Used by -A/-M/-C file tests. $^W True if warnings are requested (perl -w flag). $^X The name under which perl was invoked (argv[0] in C-speech). $_ The default input and pattern-searching space. ! $| Auto-flush after write/print on current output channel? Default 0. $~ The name of the current report format. ... % ... Modulo division. ... %= ... Modulo division assignment. *************** *** 4967,4974 **** ... &= ... Bitwise and assignment. ... * ... Multiplication. ... ** ... Exponentiation. ! *NAME Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2. ! &NAME(arg0, ...) Subroutine call. Arguments go to @_. ... + ... Addition. +EXPR Makes EXPR into scalar context. ++ Auto-increment (magical on strings). ++EXPR EXPR++ ... += ... Addition assignment. --- 6554,6561 ---- ... &= ... Bitwise and assignment. ... * ... Multiplication. ... ** ... Exponentiation. ! *NAME Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2. ! &NAME(arg0, ...) Subroutine call. Arguments go to @_. ... + ... Addition. +EXPR Makes EXPR into scalar context. ++ Auto-increment (magical on strings). ++EXPR EXPR++ ... += ... Addition assignment. *************** *** 5010,5017 **** ... /= ... Division assignment. /PATTERN/ioxsmg Pattern match. ... < ... Numeric less than. Glob. See , <> as well. ! Reads line from filehandle NAME. NAME must be bareword/dollar-bareword. ! Glob. (Unless pattern is bareword/dollar-bareword - see ) <> Reads line from union of files in @ARGV (= command line) and STDIN. ... << ... Bitwise shift left. << start of HERE-DOCUMENT. ... <= ... Numeric less than or equal to. --- 6597,6604 ---- ... /= ... Division assignment. /PATTERN/ioxsmg Pattern match. ... < ... Numeric less than. Glob. See , <> as well. ! Reads line from filehandle NAME (a bareword or dollar-bareword). ! Glob (Unless pattern is bareword/dollar-bareword - see ). <> Reads line from union of files in @ARGV (= command line) and STDIN. ... << ... Bitwise shift left. << start of HERE-DOCUMENT. ... <= ... Numeric less than or equal to. *************** *** 5027,5049 **** ?PATTERN? One-time pattern match. @ARGV Command line arguments (not including the command name - see $0). @INC List of places to look for perl scripts during do/include/use. ! @_ Parameter array for subroutines. Also used by split unless in array context. \\ Creates reference to what follows, like \$var, or quotes non-\w in strings. \\0 Octal char, e.g. \\033. ! \\E Case modification terminator. See \\Q, \\L, and \\U. ! \\L Lowercase until \\E . See also \l, lc. ! \\U Upcase until \\E . See also \u, uc. ! \\Q Quote metacharacters until \\E . See also quotemeta. \\a Alarm character (octal 007). \\b Backspace character (octal 010). \\c Control character, e.g. \\c[ . \\e Escape character (octal 033). \\f Formfeed character (octal 014). ! \\l Lowercase the next character. See also \\L and \\u, lcfirst. \\n Newline character (octal 012 on most systems). \\r Return character (octal 015 on most systems). \\t Tab character (octal 011). ! \\u Upcase the next character. See also \\U and \\l, ucfirst. \\x Hex character, e.g. \\x1b. ... ^ ... Bitwise exclusive or. __END__ Ends program source. --- 6614,6636 ---- ?PATTERN? One-time pattern match. @ARGV Command line arguments (not including the command name - see $0). @INC List of places to look for perl scripts during do/include/use. ! @_ Parameter array for subroutines. Also used by split unless in array context. \\ Creates reference to what follows, like \$var, or quotes non-\w in strings. \\0 Octal char, e.g. \\033. ! \\E Case modification terminator. See \\Q, \\L, and \\U. ! \\L Lowercase until \\E . See also \l, lc. ! \\U Upcase until \\E . See also \u, uc. ! \\Q Quote metacharacters until \\E . See also quotemeta. \\a Alarm character (octal 007). \\b Backspace character (octal 010). \\c Control character, e.g. \\c[ . \\e Escape character (octal 033). \\f Formfeed character (octal 014). ! \\l Lowercase the next character. See also \\L and \\u, lcfirst. \\n Newline character (octal 012 on most systems). \\r Return character (octal 015 on most systems). \\t Tab character (octal 011). ! \\u Upcase the next character. See also \\U and \\l, ucfirst. \\x Hex character, e.g. \\x1b. ... ^ ... Bitwise exclusive or. __END__ Ends program source. *************** *** 5051,5057 **** __FILE__ Current (source) filename. __LINE__ Current line in current source. __PACKAGE__ Current package. ! ARGV Default multi-file input filehandle. is a synonym for <>. ARGVOUT Output filehandle with -i flag. BEGIN { ... } Immediately executed (during compilation) piece of code. END { ... } Pseudo-subroutine executed after the script finishes. --- 6638,6644 ---- __FILE__ Current (source) filename. __LINE__ Current line in current source. __PACKAGE__ Current package. ! ARGV Default multi-file input filehandle. is a synonym for <>. ARGVOUT Output filehandle with -i flag. BEGIN { ... } Immediately executed (during compilation) piece of code. END { ... } Pseudo-subroutine executed after the script finishes. *************** *** 5071,5077 **** closedir(DIRHANDLE) ... cmp ... String compare. connect(SOCKET,NAME) ! continue of { block } continue { block }. Is executed after `next' or at end. cos(EXPR) crypt(PLAINTEXT,SALT) dbmclose(%HASH) --- 6658,6664 ---- closedir(DIRHANDLE) ... cmp ... String compare. connect(SOCKET,NAME) ! continue of { block } continue { block }. Is executed after `next' or at end. cos(EXPR) crypt(PLAINTEXT,SALT) dbmclose(%HASH) *************** *** 5130,5136 **** getsockopt(SOCKET,LEVEL,OPTNAME) gmtime(EXPR) goto LABEL - grep(EXPR,LIST) ... gt ... String greater than. hex(EXPR) if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR --- 6717,6722 ---- *************** *** 5258,5264 **** ... | ... Bitwise or. ... || ... Logical or. ~ ... Unary bitwise complement. ! #! OS interpreter indicator. If contains `perl', used for options, and -x. AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'. CORE:: Prefix to access builtin function if imported sub obscures it. SUPER:: Prefix to lookup for a method in @ISA classes. --- 6844,6850 ---- ... | ... Bitwise or. ... || ... Logical or. ~ ... Unary bitwise complement. ! #! OS interpreter indicator. If contains `perl', used for options, and -x. AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'. CORE:: Prefix to access builtin function if imported sub obscures it. SUPER:: Prefix to lookup for a method in @ISA classes. *************** *** 5272,5289 **** abs [ EXPR ] absolute value ... and ... Low-precedence synonym for &&. bless REFERENCE [, PACKAGE] Makes reference into an object of a package. ! chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''! chr Converts a number to char with the same ordinal. else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. exists $HASH{KEY} True if the key exists. ! format [NAME] = Start of output format. Ended by a single dot (.) on a line. formline PICTURE, LIST Backdoor into \"format\" processing. glob EXPR Synonym of . lc [ EXPR ] Returns lowercased EXPR. lcfirst [ EXPR ] Returns EXPR with lower-cased first letter. map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST. ! no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method. not ... Low-precedence synonym for ! - negation. ... or ... Low-precedence synonym for ||. pos STRING Set/Get end-position of the last match over this string, see \\G. --- 6858,6876 ---- abs [ EXPR ] absolute value ... and ... Low-precedence synonym for &&. bless REFERENCE [, PACKAGE] Makes reference into an object of a package. ! chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''! chr Converts a number to char with the same ordinal. else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. exists $HASH{KEY} True if the key exists. ! format [NAME] = Start of output format. Ended by a single dot (.) on a line. formline PICTURE, LIST Backdoor into \"format\" processing. glob EXPR Synonym of . lc [ EXPR ] Returns lowercased EXPR. lcfirst [ EXPR ] Returns EXPR with lower-cased first letter. + grep EXPR,LIST or grep {BLOCK} LIST Filters LIST via EXPR/BLOCK. map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST. ! no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method. not ... Low-precedence synonym for ! - negation. ... or ... Low-precedence synonym for ||. pos STRING Set/Get end-position of the last match over this string, see \\G. *************** *** 5423,5428 **** --- 7010,7018 ---- (goto-char (+ 2 tmp)) (forward-sexp 1) (cperl-beautify-regexp-piece (point) m t)) + ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind + (goto-char (+ 3 tmp)) + (cperl-beautify-regexp-piece (point) m t)) (t (cperl-beautify-regexp-piece tmp m t))) (goto-char m1) *************** *** 5480,5490 **** )) (defun cperl-make-regexp-x () (save-excursion (or cperl-use-syntax-table-text-property ! (error "I need to have regex marked!")) ;; Find the start ! (re-search-backward "\\s|") ; Assume it is scanned already. ;;(forward-char 1) (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) (sub-p (eq (preceding-char) ?s)) s) --- 7070,7085 ---- )) (defun cperl-make-regexp-x () + ;; Returns position of the start (save-excursion (or cperl-use-syntax-table-text-property ! (error "I need to have a regexp marked!")) ;; Find the start ! (if (looking-at "\\s|") ! nil ; good already ! (if (looking-at "\\([smy]\\|qr\\)\\s|") ! (forward-char 1) ! (re-search-backward "\\s|"))) ; Assume it is scanned already. ;;(forward-char 1) (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) (sub-p (eq (preceding-char) ?s)) s) *************** *** 5507,5572 **** b))) (defun cperl-beautify-regexp () ! "do it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) ! (cperl-make-regexp-x) ! (re-search-backward "\\s|") ; Assume it is scanned already. ! ;;(forward-char 1) (let ((b (point)) (e (make-marker))) (forward-sexp 1) (set-marker e (1- (point))) (cperl-beautify-regexp-piece b e nil))) ! (defun cperl-contract-level () ! "Find an enclosing group in regexp and contract it. (Experimental, may change semantics, recheck the result.) Unfinished. We suppose that the regexp is scanned already." (interactive) ! (let ((bb (cperl-make-regexp-x)) done) (while (not done) (or (eq (following-char) ?\() ! (search-backward "(" (1+ bb) t) (error "Cannot find `(' which starts a group")) (setq done (save-excursion (skip-chars-backward "\\") (looking-at "\\(\\\\\\\\\\)*("))) ! (or done (forward-char -1))) ! (let ((b (point)) (e (make-marker)) s c) ! (forward-sexp 1) ! (set-marker e (1- (point))) ! (goto-char b) ! (while (re-search-forward "\\(#\\)\\|\n" e t) ! (cond ! ((match-beginning 1) ; #-comment ! (or c (setq c (current-indentation))) ! (beginning-of-line 2) ; Skip ! (setq s (point)) ! (skip-chars-forward " \t") ! (delete-region s (point)) ! (indent-to-column c)) ! (t ! (delete-char -1) ! (just-one-space))))))) (defun cperl-beautify-level () ! "Find an enclosing group in regexp and beautify it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) ! (let ((bb (cperl-make-regexp-x)) done) ! (while (not done) ! (or (eq (following-char) ?\() ! (search-backward "(" (1+ bb) t) ! (error "Cannot find `(' which starts a group")) ! (setq done ! (save-excursion ! (skip-chars-backward "\\") ! (looking-at "\\(\\\\\\\\\\)*("))) ! (or done (forward-char -1))) ! (let ((b (point)) (e (make-marker))) ! (forward-sexp 1) ! (set-marker e (1- (point))) ! (cperl-beautify-regexp-piece b e nil)))) (if (fboundp 'run-with-idle-timer) (progn --- 7102,7341 ---- b))) (defun cperl-beautify-regexp () ! "do it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) ! (goto-char (cperl-make-regexp-x)) (let ((b (point)) (e (make-marker))) (forward-sexp 1) (set-marker e (1- (point))) (cperl-beautify-regexp-piece b e nil))) ! (defun cperl-regext-to-level-start () ! "Goto start of an enclosing group in regexp. We suppose that the regexp is scanned already." (interactive) ! (let ((limit (cperl-make-regexp-x)) done) (while (not done) (or (eq (following-char) ?\() ! (search-backward "(" (1+ limit) t) (error "Cannot find `(' which starts a group")) (setq done (save-excursion (skip-chars-backward "\\") (looking-at "\\(\\\\\\\\\\)*("))) ! (or done (forward-char -1))))) ! ! (defun cperl-contract-level () ! "Find an enclosing group in regexp and contract it. Unfinished. ! \(Experimental, may change semantics, recheck the result.) ! We suppose that the regexp is scanned already." ! (interactive) ! (cperl-regext-to-level-start) ! (let ((b (point)) (e (make-marker)) s c) ! (forward-sexp 1) ! (set-marker e (1- (point))) ! (goto-char b) ! (while (re-search-forward "\\(#\\)\\|\n" e t) ! (cond ! ((match-beginning 1) ; #-comment ! (or c (setq c (current-indentation))) ! (beginning-of-line 2) ; Skip ! (setq s (point)) ! (skip-chars-forward " \t") ! (delete-region s (point)) ! (indent-to-column c)) ! (t ! (delete-char -1) ! (just-one-space)))))) ! ! (defun cperl-contract-levels () ! "Find an enclosing group in regexp and contract all the kids. Unfinished. ! \(Experimental, may change semantics, recheck the result.) ! We suppose that the regexp is scanned already." ! (interactive) ! (condition-case nil ! (cperl-regext-to-level-start) ! (error ; We are outside outermost group ! (goto-char (cperl-make-regexp-x)))) ! (let ((b (point)) (e (make-marker)) s c) ! (forward-sexp 1) ! (set-marker e (1- (point))) ! (goto-char (1+ b)) ! (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) ! (cond ! ((match-beginning 1) ; Skip ! nil) ! (t ; Group ! (cperl-contract-level)))))) (defun cperl-beautify-level () ! "Find an enclosing group in regexp and beautify it. ! \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) ! (cperl-regext-to-level-start) ! (let ((b (point)) (e (make-marker))) ! (forward-sexp 1) ! (set-marker e (1- (point))) ! (cperl-beautify-regexp-piece b e nil))) ! ! (defun cperl-invert-if-unless () ! "Changes `if (A) {B}' into `B if A;' if possible." ! (interactive) ! (or (looking-at "\\<") ! (forward-sexp -1)) ! (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\)\\>") ! (let ((pos1 (point)) ! pos2 pos3 pos4 pos5 s1 s2 state p pos45 ! (s0 (buffer-substring (match-beginning 0) (match-end 0)))) ! (forward-sexp 2) ! (setq pos3 (point)) ! (forward-sexp -1) ! (setq pos2 (point)) ! (if (eq (following-char) ?\( ) ! (progn ! (goto-char pos3) ! (forward-sexp 1) ! (setq pos5 (point)) ! (forward-sexp -1) ! (setq pos4 (point)) ! ;; XXXX In fact may be `A if (B); {C}' ... ! (if (and (eq (following-char) ?\{ ) ! (progn ! (cperl-backward-to-noncomment pos3) ! (eq (preceding-char) ?\) ))) ! (if (condition-case nil ! (progn ! (goto-char pos5) ! (forward-sexp 1) ! (forward-sexp -1) ! (looking-at "\\")) ! (error nil)) ! (error ! "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0) ! (goto-char (1- pos5)) ! (cperl-backward-to-noncomment pos4) ! (if (eq (preceding-char) ?\;) ! (forward-char -1)) ! (setq pos45 (point)) ! (goto-char pos4) ! (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t) ! (setq p (match-beginning 0) ! s1 (buffer-substring p (match-end 0)) ! state (parse-partial-sexp pos4 p)) ! (or (nth 3 state) ! (nth 4 state) ! (nth 5 state) ! (error "`%s' inside `%s' BLOCK" s1 s0)) ! (goto-char (match-end 0))) ! ;; Finally got it ! (goto-char (1+ pos4)) ! (skip-chars-forward " \t\n") ! (setq s2 (buffer-substring (point) pos45)) ! (goto-char pos45) ! (or (looking-at ";?[ \t\n]*}") ! (progn ! (skip-chars-forward "; \t\n") ! (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5)))))) ! (and (equal s2 "") ! (setq s2 "1")) ! (goto-char (1- pos3)) ! (cperl-backward-to-noncomment pos2) ! (or (looking-at "[ \t\n]*)") ! (goto-char (1- pos3))) ! (setq p (point)) ! (goto-char (1+ pos2)) ! (skip-chars-forward " \t\n") ! (setq s1 (buffer-substring (point) p)) ! (delete-region pos4 pos5) ! (delete-region pos2 pos3) ! (goto-char pos1) ! (insert s2 " ") ! (just-one-space) ! (forward-word 1) ! (setq pos1 (point)) ! (insert " " s1 ";") ! (forward-char -1) ! (delete-horizontal-space) ! (goto-char pos1) ! (just-one-space) ! (cperl-indent-line)) ! (error "`%s' (EXPR) not with an {BLOCK}" s0))) ! (error "`%s' not with an (EXPR)" s0))) ! (error "Not at `if', `unless', `while', or `unless'"))) ! ! ;;; By Anthony Foiani ! ;;; Getting help on modules in C-h f ? ! ;;; Need to teach it how to lookup functions ! (defvar Man-filter-list) ! (defun cperl-perldoc (word) ! "Run a 'perldoc' on WORD." ! (interactive ! (list (let* ((default-entry (cperl-word-at-point)) ! (input (read-string ! (format "perldoc entry%s: " ! (if (string= default-entry "") ! "" ! (format " (default %s)" default-entry)))))) ! (if (string= input "") ! (if (string= default-entry "") ! (error "No perldoc args given") ! default-entry) ! input)))) ! (let* ((is-func (and ! (string-match "^[a-z]+$" word) ! (string-match (concat "^" word "\\>") ! (documentation-property ! 'cperl-short-docs ! 'variable-documentation)))) ! (manual-program (if is-func "perldoc -f" "perldoc"))) ! (require 'man) ! (Man-getpage-in-background word))) ! ! (defun cperl-perldoc-at-point () ! "Run a 'perldoc' on WORD." ! (interactive) ! (cperl-perldoc (cperl-word-at-point))) ! ! ;;; By Nick Roberts (with changes) ! (defvar pod2man-program "pod2man") ! ! (defun cperl-pod-to-manpage () ! "Create a virtual manpage in emacs from the Perl Online Documentation" ! (interactive) ! (require 'man) ! (let* ((pod2man-args (concat buffer-file-name " | nroff -man ")) ! (bufname (concat "Man " buffer-file-name)) ! (buffer (generate-new-buffer bufname))) ! (save-excursion ! (set-buffer buffer) ! (let ((process-environment (copy-sequence process-environment))) ! ;; Prevent any attempt to use display terminal fanciness. ! (setenv "TERM" "dumb") ! (set-process-sentinel ! (start-process pod2man-program buffer "sh" "-c" ! (format (cperl-pod2man-build-command) pod2man-args)) ! 'Man-bgproc-sentinel))))) ! ! (defun cperl-pod2man-build-command () ! "Builds the entire background manpage and cleaning command." ! (let ((command (concat pod2man-program " %s 2>/dev/null")) ! (flist Man-filter-list)) ! (while (and flist (car flist)) ! (let ((pcom (car (car flist))) ! (pargs (cdr (car flist)))) ! (setq command ! (concat command " | " pcom " " ! (mapconcat '(lambda (phrase) ! (if (not (stringp phrase)) ! (error "Malformed Man-filter-list")) ! phrase) ! pargs " "))) ! (setq flist (cdr flist)))) ! command)) ! ! (defun cperl-lazy-install ()) ; Avoid a warning (if (fboundp 'run-with-idle-timer) (progn *************** *** 5605,5608 **** --- 7374,7440 ---- (setq cperl-help-shown t)))) (cperl-lazy-install))) + + ;;; Plug for wrong font-lock: + + (defun cperl-font-lock-unfontify-region-function (beg end) + (let* ((modified (buffer-modified-p)) (buffer-undo-list t) + (inhibit-read-only t) (inhibit-point-motion-hooks t) + before-change-functions after-change-functions + deactivate-mark buffer-file-name buffer-file-truename) + (remove-text-properties beg end '(face nil)) + (when (and (not modified) (buffer-modified-p)) + (set-buffer-modified-p nil)))) + + (defvar cperl-d-l nil) + (defun cperl-fontify-syntaxically (end) + (and cperl-syntaxify-unwind + (cperl-unwind-to-safe t)) + (let ((start (point)) (dbg (point))) + (or cperl-syntax-done-to + (setq cperl-syntax-done-to (point-min))) + (if (or (not (boundp 'font-lock-hot-pass)) + (eval 'font-lock-hot-pass) + t) ; Not debugged otherwise + ;; Need to forget what is after `start' + (setq start (min cperl-syntax-done-to start)) + ;; Fontification without a change + (setq start (max cperl-syntax-done-to start))) + (and (> end start) + (setq cperl-syntax-done-to start) ; In case what follows fails + (cperl-find-pods-heres start end t nil t)) + ;;(setq cperl-d-l (cons (format "Syntaxifying %s..%s from %s to %s\n" + ;; dbg end start cperl-syntax-done-to) + ;; cperl-d-l)) + ;;(let ((standard-output (get-buffer "*Messages*"))) + ;;(princ (format "Syntaxifying %s..%s from %s to %s\n" + ;; dbg end start cperl-syntax-done-to))) + (if (eq cperl-syntaxify-by-font-lock 'message) + (message "Syntaxified %s..%s from %s to %s, state at %s" + dbg end start cperl-syntax-done-to + (car cperl-syntax-state))) ; For debugging + nil)) ; Do not iterate + + (defun cperl-fontify-update (end) + (let ((pos (point)) prop posend) + (while (< pos end) + (setq prop (get-text-property pos 'cperl-postpone)) + (setq posend (next-single-property-change pos 'cperl-postpone nil end)) + (and prop (put-text-property pos posend (car prop) (cdr prop))) + (setq pos posend))) + nil) ; Do not iterate + + (defun cperl-update-syntaxification (from to) + (if (and cperl-use-syntax-table-text-property + cperl-syntaxify-by-font-lock + (or (null cperl-syntax-done-to) + (< cperl-syntax-done-to to))) + (progn + (save-excursion + (goto-char from) + (cperl-fontify-syntaxically to))))) + (provide 'cperl-mode) + + ;;; cperl-mode.el ends here + diff -c /dev/null 'perl5.004_05/emacs/e2ctags.pl' Index: ./emacs/e2ctags.pl *** ./emacs/e2ctags.pl Wed Dec 31 19:00:00 1969 --- ./emacs/e2ctags.pl Fri Feb 12 07:55:11 1999 *************** *** 0 **** --- 1,75 ---- + + ##e2ctags.pl + ##Convert an Emacs-style TAGS file to a standard ctags file. + ##Runs in a single pass over the TAGS file and keeps the first + ##tag entry found, and the file name and line number the tag can + ##be found on. + ##Then it opens all relevant files and builds the regular expression + ##for ctags. + ##Run over a few test files and compared with a real ctags file shows + ##only extra tags in the translated file, which probably won't hurt + ##vi. + ## + + use strict; + + my $filename; + my ($tag,$line_no,$line); + my %tags = (); + my %files = (); + my @lines = (); + + while (<>) { + if ($_ eq "\x0C\n") { + ##Grab next line and parse it for the filename + $_ = <>; + chomp; + s/,\d+$//; + $filename = $_; + ++$files{$filename}; + next; + } + ##Figure out how many records in this line and + ##extract the tag name and the line that it is found on + next if /struct/; + if (/\x01/) { + ($tag,$line_no) = /\x7F(\w+)\x01(\d+)/; + next unless $tag; + ##Take only the first entry per tag + next if defined($tags{$tag}); + $tags{$tag}{FILE} = $filename; + $tags{$tag}{LINE_NO} = $line_no; + } + else { + tr/(//d; + ($tag,$line_no) = /(\w+)\s*\x7F(\d+),/; + next unless $tag; + ##Take only the first entry per tag + next if defined($tags{$tag}); + $tags{$tag}{FILE} = $filename; + $tags{$tag}{LINE_NO} = $line_no; + } + } + + foreach $filename (keys %files) { + open FILE, $filename or die "Couldn't open $filename: $!\n"; + @lines = ; + close FILE; + chomp @lines; + foreach $tag ( keys %tags ) { + next unless $filename eq $tags{$tag}{FILE}; + $line = $lines[$tags{$tag}{LINE_NO}-1]; + if (length($line) >= 50) { + $line = substr($line,0,50); + } + else { + $line .= '$'; + } + $line =~ s#\\#\\\\#; + $tags{$tag}{LINE} = join '', '/^',$line,'/'; + } + } + + foreach $tag ( sort keys %tags ) { + print "$tag\t$tags{$tag}{FILE}\t$tags{$tag}{LINE}\n"; + } diff -c /dev/null 'perl5.004_05/emacs/ptags' Index: ./emacs/ptags *** ./emacs/ptags Wed Dec 31 19:00:00 1969 --- ./emacs/ptags Mon Oct 5 23:49:03 1998 *************** *** 0 **** --- 1,166 ---- + # Make a TAGS file for emacs ``M-x find-tag'' from all source files. + # (``make realclean'' first to avoid generated files, or ``make'' first + # to get tags from all files.) + # + # (IZ: to be a happier jumper: install 'imenu-go.el' from + # ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs.) + # + # (Some tags should probably live in their own subdirs, like those in x2p/, + # but I have never been interested in x2p anyway.) + # + # Hallvard B Furuseth , Aug -96. + # + # Ilya Zakharevich, Oct 97: minor comments, add CPerl scan; + # Use Hallvard's scan for XS files - since he processes the "C" part too - + # but with a lot of improvements: now it is no worse than CPerl's one. + + # Avoid builtin on OS/2: + if test ! -z "$OS2_SHELL"; then alias find=gnufind; fi + + # Insure proper order (.h after .c, .xs before .c in subdirs): + # Move autogenerated less-informative files to the end: + # Hard to do embed.h and embedvar.h in one sweep: + + topfiles="`echo ' ' *.y *.c *.h ' ' | sed 's/ \(embed\(var\|\)\.h\|obj\(pp\|XSUB\)\.h\|globals\.c\) \(\(embedvar\|objpp\).h \|\)/ /g'`" + subdirs="`find ./* -maxdepth 0 -type d`" + subdirfiles="`find $subdirs -name '*.[cy]' -print | sort`" + subdirfiles1="`find $subdirs -name '*.[hH]' -print | sort`" + xsfiles="`find . -name '*.xs' -print | sort`" + + # etags -d : process defines too (default now) + + # These are example lines for global variables and PP-code: + ## IEXT SV * Iparsehook; + ## IEXT char * Isplitstr IINIT(" "); + ## dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; + ## PP(pp_const) + ## PERLVARI(Grsfp, PerlIO *, Nullfp) + ## PERLVAR(cvcache, HV *) + + # Putting PL_\1 in the substitution line makes etags dump core + # Thus we do it later (but 20.2.92 does it OK). + set x -d -l c \ + -r '/[dI]?EXT\(CONST\)?[ \t*]+\([a-zA-Z_0-9]+[ \t*]+\)*\([a-zA-Z_0-9]+\)[ \t]*\($\|;\|\[\|[ \t]I+NIT[ \t]*(\|\/\*\)/\3/' \ + -r '/IEXT[ \t][^\/]*[ \t*]I\([a-zA-Z_][a-zA-Z_0-9]*\)[\[; \t]/\1/' \ + -r '/PERLVAR[a-zA-Z_0-9]*[ \t]*([ \t]*[GIT]?\([a-zA-Z_][a-zA-Z_0-9]*\)[ \t]*[\[,]/\1/' \ + -r '/PP[ \t]*([ \t]*\([^ \t()]*\)[ \t]*)/\1/' + + shift + + rm -f TAGS.tmp TAGS.tm2 + + # Process lines like this: #define MEM_ALIGNBYTES $alignbytes /**/ + etags -o TAGS.tmp \ + -l none -r '/#\(\$[a-zA-Z_0-9]+\|define\)[ \t]+\([a-zA-Z_0-9]+\)/\2/' \ + config_h.SH + # Process lines like this: Mcc (Loc.U): + etags -o TAGS.tmp -a \ + -l none -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\$\1/' \ + -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\1/' Porting/Glossary + + etags -o TAGS.tmp -a "$@" $topfiles + + # Now add these PL_: + perl -w014pe 'if (s/^( .* PERLVAR I? # 1: TAG group + \s* \( \s* [GIT] # + .* # + \x7F # End of description + ) + ( .* \x01 ) # 2: Exact group + /${1}PL_$2/mgx) { # Add PL_ + $chars = chomp; + s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e; + $_ .= ("\f" x $chars); + }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp + + + + etags -o TAGS.tmp -a -D -l none -r '/#define.*\t\(Perl_.*\)/\1/' embed.h + etags -o TAGS.tmp -a globals.c embedvar.h objXSUB.h objpp.h + + perl -w014pe 'if (s/^( [^\n\x7F\x01]*\b # 1: TAG group + (\w+) # 2: word + [^\w\x7F\x01\n]* # Most anything + \x7F # End of description + ) + (\d+,\d+\n) # 3: TAGS Trail + /$1$2\x01$3/mgx) { # Add specific marking + $chars = chomp; + s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e; + $_ .= ("\f" x $chars); + }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp + + # Add MODULE lines to TAG files (to be postprocessed later), + # and BOOT: lines (in DynaLoader processed twice?) + + # This skips too many XSUBs: + + # etags -o TAGS.tmp -a -d -l c \ + # -r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)\([ \t]*PREFIX[ \t]*=[ \t]*\([^ \t]+\)\)?/\2/' \ + # -r '/[ \t]*BOOT:/' \ + # $xsfiles + + etags -o TAGS.tmp -a -d -l c \ + -r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)\([ \t]*PREFIX[ \t]*=[ \t]*\([^ \t]+\)\)?/\2/' \ + -r '/[ \t]*BOOT:/' \ + -r '/\([_a-zA-Z][a-zA-Z0-9_:]*\)(/' \ + $xsfiles + + # -r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)/\2/' \ + # -r '/MODULE.*PREFIX[ \t]*=[ \t]*\([^ \t]+\)/\1/' \ + # $xsfiles + + etags -o TAGS.tmp -a "$@" $subdirfiles + etags -o TAGS.tmp -a "$@" $subdirfiles1 + + if test ! -f emacs/cperl-mode.elc ; then + ( cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el ) + fi + + # This should work with newer Emaxen + + cp TAGS.tmp TAGS + if emacs -batch -q -no-site-file -l emacs/cperl-mode.elc -f cperl-add-tags-recurse-noxs ; then + mv TAGS TAGS.tmp + fi + + perl -w014pe ' + $update = s/^PP\(\177\d+,\d+\n//gm; + $update += s/^(I?EXT.*[ \t])IINIT[ \t]*\((\177)/$1$2/gm; + if (/^\n*[^\s,]+\.xs,/s) { + $mod = $cmod = $bmod = $pref = ""; + s/^(.*\n)\1+/$1/mg; # Remove duplicate lines + $_ = join("", map { + if (/^MODULE[ \t]*=[ \t]*(\S+)(?:[ \t]+PACKAGE[ \t]*=[ \t]*(\S+))?[ \t\177]/m) { + $mod = $+; + ($bmod = $mod) =~ tr/:/_/; + $cmod = "XS_${bmod}_"; + $pref = ""; + if (s/[ \t]+PREFIX[ \t]*=[ \t]*([^\s\177]+)(\177)/$+/) { + $pref = $1; + $pref =~ s/([^\w\s])/\\$1/g; + $pref = "(?:$pref)?"; + } + } elsif ($mod ne "") { + # Ref points for Module::subr, XS_Module_subr, subr + s/^($pref(\w+)[ \t()]*\177)(\d+,\d+)$/$1${mod}::${2}\01$3\n$1$2\01$3\n$1$cmod$2\01$3/gm; + # Ref for Module::bootstrap bootstrap boot_Module + s/^([ \t]*BOOT:\177)(\d+,\d+)$/$1${mod}::bootstrap\01$2\n${1}bootstrap\01$2\n${1}boot_$bmod\01$2/gm; + } + $_; + } split(/(\nMODULE[ \t]*=[^\n\177]+\177)/)); + + $update = 1; + } + if ($update) { + $chars = chomp; + s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e; + $_ .= ("\f" x $chars); + }' TAGS.tmp > TAGS.tm2 + + rm -f TAGS + mv TAGS.tm2 TAGS + rm -f TAGS.tmp + + + diff -c 'perl5.004_04/embed.h' 'perl5.004_05/embed.h' Index: ./embed.h *** ./embed.h Tue Oct 14 09:07:53 1997 --- ./embed.h Tue Apr 13 00:41:01 1999 *************** *** 146,151 **** --- 146,152 ---- #define div_amg Perl_div_amg #define div_ass_amg Perl_div_ass_amg #define do_aexec Perl_do_aexec + #define do_binmode Perl_do_binmode #define do_chomp Perl_do_chomp #define do_chop Perl_do_chop #define do_close Perl_do_close *************** *** 203,208 **** --- 204,210 ---- #define filter_add Perl_filter_add #define filter_del Perl_filter_del #define filter_read Perl_filter_read + #define find_script Perl_find_script #define fold Perl_fold #define fold_constants Perl_fold_constants #define fold_locale Perl_fold_locale *************** *** 313,328 **** #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack - #define magic_freedefelem Perl_magic_freedefelem #define magic_get Perl_magic_get #define magic_getarylen Perl_magic_getarylen #define magic_getdefelem Perl_magic_getdefelem #define magic_getglob Perl_magic_getglob #define magic_getpack Perl_magic_getpack #define magic_getpos Perl_magic_getpos #define magic_getsig Perl_magic_getsig #define magic_gettaint Perl_magic_gettaint #define magic_getuvar Perl_magic_getuvar #define magic_len Perl_magic_len #define magic_nextpack Perl_magic_nextpack #define magic_set Perl_magic_set --- 315,332 ---- #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack #define magic_get Perl_magic_get #define magic_getarylen Perl_magic_getarylen #define magic_getdefelem Perl_magic_getdefelem #define magic_getglob Perl_magic_getglob + #define magic_getnkeys Perl_magic_getnkeys #define magic_getpack Perl_magic_getpack #define magic_getpos Perl_magic_getpos #define magic_getsig Perl_magic_getsig + #define magic_getsubstr Perl_magic_getsubstr #define magic_gettaint Perl_magic_gettaint #define magic_getuvar Perl_magic_getuvar + #define magic_getvec Perl_magic_getvec #define magic_len Perl_magic_len #define magic_nextpack Perl_magic_nextpack #define magic_set Perl_magic_set *************** *** 406,411 **** --- 410,416 ---- #define newAVREF Perl_newAVREF #define newBINOP Perl_newBINOP #define newCONDOP Perl_newCONDOP + #define newCONSTSUB Perl_newCONSTSUB #define newCVREF Perl_newCVREF #define newFORM Perl_newFORM #define newFOROP Perl_newFOROP *************** *** 436,441 **** --- 441,447 ---- #define newSVnv Perl_newSVnv #define newSVpv Perl_newSVpv #define newSVpvf Perl_newSVpvf + #define newSVpvn Perl_newSVpvn #define newSVrv Perl_newSVrv #define newSVsv Perl_newSVsv #define newUNOP Perl_newUNOP *************** *** 473,478 **** --- 479,485 ---- #define oopsCV Perl_oopsCV #define oopsHV Perl_oopsHV #define op Perl_op + #define op_const_sv Perl_op_const_sv #define op_desc Perl_op_desc #define op_free Perl_op_free #define op_name Perl_op_name *************** *** 912,917 **** --- 919,925 ---- #define same_dirent Perl_same_dirent #define save_I16 Perl_save_I16 #define save_I32 Perl_save_I32 + #define save_aelem Perl_save_aelem #define save_aptr Perl_save_aptr #define save_ary Perl_save_ary #define save_clearsv Perl_save_clearsv *************** *** 922,927 **** --- 930,936 ---- #define save_freesv Perl_save_freesv #define save_gp Perl_save_gp #define save_hash Perl_save_hash + #define save_helem Perl_save_helem #define save_hptr Perl_save_hptr #define save_int Perl_save_int #define save_item Perl_save_item *************** *** 1008,1016 **** --- 1017,1029 ---- #define sv_backoff Perl_sv_backoff #define sv_bless Perl_sv_bless #define sv_catpv Perl_sv_catpv + #define sv_catpv_mg Perl_sv_catpv_mg #define sv_catpvf Perl_sv_catpvf + #define sv_catpvf_mg Perl_sv_catpvf_mg #define sv_catpvn Perl_sv_catpvn + #define sv_catpvn_mg Perl_sv_catpvn_mg #define sv_catsv Perl_sv_catsv + #define sv_catsv_mg Perl_sv_catsv_mg #define sv_chop Perl_sv_chop #define sv_clean_all Perl_sv_clean_all #define sv_clean_objs Perl_sv_clean_objs *************** *** 1044,1061 **** --- 1057,1082 ---- #define sv_report_used Perl_sv_report_used #define sv_reset Perl_sv_reset #define sv_setiv Perl_sv_setiv + #define sv_setiv_mg Perl_sv_setiv_mg #define sv_setnv Perl_sv_setnv + #define sv_setnv_mg Perl_sv_setnv_mg #define sv_setptrobj Perl_sv_setptrobj #define sv_setpv Perl_sv_setpv + #define sv_setpv_mg Perl_sv_setpv_mg #define sv_setpvf Perl_sv_setpvf + #define sv_setpvf_mg Perl_sv_setpvf_mg #define sv_setpviv Perl_sv_setpviv + #define sv_setpviv_mg Perl_sv_setpviv_mg #define sv_setpvn Perl_sv_setpvn + #define sv_setpvn_mg Perl_sv_setpvn_mg #define sv_setref_iv Perl_sv_setref_iv #define sv_setref_nv Perl_sv_setref_nv #define sv_setref_pv Perl_sv_setref_pv #define sv_setref_pvn Perl_sv_setref_pvn #define sv_setsv Perl_sv_setsv + #define sv_setsv_mg Perl_sv_setsv_mg #define sv_setuv Perl_sv_setuv + #define sv_setuv_mg Perl_sv_setuv_mg #define sv_taint Perl_sv_taint #define sv_tainted Perl_sv_tainted #define sv_undef Perl_sv_undef *************** *** 1064,1069 **** --- 1085,1091 ---- #define sv_untaint Perl_sv_untaint #define sv_upgrade Perl_sv_upgrade #define sv_usepvn Perl_sv_usepvn + #define sv_usepvn_mg Perl_sv_usepvn_mg #define sv_vcatpvfn Perl_sv_vcatpvfn #define sv_vsetpvfn Perl_sv_vsetpvfn #define sv_yes Perl_sv_yes *************** *** 1232,1239 **** #define doswitches (curinterp->Idoswitches) #define dowarn (curinterp->Idowarn) #define dumplvl (curinterp->Idumplvl) ! #define e_fp (curinterp->Ie_fp) ! #define e_tmpname (curinterp->Ie_tmpname) #define endav (curinterp->Iendav) #define envgv (curinterp->Ienvgv) #define errgv (curinterp->Ierrgv) --- 1254,1260 ---- #define doswitches (curinterp->Idoswitches) #define dowarn (curinterp->Idowarn) #define dumplvl (curinterp->Idumplvl) ! #define e_script (curinterp->Ie_script) #define endav (curinterp->Iendav) #define envgv (curinterp->Ienvgv) #define errgv (curinterp->Ierrgv) *************** *** 1328,1333 **** --- 1349,1355 ---- #define sv_count (curinterp->Isv_count) #define sv_objcount (curinterp->Isv_objcount) #define sv_root (curinterp->Isv_root) + #define sys_intern (curinterp->Isys_intern) #define tainted (curinterp->Itainted) #define tainting (curinterp->Itainting) #define tmps_floor (curinterp->Itmps_floor) *************** *** 1386,1393 **** #define Idoswitches doswitches #define Idowarn dowarn #define Idumplvl dumplvl ! #define Ie_fp e_fp ! #define Ie_tmpname e_tmpname #define Iendav endav #define Ienvgv envgv #define Ierrgv errgv --- 1408,1414 ---- #define Idoswitches doswitches #define Idowarn dowarn #define Idumplvl dumplvl ! #define Ie_script e_script #define Iendav endav #define Ienvgv envgv #define Ierrgv errgv *************** *** 1482,1487 **** --- 1503,1509 ---- #define Isv_count sv_count #define Isv_objcount sv_objcount #define Isv_root sv_root + #define Isys_intern sys_intern #define Itainted tainted #define Itainting tainting #define Itmps_floor tmps_floor *************** *** 1550,1557 **** #define doswitches Perl_doswitches #define dowarn Perl_dowarn #define dumplvl Perl_dumplvl ! #define e_fp Perl_e_fp ! #define e_tmpname Perl_e_tmpname #define endav Perl_endav #define errgv Perl_errgv #define eval_root Perl_eval_root --- 1572,1578 ---- #define doswitches Perl_doswitches #define dowarn Perl_dowarn #define dumplvl Perl_dumplvl ! #define e_script Perl_e_script #define endav Perl_endav #define errgv Perl_errgv #define eval_root Perl_eval_root *************** *** 1644,1649 **** --- 1665,1671 ---- #define sv_count Perl_sv_count #define sv_objcount Perl_sv_objcount #define sv_root Perl_sv_root + #define sys_intern Perl_sys_intern #define tainted Perl_tainted #define tmps_floor Perl_tmps_floor #define tmps_ix Perl_tmps_ix *************** *** 1659,1661 **** --- 1681,1711 ---- #endif /* EMBED */ #endif /* MULTIPLICITY */ + + /* perl5.005 names for common perl globals */ + #define PL_DBsingle DBsingle + #define PL_DBsub DBsub + #define PL_compiling compiling + #define PL_curcop curcop + #define PL_curstash curstash + #define PL_debstash debstash + #define PL_defgv defgv + #define PL_diehook diehook + #define PL_dirty dirty + #define PL_dowarn dowarn + #define PL_errgv errgv + #define PL_na na + #define PL_no_modify no_modify + #define PL_perl_destruct_level perl_destruct_level + #define PL_perldb perldb + #define PL_rsfp rsfp + #define PL_rsfp_filters rsfp_filters + #define PL_stack_base stack_base + #define PL_stack_sp stack_sp + #define PL_stdingv stdingv + #define PL_sv_arenaroot sv_arenaroot + #define PL_sv_no sv_no + #define PL_sv_undef sv_undef + #define PL_sv_yes sv_yes + #define PL_tainted tainted + #define PL_tainting tainting diff -c 'perl5.004_04/embed.pl' 'perl5.004_05/embed.pl' Index: ./embed.pl *** ./embed.pl Sat Dec 14 22:32:46 1996 --- ./embed.pl Tue Apr 13 00:28:38 1999 *************** *** 2,7 **** --- 2,24 ---- require 5.003; + my @vars5005 = qw(sv_undef sv_yes sv_no na dowarn + curcop compiling + tainting tainted stack_base stack_sp sv_arenaroot + no_modify + curstash DBsub DBsingle debstash + rsfp + stdingv + defgv + errgv + rsfp_filters + perldb + diehook + dirty + perl_destruct_level + ); + + sub readsyms (\%$) { my ($syms, $file) = @_; %$syms = (); *************** *** 140,144 **** --- 157,168 ---- #endif /* EMBED */ #endif /* MULTIPLICITY */ + + /* perl5.005 names for common perl globals */ END + for $sym (sort @vars5005) { + print EM hide("PL_$sym",$sym); + } + + close(EM); diff -c 'perl5.004_04/ext/DB_File/DB_File.xs' 'perl5.004_05/ext/DB_File/DB_File.xs' Index: ./ext/DB_File/DB_File.xs *** ./ext/DB_File/DB_File.xs Thu Jul 31 15:53:33 1997 --- ./ext/DB_File/DB_File.xs Wed Apr 22 07:49:24 1998 *************** *** 160,167 **** ENTER ; SAVETMPS; ! PUSHMARK(sp) ; ! EXTEND(sp,2) ; PUSHs(sv_2mortal(newSVpv(data1,key1->size))); PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; --- 160,167 ---- ENTER ; SAVETMPS; ! PUSHMARK(SP) ; ! EXTEND(SP,2) ; PUSHs(sv_2mortal(newSVpv(data1,key1->size))); PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; *************** *** 207,214 **** ENTER ; SAVETMPS; ! PUSHMARK(sp) ; ! EXTEND(sp,2) ; PUSHs(sv_2mortal(newSVpv(data1,key1->size))); PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; --- 207,214 ---- ENTER ; SAVETMPS; ! PUSHMARK(SP) ; ! EXTEND(SP,2) ; PUSHs(sv_2mortal(newSVpv(data1,key1->size))); PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; *************** *** 245,251 **** ENTER ; SAVETMPS; ! PUSHMARK(sp) ; XPUSHs(sv_2mortal(newSVpv((char*)data,size))); PUTBACK ; --- 245,251 ---- ENTER ; SAVETMPS; ! PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSVpv((char*)data,size))); PUTBACK ; diff -c /dev/null 'perl5.004_05/ext/DynaLoader/DynaLoader_pm.PL' Index: ./ext/DynaLoader/DynaLoader_pm.PL *** ./ext/DynaLoader/DynaLoader_pm.PL Wed Dec 31 19:00:00 1969 --- ./ext/DynaLoader/DynaLoader_pm.PL Sun Nov 22 10:08:38 1998 *************** *** 0 **** --- 1,730 ---- + + use Config; + + sub to_string { + my ($value) = @_; + $value =~ s/\\/\\\\'/g; + $value =~ s/'/\\'/g; + return "'$value'"; + } + + unlink "DynaLoader.pm" if -f "DynaLoader.pm"; + open OUT, ">DynaLoader.pm" or die $!; + print OUT <<'EOT'; + + # Generated from DynaLoader.pm.PL (resolved %Config::Config values) + + package DynaLoader; + + # And Gandalf said: 'Many folk like to know beforehand what is to + # be set on the table; but those who have laboured to prepare the + # feast like to keep their secret; for wonder makes the words of + # praise louder.' + + # (Quote from Tolkien sugested by Anno Siegel.) + # + # See pod text at end of file for documentation. + # See also ext/DynaLoader/README in source tree for other information. + # + # Tim.Bunce@ig.co.uk, August 1994 + + $VERSION = $VERSION = "1.03"; # avoid typo warning + + require AutoLoader; + *AUTOLOAD = \&AutoLoader::AUTOLOAD; + + # The following require can't be removed during maintenance + # releases, sadly, because of the risk of buggy code that does + # require Carp; Carp::croak "..."; without brackets dying + # if Carp hasn't been loaded in earlier compile time. :-( + # We'll let those bugs get found on the development track. + require Carp if $] < 5.00450; + + + # enable debug/trace messages from DynaLoader perl code + $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; + + # + # Flags to alter dl_load_file behaviour. Assigned bits: + # 0x01 make symbols available for linking later dl_load_file's. + # (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL)) + # (ignored under VMS; effect is built-in to image linking) + # + # This is called as a class method $module->dl_load_flags. The + # definition here will be inherited and result on "default" loading + # behaviour unless a sub-class of DynaLoader defines its own version. + # + + sub dl_load_flags { 0x00 } + + # ($dl_dlext, $dlsrc) + # = @Config::Config{'dlext', 'dlsrc'}; + EOT + + print OUT " (\$dl_dlext, \$dlsrc) = (", + to_string($Config::Config{'dlext'}), ",", + to_string($Config::Config{'dlsrc'}), ")\n;" ; + + print OUT <<'EOT'; + + # Some systems need special handling to expand file specifications + # (VMS support by Charles Bailey ) + # See dl_expandspec() for more details. Should be harmless but + # inefficient to define on systems that don't need it. + $do_expand = $Is_VMS = $^O eq 'VMS'; + + @dl_require_symbols = (); # names of symbols we need + @dl_resolve_using = (); # names of files to link with + @dl_library_path = (); # path to look for files + @dl_librefs = (); # things we have loaded + @dl_modules = (); # Modules we have loaded + + # This is a fix to support DLD's unfortunate desire to relink -lc + @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs"; + + # Initialise @dl_library_path with the 'standard' library path + # for this platform as determined by Configure + + # push(@dl_library_path, split(' ', $Config::Config{'libpth'}); + EOT + + print OUT "push(\@dl_library_path, split(' ', ", + to_string($Config::Config{'libpth'}), "));\n"; + + print OUT <<'EOT'; + + # Add to @dl_library_path any extra directories we can gather from + # environment variables. So far LD_LIBRARY_PATH is the only known + # variable used for this purpose. Others may be added later. + push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH})) + if $ENV{LD_LIBRARY_PATH}; + + + # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. + boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && + !defined(&dl_load_file); + + + if ($dl_debug) { + print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n"; + print STDERR "DynaLoader not linked into this perl\n" + unless defined(&boot_DynaLoader); + } + + 1; # End of main code + + + sub croak { require Carp; Carp::croak(@_) } + + # The bootstrap function cannot be autoloaded (without complications) + # so we define it here: + + sub bootstrap { + # use local vars to enable $module.bs script to edit values + local(@args) = @_; + local($module) = $args[0]; + local(@dirs, $file); + + unless ($module) { + require Carp; + Carp::confess("Usage: DynaLoader::bootstrap(module)"); + } + + # A common error on platforms which don't support dynamic loading. + # Since it's fatal and potentially confusing we give a detailed message. + croak("Can't load module $module, dynamic loading not available in this perl.\n". + " (You may need to build a new perl executable which either supports\n". + " dynamic loading or has the $module module statically linked into it.)\n") + unless defined(&dl_load_file); + + my @modparts = split(/::/,$module); + my $modfname = $modparts[-1]; + + # Some systems have restrictions on files names for DLL's etc. + # mod2fname returns appropriate file base name (typically truncated) + # It may also edit @modparts if required. + $modfname = &mod2fname(\@modparts) if defined &mod2fname; + + my $modpname = join('/',@modparts); + + print STDERR "DynaLoader::bootstrap for $module ", + "(auto/$modpname/$modfname.$dl_dlext)\n" if $dl_debug; + + foreach (@INC) { + chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS; + my $dir = "$_/auto/$modpname"; + next unless -d $dir; # skip over uninteresting directories + + # check for common cases to avoid autoload of dl_findfile + my $try = "$dir/$modfname.$dl_dlext"; + last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try); + + # no luck here, save dir for possible later dl_findfile search + push @dirs, $dir; + } + # last resort, let dl_findfile have a go in all known locations + $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file; + + croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)") + unless $file; # wording similar to error from 'require' + + my $bootname = "boot_$module"; + $bootname =~ s/\W/_/g; + @dl_require_symbols = ($bootname); + + # Execute optional '.bootstrap' perl script for this module. + # The .bs file can be used to configure @dl_resolve_using etc to + # match the needs of the individual module on this architecture. + my $bs = $file; + $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library + if (-s $bs) { # only read file if it's not empty + print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug; + eval { do $bs; }; + warn "$bs: $@\n" if $@; + } + + # Many dynamic extension loading problems will appear to come from + # this section of code: XYZ failed at line 123 of DynaLoader.pm. + # Often these errors are actually occurring in the initialisation + # C code of the extension XS file. Perl reports the error as being + # in this perl code simply because this was the last perl code + # it executed. + + my $libref = dl_load_file($file, $module->dl_load_flags) or + croak("Can't load '$file' for module $module: ".dl_error()."\n"); + + push(@dl_librefs,$libref); # record loaded object + + my @unresolved = dl_undef_symbols(); + if (@unresolved) { + require Carp; + Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); + } + + my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or + croak("Can't find '$bootname' symbol in $file\n"); + + my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + + push(@dl_modules, $module); # record loaded module + + # See comment block above + &$xs(@args); + } + + + #sub _check_file { # private utility to handle dl_expandspec vs -f tests + # my($file) = @_; + # return $file if (!$do_expand && -f $file); # the common case + # return $file if ( $do_expand && ($file=dl_expandspec($file))); + # return undef; + #} + + + # Let autosplit and the autoloader deal with these functions: + __END__ + + + sub dl_findfile { + # Read ext/DynaLoader/DynaLoader.doc for detailed information. + # This function does not automatically consider the architecture + # or the perl library auto directories. + my (@args) = @_; + my (@dirs, $dir); # which directories to search + my (@found); # full paths to real files we have found + EOT + + print OUT ' my $dl_ext= ' . to_string($Config::Config{'dlext'}) . + "; # \$Config::Config{'dlext'} suffix for perl extensions\n"; + print OUT ' my $dl_so = ' . to_string($Config::Config{'so'}) . + "; # \$Config::Config{'so'} suffix for shared libraries\n"; + + print OUT <<'EOT'; + + print STDERR "dl_findfile(@args)\n" if $dl_debug; + + # accumulate directories but process files as they appear + arg: foreach(@args) { + # Special fast case: full filepath requires no search + if ($Is_VMS && m%[:>/\]]% && -f $_) { + push(@found,dl_expandspec(VMS::Filespec::vmsify($_))); + last arg unless wantarray; + next; + } + elsif (m:/: && -f $_ && !$do_expand) { + push(@found,$_); + last arg unless wantarray; + next; + } + + # Deal with directories first: + # Using a -L prefix is the preferred option (faster and more robust) + if (m:^-L:) { s/^-L//; push(@dirs, $_); next; } + + # Otherwise we try to try to spot directories by a heuristic + # (this is a more complicated issue than it first appears) + if (m:/: && -d $_) { push(@dirs, $_); next; } + + # VMS: we may be using native VMS directry syntax instead of + # Unix emulation, so check this as well + if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; } + + # Only files should get this far... + my(@names, $name); # what filenames to look for + if (m:-l: ) { # convert -lname to appropriate library name + s/-l//; + push(@names,"lib$_.$dl_so"); + push(@names,"lib$_.a"); + } else { # Umm, a bare name. Try various alternatives: + # these should be ordered with the most likely first + push(@names,"$_.$dl_ext") unless m/\.$dl_ext$/o; + push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; + push(@names,"lib$_.$dl_so") unless m:/:; + push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs"; + push(@names, $_); + } + foreach $dir (@dirs, @dl_library_path) { + next unless -d $dir; + chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS; + foreach $name (@names) { + my($file) = "$dir/$name"; + print STDERR " checking in $dir for $name\n" if $dl_debug; + $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file); + #$file = _check_file($file); + if ($file) { + push(@found, $file); + next arg; # no need to look any further + } + } + } + } + if ($dl_debug) { + foreach(@dirs) { + print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_; + } + print STDERR "dl_findfile found: @found\n"; + } + return $found[0] unless wantarray; + @found; + } + + + sub dl_expandspec { + my($spec) = @_; + # Optional function invoked if DynaLoader.pm sets $do_expand. + # Most systems do not require or use this function. + # Some systems may implement it in the dl_*.xs file in which case + # this autoload version will not be called but is harmless. + + # This function is designed to deal with systems which treat some + # 'filenames' in a special way. For example VMS 'Logical Names' + # (something like unix environment variables - but different). + # This function should recognise such names and expand them into + # full file paths. + # Must return undef if $spec is invalid or file does not exist. + + my $file = $spec; # default output to input + + if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs + require Carp; + Carp::croak("dl_expandspec: should be defined in XS file!\n"); + } else { + return undef unless -f $file; + } + print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; + $file; + } + + sub dl_find_symbol_anywhere + { + my $sym = shift; + my $libref; + foreach $libref (@dl_librefs) { + my $symref = dl_find_symbol($libref,$sym); + return $symref if $symref; + } + return undef; + } + + =head1 NAME + + DynaLoader - Dynamically load C libraries into Perl code + + dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules + + =head1 SYNOPSIS + + package YourPackage; + require DynaLoader; + @ISA = qw(... DynaLoader ...); + bootstrap YourPackage; + + # optional method for 'global' loading + sub dl_load_flags { 0x01 } + + + =head1 DESCRIPTION + + This document defines a standard generic interface to the dynamic + linking mechanisms available on many platforms. Its primary purpose is + to implement automatic dynamic loading of Perl modules. + + This document serves as both a specification for anyone wishing to + implement the DynaLoader for a new platform and as a guide for + anyone wishing to use the DynaLoader directly in an application. + + The DynaLoader is designed to be a very simple high-level + interface that is sufficiently general to cover the requirements + of SunOS, HP-UX, NeXT, Linux, VMS and other platforms. + + It is also hoped that the interface will cover the needs of OS/2, NT + etc and also allow pseudo-dynamic linking (using C at runtime). + + It must be stressed that the DynaLoader, by itself, is practically + useless for accessing non-Perl libraries because it provides almost no + Perl-to-C 'glue'. There is, for example, no mechanism for calling a C + library function or supplying arguments. A C::DynaLib module + is available from CPAN sites which performs that function for some + common system types. + + DynaLoader Interface Summary + + @dl_library_path + @dl_resolve_using + @dl_require_symbols + $dl_debug + @dl_librefs + @dl_modules + Implemented in: + bootstrap($modulename) Perl + @filepaths = dl_findfile(@names) Perl + $flags = $modulename->dl_load_flags Perl + $symref = dl_find_symbol_anywhere($symbol) Perl + + $libref = dl_load_file($filename, $flags) C + $symref = dl_find_symbol($libref, $symbol) C + @symbols = dl_undef_symbols() C + dl_install_xsub($name, $symref [, $filename]) C + $message = dl_error C + + =over 4 + + =item @dl_library_path + + The standard/default list of directories in which dl_findfile() will + search for libraries etc. Directories are searched in order: + $dl_library_path[0], [1], ... etc + + @dl_library_path is initialised to hold the list of 'normal' directories + (F, etc) determined by B (C<$Config{'libpth'}>). This should + ensure portability across a wide range of platforms. + + @dl_library_path should also be initialised with any other directories + that can be determined from the environment at runtime (such as + LD_LIBRARY_PATH for SunOS). + + After initialisation @dl_library_path can be manipulated by an + application using push and unshift before calling dl_findfile(). + Unshift can be used to add directories to the front of the search order + either to save search time or to override libraries with the same name + in the 'normal' directories. + + The load function that dl_load_file() calls may require an absolute + pathname. The dl_findfile() function and @dl_library_path can be + used to search for and return the absolute pathname for the + library/object that you wish to load. + + =item @dl_resolve_using + + A list of additional libraries or other shared objects which can be + used to resolve any undefined symbols that might be generated by a + later call to load_file(). + + This is only required on some platforms which do not handle dependent + libraries automatically. For example the Socket Perl extension + library (F) contains references to many socket + functions which need to be resolved when it's loaded. Most platforms + will automatically know where to find the 'dependent' library (e.g., + F). A few platforms need to be told the + location of the dependent library explicitly. Use @dl_resolve_using + for this. + + Example usage: + + @dl_resolve_using = dl_findfile('-lsocket'); + + =item @dl_require_symbols + + A list of one or more symbol names that are in the library/object file + to be dynamically loaded. This is only required on some platforms. + + =item @dl_librefs + + An array of the handles returned by successful calls to dl_load_file(), + made by bootstrap, in the order in which they were loaded. + Can be used with dl_find_symbol() to look for a symbol in any of + the loaded files. + + =item @dl_modules + + An array of module (package) names that have been bootstrap'ed. + + =item dl_error() + + Syntax: + + $message = dl_error(); + + Error message text from the last failed DynaLoader function. Note + that, similar to errno in unix, a successful function call does not + reset this message. + + Implementations should detect the error as soon as it occurs in any of + the other functions and save the corresponding message for later + retrieval. This will avoid problems on some platforms (such as SunOS) + where the error message is very temporary (e.g., dlerror()). + + =item $dl_debug + + Internal debugging messages are enabled when $dl_debug is set true. + Currently setting $dl_debug only affects the Perl side of the + DynaLoader. These messages should help an application developer to + resolve any DynaLoader usage problems. + + $dl_debug is set to C<$ENV{'PERL_DL_DEBUG'}> if defined. + + For the DynaLoader developer/porter there is a similar debugging + variable added to the C code (see dlutils.c) and enabled if Perl was + built with the B<-DDEBUGGING> flag. This can also be set via the + PERL_DL_DEBUG environment variable. Set to 1 for minimal information or + higher for more. + + =item dl_findfile() + + Syntax: + + @filepaths = dl_findfile(@names) + + Determine the full paths (including file suffix) of one or more + loadable files given their generic names and optionally one or more + directories. Searches directories in @dl_library_path by default and + returns an empty list if no files were found. + + Names can be specified in a variety of platform independent forms. Any + names in the form B<-lname> are converted into F, where F<.*> is + an appropriate suffix for the platform. + + If a name does not already have a suitable prefix and/or suffix then + the corresponding file will be searched for by trying combinations of + prefix and suffix appropriate to the platform: "$name.o", "lib$name.*" + and "$name". + + If any directories are included in @names they are searched before + @dl_library_path. Directories may be specified as B<-Ldir>. Any other + names are treated as filenames to be searched for. + + Using arguments of the form C<-Ldir> and C<-lname> is recommended. + + Example: + + @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix)); + + + =item dl_expandspec() + + Syntax: + + $filepath = dl_expandspec($spec) + + Some unusual systems, such as VMS, require special filename handling in + order to deal with symbolic names for files (i.e., VMS's Logical Names). + + To support these systems a dl_expandspec() function can be implemented + either in the F file or code can be added to the autoloadable + dl_expandspec() function in F. See F for + more information. + + =item dl_load_file() + + Syntax: + + $libref = dl_load_file($filename, $flags) + + Dynamically load $filename, which must be the path to a shared object + or library. An opaque 'library reference' is returned as a handle for + the loaded object. Returns undef on error. + + The $flags argument to alters dl_load_file behaviour. + Assigned bits: + + 0x01 make symbols available for linking later dl_load_file's. + (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL)) + (ignored under VMS; this is a normal part of image linking) + + (On systems that provide a handle for the loaded object such as SunOS + and HPUX, $libref will be that handle. On other systems $libref will + typically be $filename or a pointer to a buffer containing $filename. + The application should not examine or alter $libref in any way.) + + This is the function that does the real work. It should use the + current values of @dl_require_symbols and @dl_resolve_using if required. + + SunOS: dlopen($filename) + HP-UX: shl_load($filename) + Linux: dld_create_reference(@dl_require_symbols); dld_link($filename) + NeXT: rld_load($filename, @dl_resolve_using) + VMS: lib$find_image_symbol($filename,$dl_require_symbols[0]) + + (The dlopen() function is also used by Solaris and some versions of + Linux, and is a common choice when providing a "wrapper" on other + mechanisms as is done in the OS/2 port.) + + =item dl_loadflags() + + Syntax: + + $flags = dl_loadflags $modulename; + + Designed to be a method call, and to be overridden by a derived class + (i.e. a class which has DynaLoader in its @ISA). The definition in + DynaLoader itself returns 0, which produces standard behavior from + dl_load_file(). + + =item dl_find_symbol() + + Syntax: + + $symref = dl_find_symbol($libref, $symbol) + + Return the address of the symbol $symbol or C if not found. If the + target system has separate functions to search for symbols of different + types then dl_find_symbol() should search for function symbols first and + then other types. + + The exact manner in which the address is returned in $symref is not + currently defined. The only initial requirement is that $symref can + be passed to, and understood by, dl_install_xsub(). + + SunOS: dlsym($libref, $symbol) + HP-UX: shl_findsym($libref, $symbol) + Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol) + NeXT: rld_lookup("_$symbol") + VMS: lib$find_image_symbol($libref,$symbol) + + + =item dl_find_symbol_anywhere() + + Syntax: + + $symref = dl_find_symbol_anywhere($symbol) + + Applies dl_find_symbol() to the members of @dl_librefs and returns + the first match found. + + =item dl_undef_symbols() + + Example + + @symbols = dl_undef_symbols() + + Return a list of symbol names which remain undefined after load_file(). + Returns C<()> if not known. Don't worry if your platform does not provide + a mechanism for this. Most do not need it and hence do not provide it, + they just return an empty list. + + + =item dl_install_xsub() + + Syntax: + + dl_install_xsub($perl_name, $symref [, $filename]) + + Create a new Perl external subroutine named $perl_name using $symref as + a pointer to the function which implements the routine. This is simply + a direct call to newXSUB(). Returns a reference to the installed + function. + + The $filename parameter is used by Perl to identify the source file for + the function if required by die(), caller() or the debugger. If + $filename is not defined then "DynaLoader" will be used. + + + =item bootstrap() + + Syntax: + + bootstrap($module) + + This is the normal entry point for automatic dynamic loading in Perl. + + It performs the following actions: + + =over 8 + + =item * + + locates an auto/$module directory by searching @INC + + =item * + + uses dl_findfile() to determine the filename to load + + =item * + + sets @dl_require_symbols to C<("boot_$module")> + + =item * + + executes an F file if it exists + (typically used to add to @dl_resolve_using any files which + are required to load the module on the current platform) + + =item * + + calls dl_load_flags() to determine how to load the file. + + =item * + + calls dl_load_file() to load the file + + =item * + + calls dl_undef_symbols() and warns if any symbols are undefined + + =item * + + calls dl_find_symbol() for "boot_$module" + + =item * + + calls dl_install_xsub() to install it as "${module}::bootstrap" + + =item * + + calls &{"${module}::bootstrap"} to bootstrap the module (actually + it uses the function reference returned by dl_install_xsub for speed) + + =back + + =back + + + =head1 AUTHOR + + Tim Bunce, 11 August 1994. + + This interface is based on the work and comments of (in no particular + order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno + Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others. + + Larry Wall designed the elegant inherited bootstrap mechanism and + implemented the first Perl 5 dynamic loader using it. + + Solaris global loading added by Nick Ing-Simmons with design/coding + assistance from Tim Bunce, January 1996. + + =cut + EOT + + close OUT or die $!; + diff -c 'perl5.004_04/ext/DynaLoader/Makefile.PL' 'perl5.004_05/ext/DynaLoader/Makefile.PL' Index: ./ext/DynaLoader/Makefile.PL *** ./ext/DynaLoader/Makefile.PL Mon Aug 19 13:13:17 1996 --- ./ext/DynaLoader/Makefile.PL Sat Jul 11 11:53:37 1998 *************** *** 7,16 **** MAN3PODS => ' ', # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? ! VERSION_FROM => 'DynaLoader.pm', ! clean => {FILES => 'DynaLoader.c DynaLoader.xs'}, ); - sub MY::postamble { ' --- 7,17 ---- MAN3PODS => ' ', # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? ! VERSION_FROM => 'DynaLoader_pm.PL', ! PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm'}, ! PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'}, ! clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'}, ); sub MY::postamble { ' diff -c 'perl5.004_04/ext/DynaLoader/dl_aix.xs' 'perl5.004_05/ext/DynaLoader/dl_aix.xs' Index: ./ext/DynaLoader/dl_aix.xs Prereq: 1.5 *** ./ext/DynaLoader/dl_aix.xs Tue Oct 7 05:20:43 1997 --- ./ext/DynaLoader/dl_aix.xs Mon Apr 27 16:20:21 1998 *************** *** 29,34 **** --- 29,48 ---- #include #include + /* + * AIX 4.3 does remove some useful definitions from ldfcn.h. Define + * these here to compensate for that lossage. + */ + #ifndef BEGINNING + # define BEGINNING SEEK_SET + #endif + #ifndef FSEEK + # define FSEEK(ldptr,o,p) fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p) + #endif + #ifndef FREAD + # define FREAD(p,s,n,ldptr) fread(p,s,n,IOPTR(ldptr)) + #endif + /* If using PerlIO, redefine these macros from */ #ifdef USE_PERLIO #define FSEEK(ldptr,o,p) PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p) diff -c 'perl5.004_04/ext/DynaLoader/dl_dld.xs' 'perl5.004_05/ext/DynaLoader/dl_dld.xs' Index: ./ext/DynaLoader/dl_dld.xs *** ./ext/DynaLoader/dl_dld.xs Tue Oct 7 05:20:43 1997 --- ./ext/DynaLoader/dl_dld.xs Wed Apr 22 07:49:24 1998 *************** *** 144,150 **** if (dld_undefined_sym_count) { int x; char **undef_syms = dld_list_undefined_sym(); ! EXTEND(sp, dld_undefined_sym_count); for (x=0; x < dld_undefined_sym_count; x++) PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); free(undef_syms); --- 144,150 ---- if (dld_undefined_sym_count) { int x; char **undef_syms = dld_list_undefined_sym(); ! EXTEND(SP, dld_undefined_sym_count); for (x=0; x < dld_undefined_sym_count; x++) PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); free(undef_syms); diff -c 'perl5.004_04/ext/DynaLoader/dl_dlopen.xs' 'perl5.004_05/ext/DynaLoader/dl_dlopen.xs' Index: ./ext/DynaLoader/dl_dlopen.xs *** ./ext/DynaLoader/dl_dlopen.xs Tue Oct 7 05:20:43 1997 --- ./ext/DynaLoader/dl_dlopen.xs Fri Oct 9 11:58:53 1998 *************** *** 122,128 **** # ifdef __NetBSD__ # define dlerror() strerror(errno) # else ! # define dlerror() "Unknown error - dlerror() not implemented" # endif #endif --- 122,130 ---- # ifdef __NetBSD__ # define dlerror() strerror(errno) # else ! # ifndef dlerror /* dlerror could be a more useful macro */ ! # define dlerror() "Unknown error - dlerror() not implemented" ! # endif # endif #endif diff -c 'perl5.004_04/ext/DynaLoader/dl_hpux.xs' 'perl5.004_05/ext/DynaLoader/dl_hpux.xs' Index: ./ext/DynaLoader/dl_hpux.xs *** ./ext/DynaLoader/dl_hpux.xs Tue Oct 7 05:20:43 1997 --- ./ext/DynaLoader/dl_hpux.xs Fri Apr 10 10:35:34 1998 *************** *** 65,70 **** --- 65,73 ---- * unresolved references in situations like this. */ /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */ } + /* BIND_NOSTART removed from bind_type because it causes the shared library's */ + /* initialisers not to be run. This causes problems with all of the static objects */ + /* in the library. */ #ifdef DEBUGGING if (dl_debug) bind_type |= BIND_VERBOSE; *************** *** 74,87 **** for (i = 0; i <= max; i++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym)); ! obj = shl_load(sym, bind_type | BIND_NOSTART, 0L); if (obj == NULL) { goto end; } } DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename)); ! obj = shl_load(filename, bind_type | BIND_NOSTART, 0L); DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj)); end: --- 77,90 ---- for (i = 0; i <= max; i++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym)); ! obj = shl_load(sym, bind_type, 0L); if (obj == NULL) { goto end; } } DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename)); ! obj = shl_load(filename, bind_type, 0L); DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj)); end: diff -c 'perl5.004_04/ext/Fcntl/Fcntl.pm' 'perl5.004_05/ext/Fcntl/Fcntl.pm' Index: ./ext/Fcntl/Fcntl.pm *** ./ext/Fcntl/Fcntl.pm Mon Jun 9 15:06:22 1997 --- ./ext/Fcntl/Fcntl.pm Mon Jul 6 19:03:16 1998 *************** *** 52,84 **** # (move infrequently used names to @EXPORT_OK below) @EXPORT = qw( ! F_DUPFD F_GETFD F_GETLK F_SETFD F_GETFL F_SETFL F_SETLK F_SETLKW ! FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK F_POSIX ! O_CREAT O_EXCL O_NOCTTY O_TRUNC ! O_APPEND O_NONBLOCK ! O_NDELAY O_DEFER ! O_RDONLY O_RDWR O_WRONLY ! O_BINARY O_TEXT ! O_EXLOCK O_SHLOCK O_ASYNC O_DSYNC O_RSYNC O_SYNC ! F_SETOWN F_GETOWN ); # Other items we are prepared to export if requested @EXPORT_OK = qw( ! LOCK_SH LOCK_EX LOCK_NB LOCK_UN ! FAPPEND FASYNC FCREAT FDEFER FEXCL FNDELAY FNONBLOCK FSYNC FTRUNC ); # Named groups of exports %EXPORT_TAGS = ( 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], 'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FEXCL ! FNDELAY FNONBLOCK FSYNC FTRUNC)], ); sub AUTOLOAD { ! my($constname); ! ($constname = $AUTOLOAD) =~ s/.*:://; ! my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; --- 52,122 ---- # (move infrequently used names to @EXPORT_OK below) @EXPORT = qw( ! FD_CLOEXEC ! F_DUPFD ! F_EXLCK ! F_GETFD ! F_GETFL ! F_GETLK ! F_GETOWN ! F_POSIX ! F_RDLCK ! F_SETFD ! F_SETFL ! F_SETLK ! F_SETLKW ! F_SETOWN ! F_SHLCK ! F_UNLCK ! F_WRLCK ! O_ACCMODE ! O_APPEND ! O_ASYNC ! O_BINARY ! O_CREAT ! O_DEFER ! O_DSYNC ! O_EXCL ! O_EXLOCK ! O_NDELAY ! O_NOCTTY ! O_NONBLOCK ! O_RDONLY ! O_RDWR ! O_RSYNC ! O_SHLOCK ! O_SYNC ! O_TEXT ! O_TRUNC ! O_WRONLY ); # Other items we are prepared to export if requested @EXPORT_OK = qw( ! FAPPEND ! FASYNC ! FCREAT ! FDEFER ! FEXCL ! FNDELAY ! FNONBLOCK ! FSYNC ! FTRUNC ! LOCK_EX ! LOCK_NB ! LOCK_SH ! LOCK_UN ); # Named groups of exports %EXPORT_TAGS = ( 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], 'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FEXCL ! FNDELAY FNONBLOCK FSYNC FTRUNC)], ); sub AUTOLOAD { ! (my $constname = $AUTOLOAD) =~ s/.*:://; ! my $val = constant($constname, 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; *************** *** 90,96 **** "; } } ! eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; } --- 128,134 ---- "; } } ! *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } diff -c 'perl5.004_04/ext/Fcntl/Fcntl.xs' 'perl5.004_05/ext/Fcntl/Fcntl.xs' Index: ./ext/Fcntl/Fcntl.xs *** ./ext/Fcntl/Fcntl.xs Mon Jun 9 12:00:27 1997 --- ./ext/Fcntl/Fcntl.xs Mon Jul 6 19:03:16 1998 *************** *** 45,56 **** --- 45,68 ---- #else goto not_there; #endif + if (strEQ(name, "F_EXLCK")) + #ifdef F_EXLCK + return F_EXLCK; + #else + goto not_there; + #endif if (strEQ(name, "F_GETFD")) #ifdef F_GETFD return F_GETFD; #else goto not_there; #endif + if (strEQ(name, "F_GETFL")) + #ifdef F_GETFL + return F_GETFL; + #else + goto not_there; + #endif if (strEQ(name, "F_GETLK")) #ifdef F_GETLK return F_GETLK; *************** *** 63,83 **** #else goto not_there; #endif ! if (strEQ(name, "F_SETFD")) ! #ifdef F_SETFD ! return F_SETFD; #else goto not_there; #endif ! if (strEQ(name, "F_GETFL")) ! #ifdef F_GETFL ! return F_GETFL; #else goto not_there; #endif ! if (strEQ(name, "F_POSIX")) ! #ifdef F_POSIX ! return F_POSIX; #else goto not_there; #endif --- 75,95 ---- #else goto not_there; #endif ! if (strEQ(name, "F_POSIX")) ! #ifdef F_POSIX ! return F_POSIX; #else goto not_there; #endif ! if (strEQ(name, "F_RDLCK")) ! #ifdef F_RDLCK ! return F_RDLCK; #else goto not_there; #endif ! if (strEQ(name, "F_SETFD")) ! #ifdef F_SETFD ! return F_SETFD; #else goto not_there; #endif *************** *** 105,113 **** #else goto not_there; #endif ! if (strEQ(name, "F_RDLCK")) ! #ifdef F_RDLCK ! return F_RDLCK; #else goto not_there; #endif --- 117,125 ---- #else goto not_there; #endif ! if (strEQ(name, "F_SHLCK")) ! #ifdef F_SHLCK ! return F_SHLCK; #else goto not_there; #endif *************** *** 150,155 **** --- 162,173 ---- #else goto not_there; #endif + if (strEQ(name, "FDEFER")) + #ifdef FDEFER + return FDEFER; + #else + goto not_there; + #endif if (strEQ(name, "FEXCL")) #ifdef FEXCL return FEXCL; *************** *** 214,246 **** break; case 'O': if (strnEQ(name, "O_", 2)) { if (strEQ(name, "O_CREAT")) #ifdef O_CREAT return O_CREAT; #else goto not_there; #endif if (strEQ(name, "O_EXCL")) #ifdef O_EXCL return O_EXCL; #else goto not_there; #endif ! if (strEQ(name, "O_NOCTTY")) ! #ifdef O_NOCTTY ! return O_NOCTTY; #else goto not_there; #endif ! if (strEQ(name, "O_TRUNC")) ! #ifdef O_TRUNC ! return O_TRUNC; #else goto not_there; #endif ! if (strEQ(name, "O_APPEND")) ! #ifdef O_APPEND ! return O_APPEND; #else goto not_there; #endif --- 232,300 ---- break; case 'O': if (strnEQ(name, "O_", 2)) { + if (strEQ(name, "O_ACCMODE")) + #ifdef O_ACCMODE + return O_ACCMODE; + #else + goto not_there; + #endif + if (strEQ(name, "O_APPEND")) + #ifdef O_APPEND + return O_APPEND; + #else + goto not_there; + #endif + if (strEQ(name, "O_ASYNC")) + #ifdef O_ASYNC + return O_ASYNC; + #else + goto not_there; + #endif + if (strEQ(name, "O_BINARY")) + #ifdef O_BINARY + return O_BINARY; + #else + goto not_there; + #endif if (strEQ(name, "O_CREAT")) #ifdef O_CREAT return O_CREAT; #else goto not_there; #endif + if (strEQ(name, "O_DEFER")) + #ifdef O_DEFER + return O_DEFER; + #else + goto not_there; + #endif + if (strEQ(name, "O_DSYNC")) + #ifdef O_DSYNC + return O_DSYNC; + #else + goto not_there; + #endif if (strEQ(name, "O_EXCL")) #ifdef O_EXCL return O_EXCL; #else goto not_there; #endif ! if (strEQ(name, "O_EXLOCK")) ! #ifdef O_EXLOCK ! return O_EXLOCK; #else goto not_there; #endif ! if (strEQ(name, "O_NDELAY")) ! #ifdef O_NDELAY ! return O_NDELAY; #else goto not_there; #endif ! if (strEQ(name, "O_NOCTTY")) ! #ifdef O_NOCTTY ! return O_NOCTTY; #else goto not_there; #endif *************** *** 250,261 **** #else goto not_there; #endif - if (strEQ(name, "O_NDELAY")) - #ifdef O_NDELAY - return O_NDELAY; - #else - goto not_there; - #endif if (strEQ(name, "O_RDONLY")) #ifdef O_RDONLY return O_RDONLY; --- 304,309 ---- *************** *** 268,288 **** #else goto not_there; #endif ! if (strEQ(name, "O_WRONLY")) ! #ifdef O_WRONLY ! return O_WRONLY; ! #else ! goto not_there; ! #endif ! if (strEQ(name, "O_BINARY")) ! #ifdef O_BINARY ! return O_BINARY; ! #else ! goto not_there; ! #endif ! if (strEQ(name, "O_EXLOCK")) ! #ifdef O_EXLOCK ! return O_EXLOCK; #else goto not_there; #endif --- 316,324 ---- #else goto not_there; #endif ! if (strEQ(name, "O_RSYNC")) ! #ifdef O_RSYNC ! return O_RSYNC; #else goto not_there; #endif *************** *** 292,324 **** #else goto not_there; #endif ! if (strEQ(name, "O_ASYNC")) ! #ifdef O_ASYNC ! return O_ASYNC; ! #else ! goto not_there; ! #endif ! if (strEQ(name, "O_DSYNC")) ! #ifdef O_DSYNC ! return O_DSYNC; #else goto not_there; #endif ! if (strEQ(name, "O_RSYNC")) ! #ifdef O_RSYNC ! return O_RSYNC; #else goto not_there; #endif ! if (strEQ(name, "O_SYNC")) ! #ifdef O_SYNC ! return O_SYNC; #else goto not_there; #endif ! if (strEQ(name, "O_DEFER")) ! #ifdef O_DEFER ! return O_DEFER; #else goto not_there; #endif --- 328,354 ---- #else goto not_there; #endif ! if (strEQ(name, "O_SYNC")) ! #ifdef O_SYNC ! return O_SYNC; #else goto not_there; #endif ! if (strEQ(name, "O_TEXT")) ! #ifdef O_TEXT ! return O_TEXT; #else goto not_there; #endif ! if (strEQ(name, "O_TRUNC")) ! #ifdef O_TRUNC ! return O_TRUNC; #else goto not_there; #endif ! if (strEQ(name, "O_WRONLY")) ! #ifdef O_WRONLY ! return O_WRONLY; #else goto not_there; #endif diff -c 'perl5.004_04/ext/GDBM_File/GDBM_File.pm' 'perl5.004_05/ext/GDBM_File/GDBM_File.pm' Index: ./ext/GDBM_File/GDBM_File.pm *** ./ext/GDBM_File/GDBM_File.pm Fri Aug 16 15:45:29 1996 --- ./ext/GDBM_File/GDBM_File.pm Wed Mar 4 11:31:29 1998 *************** *** 7,13 **** =head1 SYNOPSIS use GDBM_File ; ! tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640); # Use the %hash array. untie %hash ; --- 7,13 ---- =head1 SYNOPSIS use GDBM_File ; ! tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640; # Use the %hash array. untie %hash ; diff -c 'perl5.004_04/ext/IO/IO.pm' 'perl5.004_05/ext/IO/IO.pm' Index: ./ext/IO/IO.pm *** ./ext/IO/IO.pm Mon Oct 7 11:08:30 1996 --- ./ext/IO/IO.pm Thu Apr 23 15:49:22 1998 *************** *** 12,18 **** =head1 DESCRIPTION ! C provides a simple mechanism to load all of the IO modules at one go. Currently this includes: IO::Handle --- 12,18 ---- =head1 DESCRIPTION ! C provides a simple mechanism to load some of the IO modules at one go. Currently this includes: IO::Handle diff -c 'perl5.004_04/ext/IO/lib/IO/Handle.pm' 'perl5.004_05/ext/IO/lib/IO/Handle.pm' Index: ./ext/IO/lib/IO/Handle.pm *** ./ext/IO/lib/IO/Handle.pm Thu Jul 31 14:50:00 1997 --- ./ext/IO/lib/IO/Handle.pm Thu Jul 16 18:23:25 1998 *************** *** 444,457 **** } sub input_record_separator { - my $old = new SelectSaver qualify($_[0], caller); my $prev = $/; $/ = $_[1] if @_ > 1; $prev; } sub input_line_number { - my $old = new SelectSaver qualify($_[0], caller); my $prev = $.; $. = $_[1] if @_ > 1; $prev; --- 444,455 ---- diff -c 'perl5.004_04/ext/IO/lib/IO/Socket.pm' 'perl5.004_05/ext/IO/lib/IO/Socket.pm' Index: ./ext/IO/lib/IO/Socket.pm *** ./ext/IO/lib/IO/Socket.pm Fri Sep 19 13:05:56 1997 --- ./ext/IO/lib/IO/Socket.pm Mon Apr 27 16:20:21 1998 *************** *** 186,192 **** my $fh1 = $class->new(); my $fh2 = $class->new(); ! socketpair($fh1,$fh1,$domain,$type,$protocol) or return (); ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type; --- 186,192 ---- my $fh1 = $class->new(); my $fh2 = $class->new(); ! socketpair($fh1,$fh2,$domain,$type,$protocol) or return (); ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type; diff -c 'perl5.004_04/ext/NDBM_File/NDBM_File.pm' 'perl5.004_05/ext/NDBM_File/NDBM_File.pm' Index: ./ext/NDBM_File/NDBM_File.pm *** ./ext/NDBM_File/NDBM_File.pm Fri Aug 16 15:45:53 1996 --- ./ext/NDBM_File/NDBM_File.pm Mon Apr 27 16:20:21 1998 *************** *** 12,18 **** @ISA = qw(Tie::Hash DynaLoader); ! $VERSION = "1.00"; bootstrap NDBM_File $VERSION; --- 12,18 ---- @ISA = qw(Tie::Hash DynaLoader); ! $VERSION = "1.01"; bootstrap NDBM_File $VERSION; *************** *** 27,32 **** --- 27,33 ---- =head1 SYNOPSIS use NDBM_File; + use Fcntl; # for O_ constants tie(%h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); diff -c 'perl5.004_04/ext/ODBM_File/ODBM_File.xs' 'perl5.004_05/ext/ODBM_File/ODBM_File.xs' Index: ./ext/ODBM_File/ODBM_File.xs *** ./ext/ODBM_File/ODBM_File.xs Thu Jul 31 14:50:24 1997 --- ./ext/ODBM_File/ODBM_File.xs Tue May 19 17:26:03 1998 *************** *** 3,9 **** #include "XSUB.h" #ifdef NULL ! #undef NULL #endif #ifdef I_DBM # include --- 3,9 ---- #include "XSUB.h" #ifdef NULL ! #undef NULL /* XXX Why? */ #endif #ifdef I_DBM # include *************** *** 45,50 **** --- 45,54 ---- #endif MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ + + #ifndef NULL + # define NULL 0 + #endif ODBM_File odbm_TIEHASH(dbtype, filename, flags, mode) diff -c 'perl5.004_04/ext/Opcode/Opcode.pm' 'perl5.004_05/ext/Opcode/Opcode.pm' Index: ./ext/Opcode/Opcode.pm *** ./ext/Opcode/Opcode.pm Fri Apr 18 12:32:38 1997 --- ./ext/Opcode/Opcode.pm Thu Apr 23 15:49:22 1998 *************** *** 152,158 **** =item an operator tag name (optag) Operator tags can be used to refer to groups (or sets) of operators. ! Tag names always being with a colon. The Opcode module defines several optags and the user can define others using the define_optag function. =item a negated opname or optag --- 152,158 ---- =item an operator tag name (optag) Operator tags can be used to refer to groups (or sets) of operators. ! Tag names always begin with a colon. The Opcode module defines several optags and the user can define others using the define_optag function. =item a negated opname or optag *************** *** 563,569 **** mbeattie@sable.ox.ac.uk as part of Safe version 1. Split out from Safe module version 1, named opcode tags and other ! changes added by Tim Bunce EFE. =cut --- 563,569 ---- mbeattie@sable.ox.ac.uk as part of Safe version 1. Split out from Safe module version 1, named opcode tags and other ! changes added by Tim Bunce. =cut diff -c 'perl5.004_04/ext/Opcode/Opcode.xs' 'perl5.004_05/ext/Opcode/Opcode.xs' Index: ./ext/Opcode/Opcode.xs *** ./ext/Opcode/Opcode.xs Thu Apr 24 16:19:21 1997 --- ./ext/Opcode/Opcode.xs Tue Jul 7 10:39:51 1998 *************** *** 5,10 **** --- 5,11 ---- /* maxo shouldn't differ from MAXO but leave room anyway (see BOOT:) */ #define OP_MASK_BUF_SIZE (MAXO + 100) + /* XXX op_named_bits and opset_all are never freed */ static HV *op_named_bits; /* cache shared for whole process */ static SV *opset_all; /* mask with all bits set */ static IV opset_len; /* length of opmasks in bytes */ *************** *** 21,26 **** --- 22,29 ---- * It is first loaded with the name and number of each perl operator. * Then the builtin tags :none and :all are added. * Opcode.pm loads the standard optags from __DATA__ + * XXX leak-alert: data allocated here is never freed, call this + * at most once */ static void *************** *** 244,250 **** char * package SV * mask SV * codesv ! PPCODE: char op_mask_buf[OP_MASK_BUF_SIZE]; GV *gv; --- 247,253 ---- char * package SV * mask SV * codesv ! PPCODE: char op_mask_buf[OP_MASK_BUF_SIZE]; GV *gv; *************** *** 266,272 **** sv_free((SV*)GvHV(gv)); GvHV(gv) = (HV*)SvREFCNT_inc(defstash); ! PUSHMARK(sp); perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ SPAGAIN; /* for the PUTBACK added by xsubpp */ LEAVE; --- 269,275 ---- sv_free((SV*)GvHV(gv)); GvHV(gv) = (HV*)SvREFCNT_inc(defstash); ! PUSHMARK(SP); perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ SPAGAIN; /* for the PUTBACK added by xsubpp */ LEAVE; *************** *** 281,291 **** void invert_opset(opset) SV *opset ! CODE: { char *bitmap; STRLEN len = opset_len; ! opset = new_opset(opset); /* verify and clone opset */ bitmap = SvPVX(opset); while(len-- > 0) bitmap[len] = ~bitmap[len]; --- 284,294 ---- void invert_opset(opset) SV *opset ! CODE: { char *bitmap; STRLEN len = opset_len; ! opset = sv_2mortal(new_opset(opset)); /* verify and clone opset */ bitmap = SvPVX(opset); while(len-- > 0) bitmap[len] = ~bitmap[len]; *************** *** 300,306 **** opset_to_ops(opset, desc = 0) SV *opset int desc ! PPCODE: { STRLEN len; int i, j, myopcode; --- 303,309 ---- opset_to_ops(opset, desc = 0) SV *opset int desc ! PPCODE: { STRLEN len; int i, j, myopcode; *************** *** 319,330 **** void opset(...) ! CODE: int i, j; SV *bitspec, *opset; char *bitmap; STRLEN len, on; ! opset = new_opset(Nullsv); bitmap = SvPVX(opset); for (i = 0; i < items; i++) { char *opname; --- 322,333 ---- void opset(...) ! CODE: int i, j; SV *bitspec, *opset; char *bitmap; STRLEN len, on; ! opset = sv_2mortal(new_opset(Nullsv)); bitmap = SvPVX(opset); for (i = 0; i < items; i++) { char *opname; *************** *** 349,359 **** void permit_only(safe, ...) SV *safe ! ALIAS: permit = 1 deny_only = 2 deny = 3 ! CODE: int i, on; SV *bitspec, *mask; char *bitmap, *opname; --- 352,362 ---- void permit_only(safe, ...) SV *safe ! ALIAS: permit = 1 deny_only = 2 deny = 3 ! CODE: int i, on; SV *bitspec, *mask; char *bitmap, *opname; *************** *** 363,370 **** croak("Not a Safe object"); mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1); if (ONLY_THESE) /* *_only = new mask, else edit current */ ! sv_setsv(mask, new_opset(PERMITING ? opset_all : Nullsv)); ! else verify_opset(mask,1); /* croaks */ bitmap = SvPVX(mask); for (i = 1; i < items; i++) { on = PERMITING ? 0 : 1; /* deny = mask bit on */ --- 366,374 ---- croak("Not a Safe object"); mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1); if (ONLY_THESE) /* *_only = new mask, else edit current */ ! sv_setsv(mask, sv_2mortal(new_opset(PERMITING ? opset_all : Nullsv))); ! else ! verify_opset(mask,1); /* croaks */ bitmap = SvPVX(mask); for (i = 1; i < items; i++) { on = PERMITING ? 0 : 1; /* deny = mask bit on */ *************** *** 386,392 **** void opdesc(...) ! PPCODE: int i, myopcode; STRLEN len; SV **args; --- 390,396 ---- void opdesc(...) ! PPCODE: int i, myopcode; STRLEN len; SV **args; *************** *** 423,429 **** define_optag(optagsv, mask) SV *optagsv SV *mask ! CODE: STRLEN len; char *optag = SvPV(optagsv, len); put_op_bitspec(optag, len, mask); /* croaks */ --- 427,433 ---- define_optag(optagsv, mask) SV *optagsv SV *mask ! CODE: STRLEN len; char *optag = SvPV(optagsv, len); put_op_bitspec(optag, len, mask); /* croaks */ *************** *** 432,455 **** void empty_opset() ! CODE: ST(0) = sv_2mortal(new_opset(Nullsv)); void full_opset() ! CODE: ST(0) = sv_2mortal(new_opset(opset_all)); void opmask_add(opset) SV *opset ! PREINIT: if (!op_mask) Newz(0, op_mask, maxo, char); void opcodes() ! PPCODE: if (GIMME == G_ARRAY) { croak("opcodes in list context not yet implemented"); /* XXX */ } --- 436,459 ---- void empty_opset() ! CODE: ST(0) = sv_2mortal(new_opset(Nullsv)); void full_opset() ! CODE: ST(0) = sv_2mortal(new_opset(opset_all)); void opmask_add(opset) SV *opset ! PREINIT: if (!op_mask) Newz(0, op_mask, maxo, char); void opcodes() ! PPCODE: if (GIMME == G_ARRAY) { croak("opcodes in list context not yet implemented"); /* XXX */ } *************** *** 459,465 **** void opmask() ! CODE: ST(0) = sv_2mortal(new_opset(Nullsv)); if (op_mask) { char *bitmap = SvPVX(ST(0)); --- 463,469 ---- void opmask() ! CODE: ST(0) = sv_2mortal(new_opset(Nullsv)); if (op_mask) { char *bitmap = SvPVX(ST(0)); diff -c 'perl5.004_04/ext/Opcode/Safe.pm' 'perl5.004_05/ext/Opcode/Safe.pm' Index: ./ext/Opcode/Safe.pm *** ./ext/Opcode/Safe.pm Mon Mar 24 11:31:29 1997 --- ./ext/Opcode/Safe.pm Tue Jul 7 10:39:51 1998 *************** *** 53,63 **** sub DESTROY { my $obj = shift; ! $obj->erase if $obj->{Erase}; } sub erase { ! my $obj= shift; my $pkg = $obj->root(); my ($stem, $leaf); --- 53,63 ---- sub DESTROY { my $obj = shift; ! $obj->erase('DESTROY') if $obj->{Erase}; } sub erase { ! my ($obj, $action) = @_; my $pkg = $obj->root(); my ($stem, $leaf); *************** *** 73,90 **** #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n"; # ", join(', ', %$stem_symtab),"\n"; ! delete $stem_symtab->{$leaf}; ! # my $leaf_glob = $stem_symtab->{$leaf}; ! # my $leaf_symtab = *{$leaf_glob}{HASH}; # warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n"; ! # %$leaf_symtab = (); #delete $leaf_symtab->{'__ANON__'}; #delete $leaf_symtab->{'foo'}; #delete $leaf_symtab->{'main::'}; # my $foo = undef ${"$stem\::"}{"$leaf\::"}; ! $obj->share_from('main', $default_share); 1; } --- 73,94 ---- #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n"; # ", join(', ', %$stem_symtab),"\n"; ! # delete $stem_symtab->{$leaf}; ! my $leaf_glob = $stem_symtab->{$leaf}; ! my $leaf_symtab = *{$leaf_glob}{HASH}; # warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n"; ! %$leaf_symtab = (); #delete $leaf_symtab->{'__ANON__'}; #delete $leaf_symtab->{'foo'}; #delete $leaf_symtab->{'main::'}; # my $foo = undef ${"$stem\::"}{"$leaf\::"}; ! if ($action and $action eq 'DESTROY') { ! delete $stem_symtab->{$leaf}; ! } else { ! $obj->share_from('main', $default_share); ! } 1; } diff -c 'perl5.004_04/ext/POSIX/Makefile.PL' 'perl5.004_05/ext/POSIX/Makefile.PL' Index: ./ext/POSIX/Makefile.PL *** ./ext/POSIX/Makefile.PL Mon Jun 24 10:25:03 1996 --- ./ext/POSIX/Makefile.PL Tue May 19 17:26:03 1998 *************** *** 1,7 **** use ExtUtils::MakeMaker; WriteMakefile( NAME => 'POSIX', ! LIBS => ["-lm -lposix -lcposix"], MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', --- 1,7 ---- use ExtUtils::MakeMaker; WriteMakefile( NAME => 'POSIX', ! ($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])), MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', diff -c 'perl5.004_04/ext/POSIX/POSIX.pm' 'perl5.004_05/ext/POSIX/POSIX.pm' Index: ./ext/POSIX/POSIX.pm *** ./ext/POSIX/POSIX.pm Tue Apr 1 13:50:47 1997 --- ./ext/POSIX/POSIX.pm Fri Sep 25 18:39:26 1998 *************** *** 68,74 **** _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX ! _POSIX_STREADM_MAX _POSIX_TZNAME_MAX)], locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME NULL localeconv setlocale)], --- 68,74 ---- _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX ! _POSIX_STREAM_MAX _POSIX_TZNAME_MAX)], locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME NULL localeconv setlocale)], *************** *** 179,184 **** --- 179,185 ---- alarm chdir chown close fork getlogin getppid getpgrp link pipe read rmdir sleep unlink write utime + nice ); # Grandfather old foo_h form to new :foo_h form *************** *** 248,254 **** 1; __END__ ! sub assert { usage "assert(expr)" if @_ != 1; if (!$_[0]) { croak "Assertion failed"; --- 249,255 ---- 1; __END__ ! sub assert { # XXX should pay attention to NDEBUG? ($POSIX::NDEBUG?) usage "assert(expr)" if @_ != 1; if (!$_[0]) { croak "Assertion failed"; *************** *** 826,832 **** sub getcwd { usage "getcwd()" if @_ != 0; ! chop($cwd = `pwd`); $cwd; } --- 827,840 ---- sub getcwd { usage "getcwd()" if @_ != 0; ! if ($^O eq 'MSWin32') { ! # this perhaps applies to everyone else also? ! require Cwd; ! $cwd = &Cwd::cwd; ! } ! else { ! chop($cwd = `pwd`); ! } $cwd; } diff -c 'perl5.004_04/ext/POSIX/POSIX.pod' 'perl5.004_05/ext/POSIX/POSIX.pod' Index: ./ext/POSIX/POSIX.pod *** ./ext/POSIX/POSIX.pod Fri Apr 18 14:40:48 1997 --- ./ext/POSIX/POSIX.pod Sun Nov 22 10:08:38 1998 *************** *** 1009,1021 **** Synopsis: ! strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) 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 2001 is 101. Consult your system's C manpage for details ! about these and the other arguments. The string for Tuesday, December 12, 1995. --- 1009,1022 ---- Synopsis: ! strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) The month (C), 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 2001 is 101. Consult your system's C manpage for details ! 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. *************** *** 1392,1398 **** =item new Create a new Termios object. This object will be destroyed automatically ! when it is no longer needed. $termios = POSIX::Termios->new; --- 1393,1401 ---- =item new Create a new Termios object. This object will be destroyed automatically ! when it is no longer needed. A Termios object corresponds to the termios ! C struct. new() mallocs a new one, getattr() fills it from a file descriptor, ! and setattr() sets a file descriptor's parameters to match Termios' contents. $termios = POSIX::Termios->new; *************** *** 1474,1486 **** Set the c_cflag field of a termios object. ! $termios->setcflag( &POSIX::CLOCAL ); =item setiflag Set the c_iflag field of a termios object. ! $termios->setiflag( &POSIX::BRKINT ); =item setispeed --- 1477,1489 ---- Set the c_cflag field of a termios object. ! $termios->setcflag( $c_cflag | &POSIX::CLOCAL ); =item setiflag Set the c_iflag field of a termios object. ! $termios->setiflag( $c_iflag | &POSIX::BRKINT ); =item setispeed *************** *** 1494,1506 **** Set the c_lflag field of a termios object. ! $termios->setlflag( &POSIX::ECHO ); =item setoflag Set the c_oflag field of a termios object. ! $termios->setoflag( &POSIX::OPOST ); =item setospeed --- 1497,1509 ---- Set the c_lflag field of a termios object. ! $termios->setlflag( $c_lflag | &POSIX::ECHO ); =item setoflag Set the c_oflag field of a termios object. ! $termios->setoflag( $c_oflag | &POSIX::OPOST ); =item setospeed diff -c 'perl5.004_04/ext/POSIX/POSIX.xs' 'perl5.004_05/ext/POSIX/POSIX.xs' Index: ./ext/POSIX/POSIX.xs *** ./ext/POSIX/POSIX.xs Tue Aug 5 09:03:01 1997 --- ./ext/POSIX/POSIX.xs Sun Nov 22 10:08:38 1998 *************** *** 1,3 **** --- 1,6 ---- + #ifdef WIN32 + #define _POSIX_ + #endif #include "EXTERN.h" #define PERLIO_NOT_STDIO 1 #include "perl.h" *************** *** 40,46 **** #include #include #include ! #include /* see hints/sunos_4_1.sh */ #include #if defined(__VMS) && !defined(__POSIX_SOURCE) --- 43,51 ---- #include #include #include ! #ifdef I_UNISTD ! #include ! #endif #include #if defined(__VMS) && !defined(__POSIX_SOURCE) *************** *** 161,166 **** --- 166,193 ---- } # define times(t) vms_times(t) #else + #if defined (WIN32) + # undef mkfifo /* #defined in perl.h */ + # define mkfifo(a,b) not_here("mkfifo") + # define ttyname(a) not_here("ttyname") + # define sigset_t long + # define pid_t long + # ifdef __BORLANDC__ + # define tzname _tzname + # endif + # ifdef _MSC_VER + # define mode_t short + # endif + # define sigaction(a,b,c) not_here("sigaction") + # define sigpending(a) not_here("sigpending") + # define sigprocmask(a,b,c) not_here("sigprocmask") + # define sigsuspend(a) not_here("sigsuspend") + # define sigemptyset(a) not_here("sigemptyset") + # define sigaddset(a,b) not_here("sigaddset") + # define sigdelset(a,b) not_here("sigdelset") + # define sigfillset(a) not_here("sigfillset") + # define sigismember(a,b) not_here("sigismember") + #else # include # include # ifdef HAS_UNAME *************** *** 170,176 **** # ifdef I_UTIME # include # endif ! #endif typedef int SysRet; typedef long SysRetLong; --- 197,204 ---- # ifdef I_UTIME # include # endif ! #endif /* WIN32 */ ! #endif /* __VMS */ typedef int SysRet; typedef long SysRetLong; *************** *** 297,307 **** --- 325,337 ---- #define localeconv() not_here("localeconv") #endif + #ifndef WIN32 #ifdef HAS_TZNAME extern char *tzname[]; #else char *tzname[] = { "" , "" }; #endif + #endif /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) * fields for which we don't have Configure support yet: *************** *** 317,322 **** --- 347,357 ---- * support is added and NETaa14816 is considered in full. * It does not address tzname aspects of NETaa14816. */ + #ifdef HAS_GNULIBC + # ifndef STRUCT_TM_HASZONE + # define STRUCT_TM_HAS_ZONE /* XXX need Configure test! */ + # endif + #endif #ifdef STRUCT_TM_HASZONE static void init_tm(ptm) /* see mktime, strftime and asctime */ *************** *** 822,827 **** --- 857,864 ---- #else goto not_there; #endif + break; + case 'L': if (strEQ(name, "ELOOP")) #ifdef ELOOP return ELOOP; *************** *** 2315,2369 **** case '_': if (strnEQ(name, "_PC_", 4)) { if (strEQ(name, "_PC_CHOWN_RESTRICTED")) ! #ifdef _PC_CHOWN_RESTRICTED return _PC_CHOWN_RESTRICTED; #else goto not_there; #endif if (strEQ(name, "_PC_LINK_MAX")) ! #ifdef _PC_LINK_MAX return _PC_LINK_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_MAX_CANON")) ! #ifdef _PC_MAX_CANON return _PC_MAX_CANON; #else goto not_there; #endif if (strEQ(name, "_PC_MAX_INPUT")) ! #ifdef _PC_MAX_INPUT return _PC_MAX_INPUT; #else goto not_there; #endif if (strEQ(name, "_PC_NAME_MAX")) ! #ifdef _PC_NAME_MAX return _PC_NAME_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_NO_TRUNC")) ! #ifdef _PC_NO_TRUNC return _PC_NO_TRUNC; #else goto not_there; #endif if (strEQ(name, "_PC_PATH_MAX")) ! #ifdef _PC_PATH_MAX return _PC_PATH_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_PIPE_BUF")) ! #ifdef _PC_PIPE_BUF return _PC_PIPE_BUF; #else goto not_there; #endif if (strEQ(name, "_PC_VDISABLE")) ! #ifdef _PC_VDISABLE return _PC_VDISABLE; #else goto not_there; --- 2352,2406 ---- case '_': if (strnEQ(name, "_PC_", 4)) { if (strEQ(name, "_PC_CHOWN_RESTRICTED")) ! #if defined(_PC_CHOWN_RESTRICTED) || HINT_SC_EXIST return _PC_CHOWN_RESTRICTED; #else goto not_there; #endif if (strEQ(name, "_PC_LINK_MAX")) ! #if defined(_PC_LINK_MAX) || HINT_SC_EXIST return _PC_LINK_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_MAX_CANON")) ! #if defined(_PC_MAX_CANON) || HINT_SC_EXIST return _PC_MAX_CANON; #else goto not_there; #endif if (strEQ(name, "_PC_MAX_INPUT")) ! #if defined(_PC_MAX_INPUT) || HINT_SC_EXIST return _PC_MAX_INPUT; #else goto not_there; #endif if (strEQ(name, "_PC_NAME_MAX")) ! #if defined(_PC_NAME_MAX) || HINT_SC_EXIST return _PC_NAME_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_NO_TRUNC")) ! #if defined(_PC_NO_TRUNC) || HINT_SC_EXIST return _PC_NO_TRUNC; #else goto not_there; #endif if (strEQ(name, "_PC_PATH_MAX")) ! #if defined(_PC_PATH_MAX) || HINT_SC_EXIST return _PC_PATH_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_PIPE_BUF")) ! #if defined(_PC_PIPE_BUF) || HINT_SC_EXIST return _PC_PIPE_BUF; #else goto not_there; #endif if (strEQ(name, "_PC_VDISABLE")) ! #if defined(_PC_VDISABLE) || HINT_SC_EXIST return _PC_VDISABLE; #else goto not_there; *************** *** 2489,2549 **** } if (strnEQ(name, "_SC_", 4)) { if (strEQ(name, "_SC_ARG_MAX")) ! #ifdef _SC_ARG_MAX return _SC_ARG_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_CHILD_MAX")) ! #ifdef _SC_CHILD_MAX return _SC_CHILD_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_CLK_TCK")) ! #ifdef _SC_CLK_TCK return _SC_CLK_TCK; #else goto not_there; #endif if (strEQ(name, "_SC_JOB_CONTROL")) ! #ifdef _SC_JOB_CONTROL return _SC_JOB_CONTROL; #else goto not_there; #endif if (strEQ(name, "_SC_NGROUPS_MAX")) ! #ifdef _SC_NGROUPS_MAX return _SC_NGROUPS_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_OPEN_MAX")) ! #ifdef _SC_OPEN_MAX return _SC_OPEN_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_SAVED_IDS")) ! #ifdef _SC_SAVED_IDS return _SC_SAVED_IDS; #else goto not_there; #endif if (strEQ(name, "_SC_STREAM_MAX")) ! #ifdef _SC_STREAM_MAX return _SC_STREAM_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_TZNAME_MAX")) ! #ifdef _SC_TZNAME_MAX return _SC_TZNAME_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_VERSION")) ! #ifdef _SC_VERSION return _SC_VERSION; #else goto not_there; --- 2526,2586 ---- } if (strnEQ(name, "_SC_", 4)) { if (strEQ(name, "_SC_ARG_MAX")) ! #if defined(_SC_ARG_MAX) || HINT_SC_EXIST return _SC_ARG_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_CHILD_MAX")) ! #if defined(_SC_CHILD_MAX) || HINT_SC_EXIST return _SC_CHILD_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_CLK_TCK")) ! #if defined(_SC_CLK_TCK) || HINT_SC_EXIST return _SC_CLK_TCK; #else goto not_there; #endif if (strEQ(name, "_SC_JOB_CONTROL")) ! #if defined(_SC_JOB_CONTROL) || HINT_SC_EXIST return _SC_JOB_CONTROL; #else goto not_there; #endif if (strEQ(name, "_SC_NGROUPS_MAX")) ! #if defined(_SC_NGROUPS_MAX) || HINT_SC_EXIST return _SC_NGROUPS_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_OPEN_MAX")) ! #if defined(_SC_OPEN_MAX) || HINT_SC_EXIST return _SC_OPEN_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_SAVED_IDS")) ! #if defined(_SC_SAVED_IDS) || HINT_SC_EXIST return _SC_SAVED_IDS; #else goto not_there; #endif if (strEQ(name, "_SC_STREAM_MAX")) ! #if defined(_SC_STREAM_MAX) || HINT_SC_EXIST return _SC_STREAM_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_TZNAME_MAX")) ! #if defined(_SC_TZNAME_MAX) || HINT_SC_EXIST return _SC_TZNAME_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_VERSION")) ! #if defined(_SC_VERSION) || HINT_SC_EXIST return _SC_VERSION; #else goto not_there; *************** *** 2616,2621 **** --- 2653,2659 ---- RETVAL = (struct termios*)safemalloc(sizeof(struct termios)); #else not_here("termios"); + RETVAL = 0; #endif } OUTPUT: *************** *** 2665,2671 **** #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_iflag; #else ! not_here("getiflag"); #endif OUTPUT: RETVAL --- 2703,2710 ---- #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_iflag; #else ! not_here("getiflag"); ! RETVAL = 0; #endif OUTPUT: RETVAL *************** *** 2677,2683 **** #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_oflag; #else ! not_here("getoflag"); #endif OUTPUT: RETVAL --- 2716,2723 ---- #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_oflag; #else ! not_here("getoflag"); ! RETVAL = 0; #endif OUTPUT: RETVAL *************** *** 2689,2695 **** #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_cflag; #else ! not_here("getcflag"); #endif OUTPUT: RETVAL --- 2729,2736 ---- #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_cflag; #else ! not_here("getcflag"); ! RETVAL = 0; #endif OUTPUT: RETVAL *************** *** 2701,2707 **** #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_lflag; #else ! not_here("getlflag"); #endif OUTPUT: RETVAL --- 2742,2749 ---- #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_lflag; #else ! not_here("getlflag"); ! RETVAL = 0; #endif OUTPUT: RETVAL *************** *** 2716,2722 **** croak("Bad getcc subscript"); RETVAL = termios_ref->c_cc[ccix]; #else ! not_here("getcc"); #endif OUTPUT: RETVAL --- 2758,2765 ---- croak("Bad getcc subscript"); RETVAL = termios_ref->c_cc[ccix]; #else ! not_here("getcc"); ! RETVAL = 0; #endif OUTPUT: RETVAL *************** *** 2948,2954 **** #ifdef HAS_LOCALECONV struct lconv *lcbuf; RETVAL = newHV(); - SET_NUMERIC_LOCAL(); if (lcbuf = localeconv()) { /* the strings */ if (lcbuf->decimal_point && *lcbuf->decimal_point) --- 2991,2996 ---- *************** *** 3150,3156 **** POSIX::SigAction action POSIX::SigAction oldaction CODE: ! # This code is really grody because we're trying to make the signal # interface look beautiful, which is hard. --- 3192,3200 ---- POSIX::SigAction action POSIX::SigAction oldaction CODE: ! #ifdef WIN32 ! RETVAL = not_here("sigaction"); ! #else # This code is really grody because we're trying to make the signal # interface look beautiful, which is hard. *************** *** 3229,3234 **** --- 3273,3279 ---- sv_setiv(*svp, oact.sa_flags); } } + #endif OUTPUT: RETVAL *************** *** 3240,3246 **** sigprocmask(how, sigset, oldsigset = 0) int how POSIX::SigSet sigset ! POSIX::SigSet oldsigset SysRet sigsuspend(signal_mask) --- 3285,3304 ---- sigprocmask(how, sigset, oldsigset = 0) int how POSIX::SigSet sigset ! POSIX::SigSet oldsigset = NO_INIT ! INIT: ! if ( items < 3 ) { ! oldsigset = 0; ! } ! else if (sv_derived_from(ST(2), "POSIX::SigSet")) { ! IV tmp = SvIV((SV*)SvRV(ST(2))); ! oldsigset = (POSIX__SigSet) tmp; ! } ! else { ! oldsigset = (sigset_t*)safemalloc(sizeof(sigset_t)); ! sigemptyset(oldsigset); ! sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset); ! } SysRet sigsuspend(signal_mask) *************** *** 3278,3284 **** PPCODE: int fds[2]; if (pipe(fds) != -1) { ! EXTEND(sp,2); PUSHs(sv_2mortal(newSViv(fds[0]))); PUSHs(sv_2mortal(newSViv(fds[1]))); } --- 3336,3342 ---- PPCODE: int fds[2]; if (pipe(fds) != -1) { ! EXTEND(SP,2); PUSHs(sv_2mortal(newSViv(fds[0]))); PUSHs(sv_2mortal(newSViv(fds[1]))); } *************** *** 3322,3328 **** #ifdef HAS_UNAME struct utsname buf; if (uname(&buf) >= 0) { ! EXTEND(sp, 5); PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); PUSHs(sv_2mortal(newSVpv(buf.release, 0))); --- 3380,3386 ---- #ifdef HAS_UNAME struct utsname buf; if (uname(&buf) >= 0) { ! EXTEND(SP, 5); PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); PUSHs(sv_2mortal(newSVpv(buf.release, 0))); *************** *** 3390,3396 **** num = strtod(str, &unparsed); PUSHs(sv_2mortal(newSVnv(num))); if (GIMME == G_ARRAY) { ! EXTEND(sp, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else --- 3448,3454 ---- num = strtod(str, &unparsed); PUSHs(sv_2mortal(newSVnv(num))); if (GIMME == G_ARRAY) { ! EXTEND(SP, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else *************** *** 3411,3417 **** else PUSHs(sv_2mortal(newSVnv((double)num))); if (GIMME == G_ARRAY) { ! EXTEND(sp, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else --- 3469,3475 ---- else PUSHs(sv_2mortal(newSVnv((double)num))); if (GIMME == G_ARRAY) { ! EXTEND(SP, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else *************** *** 3432,3438 **** else PUSHs(sv_2mortal(newSVnv((double)num))); if (GIMME == G_ARRAY) { ! EXTEND(sp, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else --- 3490,3496 ---- else PUSHs(sv_2mortal(newSVnv((double)num))); if (GIMME == G_ARRAY) { ! EXTEND(SP, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else *************** *** 3533,3539 **** struct tms tms; clock_t realtime; realtime = times( &tms ); ! EXTEND(sp,5); PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) ); PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) ); PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) ); --- 3591,3597 ---- struct tms tms; clock_t realtime; realtime = times( &tms ); ! EXTEND(SP,5); PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) ); PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) ); PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) ); *************** *** 3575,3581 **** RETVAL char * ! strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) char * fmt int sec int min --- 3633,3639 ---- RETVAL char * ! strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) char * fmt int sec int min *************** *** 3601,3606 **** --- 3659,3665 ---- 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)); } *************** *** 3611,3617 **** void tzname() PPCODE: ! EXTEND(sp,2); PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0])))); PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1])))); --- 3670,3676 ---- void tzname() PPCODE: ! EXTEND(SP,2); PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0])))); PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1])))); diff -c /dev/null 'perl5.004_05/ext/POSIX/hints/bsdos.pl' Index: ./ext/POSIX/hints/bsdos.pl *** ./ext/POSIX/hints/bsdos.pl Wed Dec 31 19:00:00 1969 --- ./ext/POSIX/hints/bsdos.pl Fri May 15 10:18:52 1998 *************** *** 0 **** --- 1,3 ---- + # BSD platforms have extra fields in struct tm that need to be initialized. + # XXX A Configure test is needed. + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff -c /dev/null 'perl5.004_05/ext/POSIX/hints/freebsd.pl' Index: ./ext/POSIX/hints/freebsd.pl *** ./ext/POSIX/hints/freebsd.pl Wed Dec 31 19:00:00 1969 --- ./ext/POSIX/hints/freebsd.pl Fri May 15 10:18:52 1998 *************** *** 0 **** --- 1,3 ---- + # BSD platforms have extra fields in struct tm that need to be initialized. + # XXX A Configure test is needed. + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff -c /dev/null 'perl5.004_05/ext/POSIX/hints/linux.pl' Index: ./ext/POSIX/hints/linux.pl *** ./ext/POSIX/hints/linux.pl Wed Dec 31 19:00:00 1969 --- ./ext/POSIX/hints/linux.pl Fri Apr 10 10:35:34 1998 *************** *** 0 **** --- 1,5 ---- + # libc6, aka glibc2, seems to need STRUCT_TM_HASZONE defined. + # Thanks to Bart Schuller + # See Message-ID: <19971009002636.50729@tanglefoot> + # XXX A Configure test is needed. + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DHINT_SC_EXIST' ; diff -c /dev/null 'perl5.004_05/ext/POSIX/hints/netbsd.pl' Index: ./ext/POSIX/hints/netbsd.pl *** ./ext/POSIX/hints/netbsd.pl Wed Dec 31 19:00:00 1969 --- ./ext/POSIX/hints/netbsd.pl Fri May 15 10:18:52 1998 *************** *** 0 **** --- 1,3 ---- + # BSD platforms have extra fields in struct tm that need to be initialized. + # XXX A Configure test is needed. + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff -c /dev/null 'perl5.004_05/ext/POSIX/hints/openbsd.pl' Index: ./ext/POSIX/hints/openbsd.pl *** ./ext/POSIX/hints/openbsd.pl Wed Dec 31 19:00:00 1969 --- ./ext/POSIX/hints/openbsd.pl Fri May 15 10:18:52 1998 *************** *** 0 **** --- 1,3 ---- + # BSD platforms have extra fields in struct tm that need to be initialized. + # XXX A Configure test is needed. + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff -c /dev/null 'perl5.004_05/ext/POSIX/hints/sunos_4.pl' Index: ./ext/POSIX/hints/sunos_4.pl *** ./ext/POSIX/hints/sunos_4.pl Wed Dec 31 19:00:00 1969 --- ./ext/POSIX/hints/sunos_4.pl Wed May 27 13:29:15 1998 *************** *** 0 **** --- 1,11 ---- + # SunOS 4.1.3 has two extra fields in struct tm. This works around + # the problem. Other BSD platforms may have similar problems. + # This state of affairs also persists in glibc2, found + # on linux systems running libc6. + # XXX A Configure test is needed. + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; + + # Although is inappropriate in general for SunOS, we need it + # in POSIX.xs to get the correct prototype for ttyname(). + + $self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DI_UNISTD' ; diff -c 'perl5.004_04/ext/SDBM_File/sdbm/Makefile.PL' 'perl5.004_05/ext/SDBM_File/sdbm/Makefile.PL' Index: ./ext/SDBM_File/sdbm/Makefile.PL *** ./ext/SDBM_File/sdbm/Makefile.PL Mon Jun 9 20:42:27 1997 --- ./ext/SDBM_File/sdbm/Makefile.PL Wed Mar 4 11:31:29 1998 *************** *** 29,33 **** --- 29,39 ---- lint: lint -abchx $(LIBSRCS) + + # This is a workaround, the problem is that our old GNU make exports + # variables into the environment so $(MYEXTLIB) is set in here to this + # value which can not be built. + sdbm/libsdbm.a: + true '; } diff -c 'perl5.004_04/ext/Socket/Socket.pm' 'perl5.004_05/ext/Socket/Socket.pm' Index: ./ext/Socket/Socket.pm *** ./ext/Socket/Socket.pm Sat Mar 8 11:47:04 1997 --- ./ext/Socket/Socket.pm Sun Nov 22 10:08:38 1998 *************** *** 1,7 **** package Socket; ! use vars qw($VERSION @ISA @EXPORT); ! $VERSION = "1.6"; =head1 NAME --- 1,7 ---- package Socket; ! use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); ! $VERSION = "1.7"; =head1 NAME *************** *** 20,26 **** $proto = getprotobyname('tcp'); socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto); ! $port = getservbyname('smtp'); $sin = sockaddr_in($port,inet_aton("127.1")); $sin = sockaddr_in(7,inet_aton("localhost")); $sin = sockaddr_in(7,INADDR_LOOPBACK); --- 20,26 ---- $proto = getprotobyname('tcp'); socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto); ! $port = getservbyname('smtp', 'tcp'); $sin = sockaddr_in($port,inet_aton("127.1")); $sin = sockaddr_in(7,inet_aton("localhost")); $sin = sockaddr_in(7,INADDR_LOOPBACK); *************** *** 45,50 **** --- 45,59 ---- far more likely chance of getting the numbers right. This includes all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc. + Also, some common socket "newline" constants are provided: the + constants C, C, and C, as well as C<$CR>, C<$LF>, and + C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>. If you do + not want to use the literal characters in your programs, then use + the constants provided here. They are not exported by default, but can + be imported individually, and with the C<:crlf> export tag: + + use Socket qw(:DEFAULT :crlf); + In addition, some structure manipulation functions are available: =over *************** *** 238,243 **** --- 247,269 ---- SO_TYPE SO_USELOOPBACK ); + + @EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF); + + %EXPORT_TAGS = ( + crlf => [qw(CR LF CRLF $CR $LF $CRLF)], + all => [@EXPORT, @EXPORT_OK], + ); + + BEGIN { + sub CR () {"\015"} + sub LF () {"\012"} + sub CRLF () {"\015\012"} + } + + *CR = \CR(); + *LF = \LF(); + *CRLF = \CRLF(); sub sockaddr_in { if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die diff -c 'perl5.004_04/ext/Socket/Socket.xs' 'perl5.004_05/ext/Socket/Socket.xs' Index: ./ext/Socket/Socket.xs *** ./ext/Socket/Socket.xs Thu Apr 24 16:01:34 1997 --- ./ext/Socket/Socket.xs Thu Apr 23 15:49:22 1998 *************** *** 328,335 **** case 'L': break; case 'M': if (strEQ(name, "MSG_DONTROUTE")) ! #ifdef MSG_DONTROUTE return MSG_DONTROUTE; #else goto not_there; --- 328,341 ---- case 'L': break; case 'M': + if (strEQ(name, "MSG_CTRUNC")) + #if defined(MSG_CTRUNC) || defined(__GLIBC__) /* XXX it's an enum */ + return MSG_CTRUNC; + #else + goto not_there; + #endif if (strEQ(name, "MSG_DONTROUTE")) ! #if defined(MSG_DONTROUTE) || defined(__GLIBC__) /* XXX it's an enum */ return MSG_DONTROUTE; #else goto not_there; *************** *** 341,357 **** goto not_there; #endif if (strEQ(name, "MSG_OOB")) ! #ifdef MSG_OOB return MSG_OOB; #else goto not_there; #endif if (strEQ(name, "MSG_PEEK")) ! #ifdef MSG_PEEK return MSG_PEEK; #else goto not_there; #endif break; case 'N': break; --- 347,369 ---- goto not_there; #endif if (strEQ(name, "MSG_OOB")) ! #if defined(MSG_OOB) || defined(__GLIBC__) /* XXX it's an enum */ return MSG_OOB; #else goto not_there; #endif if (strEQ(name, "MSG_PEEK")) ! #if defined(MSG_PEEK) || defined(__GLIBC__) /* XXX it's an enum */ return MSG_PEEK; #else goto not_there; #endif + if (strEQ(name, "MSG_PROXY")) + #if defined(MSG_PROXY) || defined(__GLIBC__) /* XXX it's an enum */ + return MSG_PROXY; + #else + goto not_there; + #endif break; case 'N': break; *************** *** 747,755 **** { #ifdef I_SYS_UN struct sockaddr_un sun_ad; /* fear using sun */ Zero( &sun_ad, sizeof sun_ad, char ); sun_ad.sun_family = AF_UNIX; ! Copy( pathname, sun_ad.sun_path, sizeof sun_ad.sun_path, char ); ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad)); #else ST(0) = (SV *) not_here("pack_sockaddr_un"); --- 759,771 ---- { #ifdef I_SYS_UN struct sockaddr_un sun_ad; /* fear using sun */ + STRLEN len; Zero( &sun_ad, sizeof sun_ad, char ); sun_ad.sun_family = AF_UNIX; ! len = strlen(pathname); ! if (len > sizeof(sun_ad.sun_path)) ! len = sizeof(sun_ad.sun_path); ! Copy( pathname, sun_ad.sun_path, len, char ); ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad)); #else ST(0) = (SV *) not_here("pack_sockaddr_un"); *************** *** 763,771 **** CODE: { #ifdef I_SYS_UN - STRLEN sockaddrlen; struct sockaddr_un addr; ! char * sun_ad = SvPV(sun_sv,sockaddrlen); if (sockaddrlen != sizeof(addr)) { croak("Bad arg length for %s, length is %d, should be %d", --- 779,788 ---- CODE: { #ifdef I_SYS_UN struct sockaddr_un addr; ! STRLEN sockaddrlen; ! char * sun_ad = SvPV(sun_sv,sockaddrlen); ! char * e; if (sockaddrlen != sizeof(addr)) { croak("Bad arg length for %s, length is %d, should be %d", *************** *** 780,787 **** "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX); ! } ! ST(0) = sv_2mortal(newSVpv(addr.sun_path, strlen(addr.sun_path))); #else ST(0) = (SV *) not_here("unpack_sockaddr_un"); #endif --- 797,807 ---- "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX); ! } ! e = addr.sun_path; ! while (*e && e < addr.sun_path + sizeof addr.sun_path) ! ++e; ! ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - addr.sun_path)); #else ST(0) = (SV *) not_here("unpack_sockaddr_un"); #endif *************** *** 828,834 **** port = ntohs(addr.sin_port); ip_address = addr.sin_addr; ! EXTEND(sp, 2); PUSHs(sv_2mortal(newSViv((IV) port))); PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address))); } --- 848,854 ---- port = ntohs(addr.sin_port); ip_address = addr.sin_addr; ! EXTEND(SP, 2); PUSHs(sv_2mortal(newSViv((IV) port))); PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address))); } diff -c 'perl5.004_04/global.sym' 'perl5.004_05/global.sym' Index: ./global.sym *** ./global.sym Mon Oct 6 13:20:06 1997 --- ./global.sym Mon Jul 20 05:46:14 1998 *************** *** 50,55 **** --- 50,56 ---- di div_amg div_ass_amg + do_binmode do_undump ds egid *************** *** 145,150 **** --- 146,152 ---- oldbufptr oldoldbufptr op + op_const_sv op_desc op_name op_seqmax *************** *** 426,431 **** --- 428,434 ---- filter_add filter_del filter_read + find_script fold_constants force_ident force_list *************** *** 499,514 **** magic_clearpack magic_clearsig magic_existspack - magic_freedefelem magic_get magic_getarylen magic_getdefelem magic_getglob magic_getpack magic_getpos magic_getsig magic_gettaint magic_getuvar magic_len magic_nextpack magic_set --- 502,519 ---- magic_clearpack magic_clearsig magic_existspack magic_get magic_getarylen magic_getdefelem magic_getglob + magic_getnkeys magic_getpack magic_getpos magic_getsig + magic_getsubstr magic_gettaint magic_getuvar + magic_getvec magic_len magic_nextpack magic_set *************** *** 574,579 **** --- 579,585 ---- newAVREF newBINOP newCONDOP + newCONSTSUB newCVREF newFORM newFOROP *************** *** 603,608 **** --- 609,615 ---- newSViv newSVnv newSVpv + newSVpvn newSVpvf newSVrv newSVsv *************** *** 1014,1019 **** --- 1021,1027 ---- same_dirent save_I16 save_I32 + save_aelem save_aptr save_ary save_clearsv *************** *** 1024,1029 **** --- 1032,1038 ---- save_freesv save_gp save_hash + save_helem save_hptr save_int save_item *************** *** 1080,1088 **** --- 1089,1101 ---- sv_backoff sv_bless sv_catpvf + sv_catpvf_mg sv_catpv + sv_catpv_mg sv_catpvn + sv_catpvn_mg sv_catsv + sv_catsv_mg sv_chop sv_clean_all sv_clean_objs *************** *** 1116,1133 **** --- 1129,1154 ---- sv_report_used sv_reset sv_setpvf + sv_setpvf_mg sv_setiv + sv_setiv_mg sv_setnv + sv_setnv_mg sv_setptrobj sv_setpv + sv_setpv_mg sv_setpviv + sv_setpviv_mg sv_setpvn + sv_setpvn_mg sv_setref_iv sv_setref_nv sv_setref_pv sv_setref_pvn sv_setsv + sv_setsv_mg sv_setuv + sv_setuv_mg sv_taint sv_tainted sv_unmagic *************** *** 1135,1140 **** --- 1156,1162 ---- sv_untaint sv_upgrade sv_usepvn + sv_usepvn_mg sv_vcatpvfn sv_vsetpvfn taint_env diff -c 'perl5.004_04/gv.c' 'perl5.004_05/gv.c' Index: ./gv.c *** ./gv.c Mon Oct 6 13:20:07 1997 --- ./gv.c Sun Nov 22 10:08:38 1998 *************** *** 19,26 **** #include "EXTERN.h" #include "perl.h" - EXT char rcsid[]; - GV * gv_AVadd(gv) register GV *gv; --- 19,24 ---- *************** *** 58,63 **** --- 56,62 ---- gv_fetchfile(name) char *name; { + dTHR; char smallbuf[256]; char *tmpbuf; STRLEN tmplen; *************** *** 92,97 **** --- 91,97 ---- STRLEN len; int multi; { + dTHR; register GP *gp; sv_upgrade((SV*)gv, SVt_PVGV); *************** *** 104,110 **** GvFILEGV(gv) = curcop->cop_filegv; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); ! GvSTASH(gv) = stash; GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; if (multi) --- 104,110 ---- GvFILEGV(gv) = curcop->cop_filegv; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); ! GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; if (multi) *************** *** 182,187 **** --- 182,188 ---- basestash = gv_stashpvn(packname, packlen, TRUE); gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { + dTHR; /* just for SvREFCNT_dec */ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); if (!gvp || !(gv = *gvp)) croak("Cannot create %s::ISA", HvNAME(stash)); *************** *** 195,201 **** if (av) { SV** svp = AvARRAY(av); ! I32 items = AvFILL(av) + 1; while (items--) { SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); --- 196,202 ---- if (av) { SV** svp = AvARRAY(av); ! I32 items = AvFILLp(av) + 1; while (items--) { SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); *************** *** 258,263 **** --- 259,265 ---- char* name; I32 autoload; { + dTHR; register char *nend; char *nsplit = 0; GV* gv; *************** *** 420,425 **** --- 422,428 ---- I32 add; I32 sv_type; { + dTHR; register char *name = nambeg; register GV *gv = 0; GV**gvp; *************** *** 427,433 **** register char *namend; HV *stash = 0; U32 add_gvflags = 0; - char *tmpbuf; if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ name++; --- 430,435 ---- *************** *** 443,465 **** len = namend - name; if (len > 0) { ! New(601, tmpbuf, len+3, char); Copy(name, tmpbuf, len, char); tmpbuf[len++] = ':'; tmpbuf[len++] = ':'; tmpbuf[len] = '\0'; gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); ! Safefree(tmpbuf); ! if (!gvp || *gvp == (GV*)&sv_undef) ! return Nullgv; ! gv = *gvp; ! ! if (SvTYPE(gv) == SVt_PVGV) ! GvMULTI_on(gv); ! else if (!add) return Nullgv; - else - gv_init(gv, stash, nambeg, namend - nambeg, (add & 2)); if (!(stash = GvHV(gv))) stash = GvHV(gv) = newHV(); --- 445,473 ---- len = namend - name; if (len > 0) { ! char smallbuf[256]; ! char *tmpbuf; ! ! if (len + 3 < sizeof smallbuf) ! tmpbuf = smallbuf; ! else ! New(601, tmpbuf, len+3, char); Copy(name, tmpbuf, len, char); tmpbuf[len++] = ':'; tmpbuf[len++] = ':'; tmpbuf[len] = '\0'; gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); ! gv = gvp ? *gvp : Nullgv; ! if (gv && gv != (GV*)&sv_undef) { ! if (SvTYPE(gv) != SVt_PVGV) ! gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI)); ! else ! GvMULTI_on(gv); ! } ! if (tmpbuf != smallbuf) ! Safefree(tmpbuf); ! if (!gv || gv == (GV*)&sv_undef) return Nullgv; if (!(stash = GvHV(gv))) stash = GvHV(gv) = newHV(); *************** *** 553,569 **** /* By this point we should have a stash and a name */ if (!stash) { ! if (add) { ! warn("Global symbol \"%s\" requires explicit package name", name); ! ++error_count; ! stash = curstash ? curstash : defstash; /* avoid core dumps */ ! add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV ! : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV ! : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV ! : 0); ! } ! else return Nullgv; } if (!SvREFCNT(stash)) /* symbol table under destruction */ --- 561,586 ---- /* By this point we should have a stash and a name */ if (!stash) { ! if (!add) return Nullgv; + if (add & ~GV_ADDMULTI) { + char sv_type_char = ((sv_type == SVt_PV) ? '$' + : (sv_type == SVt_PVAV) ? '@' + : (sv_type == SVt_PVHV) ? '%' + : 0); + if (sv_type_char) + warn("Global symbol \"%c%s\" requires explicit package name", + sv_type_char, name); + else + warn("Global symbol \"%s\" requires explicit package name", + name); + } + ++error_count; + stash = curstash ? curstash : defstash; /* avoid core dumps */ + add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV + : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV + : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV + : 0); } if (!SvREFCNT(stash)) /* symbol table under destruction */ *************** *** 583,591 **** /* Adding a new symbol */ ! if (add & 4) warn("Had to create %s unexpectedly", nambeg); ! gv_init(gv, stash, name, len, add & 2); gv_init_sv(gv, sv_type); GvFLAGS(gv) |= add_gvflags; --- 600,608 ---- /* Adding a new symbol */ ! if (add & GV_ADDWARN) warn("Had to create %s unexpectedly", nambeg); ! gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, sv_type); GvFLAGS(gv) |= add_gvflags; *************** *** 611,617 **** AV* av = GvAVn(gv); GvMULTI_on(gv); sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0); ! if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1) { char *pname; av_push(av, newSVpv(pname = "NDBM_File",0)); --- 628,636 ---- AV* av = GvAVn(gv); GvMULTI_on(gv); sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0); ! /* NOTE: No support for tied ISA */ ! if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA") ! && AvFILLp(av) == -1) { char *pname; av_push(av, newSVpv(pname = "NDBM_File",0)); *************** *** 632,638 **** if (strEQ(name, "OVERLOAD")) { HV* hv = GvHVn(gv); GvMULTI_on(gv); ! sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0); } break; #endif /* OVERLOAD */ --- 651,657 ---- if (strEQ(name, "OVERLOAD")) { HV* hv = GvHVn(gv); GvMULTI_on(gv); ! hv_magic(hv, gv, 'A'); } break; #endif /* OVERLOAD */ *************** *** 695,707 **** #endif goto magicalize; case '#': case '*': if (dowarn && len == 1 && sv_type == SVt_PV) warn("Use of $%s is deprecated", name); /* FALL THROUGH */ case '[': - case '!': case '^': case '~': case '=': --- 714,741 ---- #endif goto magicalize; + case '!': + if(len > 1) + break; + if(sv_type > SVt_PV) { + HV* stash = gv_stashpvn("Errno",5,FALSE); + if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { + dSP; + PUTBACK; + perl_require_pv("Errno.pm"); + SPAGAIN; + stash = gv_stashpvn("Errno",5,FALSE); + if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) + croak("Can't use %%! because Errno.pm is not available"); + } + } + goto magicalize; case '#': case '*': if (dowarn && len == 1 && sv_type == SVt_PV) warn("Use of $%s is deprecated", name); /* FALL THROUGH */ case '[': case '^': case '~': case '=': *************** *** 821,826 **** --- 855,861 ---- IO * newIO() { + dTHR; IO *io; GV *iogv; *************** *** 839,844 **** --- 874,880 ---- gv_check(stash) HV* stash; { + dTHR; register HE *entry; register I32 i; register GV *gv; *************** *** 966,977 **** Gv_AMupdate(stash) HV* stash; { GV** gvp; HV* hv; GV* gv; CV* cv; MAGIC* mg=mg_find((SV*)stash,'c'); ! AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL; AMT amt; if (mg && amtp->was_ok_am == amagic_generation --- 1002,1014 ---- Gv_AMupdate(stash) HV* stash; { + dTHR; GV** gvp; HV* hv; GV* gv; CV* cv; MAGIC* mg=mg_find((SV*)stash,'c'); ! AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; if (mg && amtp->was_ok_am == amagic_generation *************** *** 1129,1134 **** --- 1166,1172 ---- int method; int flags; { + dTHR; MAGIC *mg; CV *cv; CV **cvp=NULL, **ocvp=NULL; *************** *** 1140,1146 **** && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table ! : NULL)) && ((cv = cvp[off=method+assignshift]) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ --- 1178,1184 ---- && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table ! : (CV **) NULL)) && ((cv = cvp[off=method+assignshift]) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ *************** *** 1233,1239 **** && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c')) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table ! : NULL)) && (cv = cvp[off=method])) { /* Method for right * argument found */ lr=1; --- 1271,1277 ---- && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c')) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table ! : (CV **) NULL)) && (cv = cvp[off=method])) { /* Method for right * argument found */ lr=1; *************** *** 1347,1353 **** PUTBACK; pp_pushmark(); ! EXTEND(sp, notfound + 5); PUSHs(lr>0? right: left); PUSHs(lr>0? left: right); PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no )); --- 1385,1391 ---- PUTBACK; pp_pushmark(); ! EXTEND(SP, notfound + 5); PUSHs(lr>0? right: left); PUSHs(lr>0? left: right); PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no )); *************** *** 1405,1407 **** --- 1443,1446 ---- } } #endif /* OVERLOAD */ + diff -c 'perl5.004_04/gv.h' 'perl5.004_05/gv.h' Index: ./gv.h *** ./gv.h Thu Mar 6 10:46:35 1997 --- ./gv.h Mon Jul 6 17:40:14 1998 *************** *** 127,132 **** #define DM_EGID 0x020 #define DM_DELAY 0x100 ! #define GV_ADD 0x01 ! #define GV_ADDMULTI 0x02 ! #define GV_ADDWARN 0x04 --- 127,137 ---- #define DM_EGID 0x020 #define DM_DELAY 0x100 ! /* ! * symbol creation flags, for use in gv_fetchpv() and perl_get_*v() ! */ ! #define GV_ADD 0x01 /* add, if symbol not already there */ ! #define GV_ADDMULTI 0x02 /* add, pretending it has been added already */ ! #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ ! #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ ! #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ diff -c 'perl5.004_04/h2pl/mksizes' 'perl5.004_05/h2pl/mksizes' Index: ./h2pl/mksizes *** ./h2pl/mksizes Tue Oct 18 12:31:57 1994 --- ./h2pl/mksizes Thu Apr 29 11:03:17 1999 *************** *** 1,4 **** ! #!/usr/local/bin/perl ($iam = $0) =~ s%.*/%%; $tmp = "$iam.$$"; --- 1,4 ---- ! #!/usr/bin/perl ($iam = $0) =~ s%.*/%%; $tmp = "$iam.$$"; diff -c 'perl5.004_04/hints/README.hints' 'perl5.004_05/hints/README.hints' Index: ./hints/README.hints *** ./hints/README.hints Fri Aug 23 14:37:29 1996 --- ./hints/README.hints Fri Sep 25 15:17:29 1998 *************** *** 1,17 **** These files are used by Configure to set things which Configure either can't or doesn't guess properly. Most of these hint files have been tested with at least some version of perl5, but some are still left ! over from perl4. I would appreciate hearing about any problems ! or suggested changes. Hint file naming convention: Each hint file name should have only ! one '.'. (This is for portability to non-unix filesystems.) Names should also fit in <= 14 characters, for portability to older SVR3 systems. File names are of the form $osname_$osvers.sh, with all '.' ! changed to '_', and all characters such as '/' that don't belong in Unix filenames omitted. ! For example, consider SunOS 4.1.3. Configure determines $osname=sunos (all names are converted to lower case) and $osvers=4.1.3. Configure will search for an appropriate hint file in the following order: --- 1,24 ---- + =head1 NAME + + README.hints + + =head1 DESCRIPTION + These files are used by Configure to set things which Configure either can't or doesn't guess properly. Most of these hint files have been tested with at least some version of perl5, but some are still left ! over from perl4. ! ! Please send any problems or suggested changes to perlbug@perl.com. Hint file naming convention: Each hint file name should have only ! one '.'. (This is for portability to non-unix file systems.) Names should also fit in <= 14 characters, for portability to older SVR3 systems. File names are of the form $osname_$osvers.sh, with all '.' ! changed to '_', and all characters (such as '/') that don't belong in Unix filenames omitted. ! For example, consider Sun OS 4.1.3. Configure determines $osname=sunos (all names are converted to lower case) and $osvers=4.1.3. Configure will search for an appropriate hint file in the following order: *************** *** 22,39 **** If you need to create a hint file, please try to use as general a name as possible and include minor version differences inside case or test ! statements. Be sure also to include a default choice. (See ! aix.sh for one example.) That way, if you write a hint file for ! foonix 3.2, it might still work without any changes when foonix 3.3 is ! released. Please also comment carefully on why the different hints are needed. That way, a future version of Configure may be able to automatically ! detect what is needed. A glossary of config.sh variables is in the ! file Porting/Glossary. Have the appropriate amount of fun :-) ! Andy Dougherty doughera@lafcol.lafayette.edu ! Dept. of Physics ! Lafayette College, Easton PA 18042 --- 29,132 ---- If you need to create a hint file, please try to use as general a name as possible and include minor version differences inside case or test ! statements. For example, for IRIX 6.X, we have the following hints ! files: ! ! irix_6_0.sh ! irix_6_1.sh ! irix_6.sh ! ! That is, 6.0 and 6.1 have their own special hints, but 6.2, 6.3, and ! up are all handled by the same irix_6.sh. That way, we don't have to ! make a new hint file every time the IRIX O/S is upgraded. ! ! If you need to test for specific minor version differences in your ! hints file, be sure to include a default choice. (See aix.sh for one ! example.) That way, if you write a hint file for foonix 3.2, it might ! still work without any changes when foonix 3.3 is released. Please also comment carefully on why the different hints are needed. That way, a future version of Configure may be able to automatically ! detect what is needed. ! ! A glossary of config.sh variables is in the file Porting/Glossary. ! ! =head1 Hint file tricks ! ! =head2 Propagating variables to config.sh ! ! Sometimes, you want an extra variable to appear in config.sh. For ! example, if your system can't compile toke.c with the optimizer on, ! you can put ! ! toke_cflags='optimize=""' ! ! at the beginning of a line in your hints file. Configure will then ! extract that variable and place it in your config.sh file. Later, ! while compiling toke.c, the cflags shell script will eval $toke_cflags ! and hence compile toke.c without optimization. ! ! Note that for this to work, the variable you want to propagate must ! appear in the first column of the hint file. It is extracted by ! Configure with a simple sed script, so beware that surrounding case ! statements aren't any help. ! ! By contrast, if you don't want Configure to propagate your temporary ! variable, simply indent it by a leading tab in your hint file. ! ! For example, prior to 5.002, a bug in scope.c led to perl crashing ! when compiled with -O in AIX 4.1.1. The following "obvious" ! workaround in hints/aix.sh wouldn't work as expected: ! ! case "$osvers" in ! 4.1.1) ! scope_cflags='optimize=""' ! ;; ! esac ! ! because Configure doesn't parse the surrounding 'case' statement, it ! just blindly propagates any variable that starts in the first column. ! For this particular case, that's probably harmless anyway. ! ! Three possible fixes are: ! ! =over ! ! =item 1 ! ! Create an aix_4_1_1.sh hint file that contains the scope_cflags ! line and then sources the regular aix hints file for the rest of ! the information. ! ! =item 2 ! ! Do the following trick: ! ! scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac' ! ! Now when $scope_cflags is eval'd by the cflags shell script, the ! case statement is executed. Of course writing scripts to be eval'd is ! tricky, especially if there is complex quoting. Or, ! ! =item 3 ! ! Write directly to Configure's temporary file UU/config.sh. ! You can do this with ! ! case "$osvers" in ! 4.1.1) ! echo "scope_cflags='optimize=\"\"'" >> UU/config.sh ! scope_cflags='optimize=""' ! ;; ! esac ! ! Note you have to both write the definition to the temporary ! UU/config.sh file and set the variable to the appropriate value. ! ! This is sneaky, but it works. ! ! =back Have the appropriate amount of fun :-) ! Andy Dougherty doughera@lafayette.edu diff -c 'perl5.004_04/hints/aix.sh' 'perl5.004_05/hints/aix.sh' Index: ./hints/aix.sh *** ./hints/aix.sh Wed Apr 30 22:50:28 1997 --- ./hints/aix.sh Mon Apr 26 15:47:09 1999 *************** *** 15,21 **** alignbytes=8 ! usemymalloc='n' so="a" dlext="so" --- 15,27 ---- alignbytes=8 ! case "$usemymalloc" in ! '') usemymalloc='n' ;; ! esac ! ! # 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" *************** *** 30,42 **** case "$osvers" in 3*) d_fchmod=undef ! ccflags='-D_ALL_SOURCE' ;; *) # These hints at least work for 4.x, possibly other systems too. ! ccflags='-D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE' case "$cc" in *gcc*) ;; ! *) ccflags="-qmaxmem=8192 $ccflags" ;; esac nm_opt='-B' ;; --- 36,48 ---- case "$osvers" in 3*) d_fchmod=undef ! ccflags="$ccflags -D_ALL_SOURCE" ;; *) # These hints at least work for 4.x, possibly other systems too. ! ccflags="$ccflags -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE" case "$cc" in *gcc*) ;; ! *) ccflags="$ccflags -qmaxmem=8192" ;; esac nm_opt='-B' ;; *************** *** 70,76 **** 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 -b noentry -lc' ;; esac --- 76,82 ---- lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc' ;; *) ! lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' ;; esac diff -c /dev/null 'perl5.004_05/hints/beos.sh' Index: ./hints/beos.sh *** ./hints/beos.sh Wed Dec 31 19:00:00 1969 --- ./hints/beos.sh Fri May 15 11:28:45 1998 *************** *** 0 **** --- 1,52 ---- + # BeOS hints file + # $Id: beos.sh,v 1.1 1998/02/16 03:51:45 dogcow Exp $ + + if [ ! -f ../beos/nm ]; then mwcc -w all -o ../beos/nm ../beos/nm.c; fi + + prefix="/boot/home/config" + + cpp="mwcc -e" + + libpth='/boot/beos/system/lib /boot/home/config/lib' + usrinc='/boot/develop/headers/posix' + locinc='/boot/develop/headers/ /boot/home/config/include' + + libc='/boot/beos/system/lib/libroot.so' + libs=' ' + + d_bcmp='define' + d_bcopy='define' + d_bzero='define' + d_index='define' + #d_htonl='define' # It exists, but much hackery would be required to support. + # a bunch of extra includes would have to be added, and it's only used at + # one place in the non-socket perl code. + + #these are all in libdll.a, which my version of nm doesn't know how to parse. + #if I can get it to both do that, and scan multiple library files, perhaps + #these can be gotten rid of. + + usemymalloc='n' + # Hopefully, Be's malloc knows better than perl's. + + d_link='undef' + dont_use_nlink='define' + # no posix (aka hard) links for us! + + d_syserrlst='undef' + # the array syserrlst[] is useless for the most part. + # large negative numbers really kind of suck in arrays. + + #d_socket='undef' + # Sockets really don't work with the current version of perl and the + # current BeOS sockets; I suspect that a new module a la GSAR's WIN32 port + # will be required. + + sig_name='ZERO HUP INT QUIT ILL CHLD ABRT PIPE FPE KILL STOP BUS CONT TSTP ALRM TERM TTIN TTOU USR1 USR2 WINCH THR' + sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21' + + # Sigh. the parsing of the signal's include file kinda sucks, and produces + # bad results. Easier to just hardcode it. These signals are guaranteed to + # exist and not change in PR2 and above. + + export PATH="$PATH:$PWD/beos" diff -c 'perl5.004_04/hints/bsdos.sh' 'perl5.004_05/hints/bsdos.sh' Index: ./hints/bsdos.sh *** ./hints/bsdos.sh Wed Sep 10 09:34:42 1997 --- ./hints/bsdos.sh Fri Apr 10 10:35:34 1998 *************** *** 3,9 **** # hints file for BSD/OS (adapted from bsd386.sh) # Original by Neil Bowers ; Tue Oct 4 12:01:34 EDT 1994 # Updated by Tony Sanders ; Sat Aug 23 12:47:45 MDT 1997 ! # Added 3.1 with ELF dynamic libraries # SYSV IPC tested Ok so I re-enabled. # # To override the compiler on the command line: --- 3,9 ---- # hints file for BSD/OS (adapted from bsd386.sh) # Original by Neil Bowers ; Tue Oct 4 12:01:34 EDT 1994 # Updated by Tony Sanders ; Sat Aug 23 12:47:45 MDT 1997 ! # Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0) # SYSV IPC tested Ok so I re-enabled. # # To override the compiler on the command line: *************** *** 69,75 **** '') cc='gcc2' ;; esac ;; ! 2.0*|2.1*|3.0*) so='o' # default to GCC 2.X w/shared libraries --- 69,75 ---- '') cc='gcc2' ;; esac ;; ! 2.0*|2.1*|3.0*|3.1*) so='o' # default to GCC 2.X w/shared libraries *************** *** 88,101 **** libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted" libswanted="rpc curses termcap $libswanted" ;; ! 3.1*) ! # ELF dynamic link libraries starting in 3.1 useshrplib='true' so='so' dlext='so' case "$cc" in ! '') cc='cc' # cc is gcc2 in 3.1 cccdlflags="-fPIC" ccdlflags=" " ;; esac --- 88,101 ---- libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted" libswanted="rpc curses termcap $libswanted" ;; ! 4.0*) ! # ELF dynamic link libraries starting in 4.0 (???) useshrplib='true' so='so' dlext='so' case "$cc" in ! '') cc='cc' # cc is gcc2 in 4.0 cccdlflags="-fPIC" ccdlflags=" " ;; esac diff -c 'perl5.004_04/hints/dec_osf.sh' 'perl5.004_05/hints/dec_osf.sh' Index: ./hints/dec_osf.sh *** ./hints/dec_osf.sh Mon Sep 22 15:04:50 1997 --- ./hints/dec_osf.sh Fri Apr 10 10:35:34 1998 *************** *** 102,108 **** *gcc*) optimize='-O3' ;; *) case "$_DEC_cc_style" in ! new) optimize='-O4' ;; old) optimize='-O2 -Olimit 3200' ;; esac ccflags="$ccflags -D_INTRINSICS" --- 102,110 ---- *gcc*) optimize='-O3' ;; *) case "$_DEC_cc_style" in ! new) optimize='-O4' ! ccflags="$ccflags -fprm d -ieee" ! ;; old) optimize='-O2 -Olimit 3200' ;; esac ccflags="$ccflags -D_INTRINSICS" *************** *** 111,116 **** --- 113,129 ---- ;; esac + # Make glibpth agree with the compiler suite. Note that /shlib + # is not here. That's on purpose. Even though that's where libc + # really lives from V4.0 on, the linker (and /sbin/loader) won't + # look there by default. The sharable /sbin utilities were all + # built with "-Wl,-rpath,/shlib" to get around that. This makes + # no attempt to figure out the additional location(s) searched by + # gcc, since not all versions of gcc are easily coerced into + # revealing that information. + glibpth="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc" + glibpth="$glibpth /usr/lib /usr/local/lib /var/shlib" + # dlopen() is in libc libswanted="`echo $libswanted | sed -e 's/ dl / /'`" *************** *** 165,170 **** --- 178,193 ---- esac # + # Make embedding in things like INN and Apache more memory friendly. + # Keep it overridable on the Configure command line, though, so that + # "-Uuseshrplib" prevents this default. + # + + case "$_DEC_cc_style.$useshrplib" in + new.) useshrplib="$define" ;; + esac + + # # Unset temporary variables no more needed. # *************** *** 173,178 **** --- 196,215 ---- # # History: + # + # perl5.004_05: + # + # 19-Dec-1997 Spider Boardman + # + # * Newer Digial UNIX compilers enforce signaling for NaN without + # -ieee. Added -fprm d at the same time since it's friendlier for + # embedding. + # + # * Fixed the library search path to match cc, ld, and /sbin/loader. + # + # * Default to building -Duseshrplib on newer systems. -Uuseshrplib + # still overrides. + # # # perl5.004_04: # diff -c 'perl5.004_04/hints/freebsd.sh' 'perl5.004_05/hints/freebsd.sh' Index: ./hints/freebsd.sh *** ./hints/freebsd.sh Wed Apr 23 19:01:37 1997 --- ./hints/freebsd.sh Tue Apr 13 00:38:09 1999 *************** *** 17,22 **** --- 17,26 ---- # Additional 2.2 defines from # Mark Murray # Date: Wed, 6 Nov 1996 09:44:58 +0200 (MET) + # + # 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 *************** *** 89,97 **** # out here to avoid duplicating them everywhere. case "$osvers" in 0.*|1.0*) ;; ! *) cccdlflags='-DPIC -fpic' ! lddlflags="-Bshareable $lddlflags" ! ;; esac # Avoid telldir prototype conflict in pp_sys.c (FreeBSD uses const DIR *) --- 93,119 ---- # out here to avoid duplicating them everywhere. case "$osvers" in 0.*|1.0*) ;; ! ! 3.*|4.0*) ! objformat=`/usr/bin/objformat` ! if [ x$objformat = xelf ]; then ! libpth="/usr/lib /usr/local/lib" ! glibpth="/usr/lib /usr/local/lib" ! ldflags="-Wl,-E " ! lddlflags="-shared " ! else ! if [ -e /usr/lib/aout ]; then ! libpth="/usr/lib/aout /usr/local/lib /usr/lib" ! glibpth="/usr/lib/aout /usr/local/lib /usr/lib" ! fi ! lddlflags='-Bshareable' ! fi ! cccdlflags='-DPIC -fpic' ! ;; ! ! *) cccdlflags='-DPIC -fpic' ! lddlflags="-Bshareable $lddlflags" ! ;; esac # Avoid telldir prototype conflict in pp_sys.c (FreeBSD uses const DIR *) *************** *** 108,110 **** --- 130,159 ---- EOM + # 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[ ]+PERL_VERSION/ {print $3}' $src/patchlevel.h` + subversion=`awk '/define[ ]+PERL_SUBVERSION/ {print $3}' $src/patchlevel.h` + else + patchlevel=0 + subversion=0 + fi + libperl="libperl.so.$patchlevel.$subversion" + unset patchlevel + unset subversion + ;; + esac diff -c 'perl5.004_04/hints/hpux.sh' 'perl5.004_05/hints/hpux.sh' Index: ./hints/hpux.sh *** ./hints/hpux.sh Mon Aug 18 14:15:02 1997 --- ./hints/hpux.sh Fri Oct 9 11:58:53 1998 *************** *** 43,50 **** # "ext.libs" file which is *probably* messing up the order. Often, # you can replace ext.libs with an empty file to fix the problem. # ! # If you get a message about "too much defining", you might have to ! # add the following to your ccflags: '-Wp,-H256000' #-------------------------------------------------------------------- # Turn on the _HPUX_SOURCE flag to get many of the HP add-ons --- 43,52 ---- # "ext.libs" file which is *probably* messing up the order. Often, # you can replace ext.libs with an empty file to fix the problem. # ! # If you get a message about "too much defining", as may happen ! # in HPUX < 10, you might have to append a single entry to your ! # ccflags: '-Wp,-H256000' ! # NOTE: This is a single entry (-W takes the argument 'p,-H256000'). #-------------------------------------------------------------------- # Turn on the _HPUX_SOURCE flag to get many of the HP add-ons *************** *** 82,87 **** --- 84,99 ---- 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". *************** *** 174,176 **** --- 186,189 ---- # assembler of the form: # (warning) Use of GR3 when frame >= 8192 may cause conflict. # These warnings are harmless and can be safely ignored. + diff -c 'perl5.004_04/hints/irix_5.sh' 'perl5.004_05/hints/irix_5.sh' Index: ./hints/irix_5.sh *** ./hints/irix_5.sh Mon Jul 8 10:05:57 1996 --- ./hints/irix_5.sh Thu Apr 23 15:49:22 1998 *************** *** 12,18 **** case "$cc" in *gcc*) ccflags="$ccflags -D_BSD_TYPES" ;; ! *) ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000" ;; esac lddlflags="-shared" --- 12,18 ---- case "$cc" in *gcc*) ccflags="$ccflags -D_BSD_TYPES" ;; ! *) ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 4000" ;; esac lddlflags="-shared" diff -c 'perl5.004_04/hints/irix_6.sh' 'perl5.004_05/hints/irix_6.sh' Index: ./hints/irix_6.sh *** ./hints/irix_6.sh Tue Sep 9 13:01:05 1997 --- ./hints/irix_6.sh Thu Dec 3 08:05:18 1998 *************** *** 20,25 **** --- 20,27 ---- # Tweaked by Chip Salzenberg on 5/13/97 # - don't assume 'cc -n32' if the n32 libm.so is missing + # gcc-enabled by Kurt Starsinic on 12/1/1998 + # Use sh Configure -Dcc='cc -n32' to try compiling with -n32. # or -Dcc='cc -n32 -mips3' (or -mips4) to force (non)portability # Don't bother with -n32 unless you have the 7.1 or later compilers. *************** *** 40,67 **** case "$cc" in *"cc -n32"*) # Check for which version of the compiler we're running case "`$cc -version 2>&1`" in *7.0*) # Mongoose 7.0 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0" ! optimize='none' ;; ! *7.*) # Mongoose 7.1+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" optimize='-O3' ;; *6.2*) # Ragnarok 6.2 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184" ! optimize='none' ;; *) # Be safe and not optimize ! ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" optimize='none' ;; esac ! ld=ld ! ldflags=' -L/usr/local/lib -L/usr/lib32 -L/lib32' cccdlflags=' ' # From: David Billinghurst # If you get complaints about so_locations then change the following --- 42,106 ---- case "$cc" in *"cc -n32"*) + # Perl 5.004_04/5.004_57 introduced new qsort code into pp_ctl.c + # that makes IRIX cc prior to 7.2.1 to emit bad code. + # so some serious hackery follows to set pp_ctl flags correctly. + # Check for which version of the compiler we're running case "`$cc -version 2>&1`" in *7.0*) # Mongoose 7.0 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0" ! optimize='none' ;; ! *7.1*|*7.2|*7.20) # Mongoose 7.1+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" optimize='-O3' + # This is a temporary fix for 5.005. + # Leave pp_ctl_cflags line at left margin for Configure. See + # hints/README.hints, especially the section + # =head2 Propagating variables to config.sh + pp_ctl_cflags='optimize=-O' ;; + *7.*) # Mongoose 7.2.1+ + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=ON" + optimize='-O3' + ;; *6.2*) # Ragnarok 6.2 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184" ! optimize='none' ;; *) # Be safe and not optimize ! ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" optimize='none' ;; esac ! # this is to accommodate the 'modules' capability of the ! # 7.2 MIPSPro compilers, which allows for the compilers to be installed ! # in a nondefault location. Almost everything works as expected, but ! # /usr/include isn't caught properly. Hence see the /usr/include/pthread.h ! # change below to include TOOLROOT (a modules environment variable), ! # and the following code. Additional ! # code to accommodate the 'modules' environment should probably be added ! # here if possible, or be inserted as a ${TOOLROOT} reference before ! # absolute paths (again, see the pthread.h change below). ! # -- krishna@sgi.com, 8/23/98 ! ! if [ "X${TOOLROOT}" != "X" ]; then ! # we cant set cppflags because it gets overwritten ! # we dont actually need $TOOLROOT/usr/include on the cc line cuz the ! # modules functionality already includes it but ! # XXX - how do I change cppflags in the hints file? ! ccflags="$ccflags -I${TOOLROOT}/usr/include" ! usrinc="${TOOLROOT}/usr/include" ! fi ! ! ld=$cc ! # perl's malloc can return improperly aligned buffer ! # usemymalloc='undef' ! malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' ! # NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker ! ldflags=' -L/usr/local/lib32 -L/usr/local/lib' cccdlflags=' ' # From: David Billinghurst # If you get complaints about so_locations then change the following *************** *** 73,78 **** --- 112,122 ---- nm_opt='-p' nm_so_opt='-p' ;; + *gcc*) + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -D_POSIX_C_SOURCE" + optimize="-O3" + usenm='undef' + ;; *) # this is needed to force the old-32 paths # since the system default can be changed. *************** *** 84,90 **** # This should be a Configure thing, but not for now... pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' ! # We don't want these libraries. Anyone know why? set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` shift libswanted="$*" --- 128,136 ---- # This should be a Configure thing, but not for now... pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' ! # We don't want these libraries. ! # Socket networking is in libc, these are not installed by default, ! # and just slow perl down. (scotth@sgi.com) set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` shift libswanted="$*" *************** *** 92,98 **** # I have conflicting reports about the sun, crypt, bsd, and PW # libraries on Irix 6.2. # ! # One user rerports: # Don't need sun crypt bsd PW under 6.2. You *may* need to link # with these if you want to run perl built under 6.2 on a 5.3 machine # (I haven't checked) --- 138,144 ---- # I have conflicting reports about the sun, crypt, bsd, and PW # libraries on Irix 6.2. # ! # One user reports: # Don't need sun crypt bsd PW under 6.2. You *may* need to link # with these if you want to run perl built under 6.2 on a 5.3 machine # (I haven't checked) *************** *** 107,114 **** # you need is in libc. You do also need '-lbsd' if you choose not # to use the -D_BSD_* defines. Note that as of 6.2 the only # difference between '-lmalloc' and '-lc' malloc is the debugging ! # and control calls. -- scotth@sgi.com ! set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /'` shift libswanted="$*" --- 153,161 ---- # you need is in libc. You do also need '-lbsd' if you choose not # to use the -D_BSD_* defines. Note that as of 6.2 the only # difference between '-lmalloc' and '-lc' malloc is the debugging ! # and control calls, which aren't used by perl. -- scotth@sgi.com ! set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /' -e 's/ malloc / /'` shift libswanted="$*" + diff -c 'perl5.004_04/hints/linux.sh' 'perl5.004_05/hints/linux.sh' Index: ./hints/linux.sh *** ./hints/linux.sh Thu Oct 9 16:43:33 1997 --- ./hints/linux.sh Tue Apr 13 00:36:27 1999 *************** *** 18,23 **** --- 18,44 ---- # No version of Linux supports setuid scripts. d_suidsafe='undef' + # Debian and Red Hat, and perhaps other vendors, provide both runtime and + # development packages for some libraries. The runtime packages contain shared + # libraries with version information in their names (e.g., libgdbm.so.1.7.3); + # the development packages supplement this with versionless shared libraries + # (e.g., libgdbm.so). + # + # If you want to link against such a library, you must install the development + # version of the package. + # + # These packages use a -dev naming convention in both Debian and Red Hat: + # libgdbmg1 (non-development version of GNU libc 2-linked GDBM library) + # libgdbmg1-dev (development version of GNU libc 2-linked GDBM library) + # So make sure that for any libraries you wish to link Perl with under + # Debian or Red Hat you have the -dev packages installed. + # + # Some operating systems (e.g., Solaris 2.6) will link to a versioned shared + # library implicitly. For example, on Solaris, `ld foo.o -lgdbm' will find an + # appropriate version of libgdbm, if one is available; Linux, however, doesn't + # do the implicit mapping. + ignore_versioned_solibs='y' + # perl goes into the /usr tree. See the Filesystem Standard # available via anonymous FTP at tsx-11.mit.edu in # /pub/linux/docs/linux-standards/fsstnd. *************** *** 29,47 **** # gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool. ccflags="-Dbool=char -DHAS_BOOL $ccflags" - # libc6, aka glibc2, seems to need STRUCT_TM_HASZONE defined. - # Thanks to Bart Schuller - # See Message-ID: <19971009002636.50729@tanglefoot> - # This is currently commented out for maintenance releases - # but should probably be uncommented for 5.005 or after - # more widespread testing. - #POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"' - # BSD compatability library no longer needed ! set `echo X "$libswanted "| sed -e 's/ bsd / /'` shift libswanted="$*" # Configure may fail to find lstat() since it's a static/inline # function in . d_lstat=define --- 50,74 ---- # gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool. ccflags="-Dbool=char -DHAS_BOOL $ccflags" # BSD compatability library no longer needed ! # 'kaffe' has a /usr/lib/libnet.so which is not at all relevent for perl. ! set `echo X "$libswanted "| sed -e 's/ bsd / /' -e 's/ net / /'` shift libswanted="$*" + # If you have glibc, then report the version for ./myconfig bug reporting. + # (Configure doesn't need to know the specific version since it just uses + # gcc to load the library for all tests.) + # Is this sufficiently robust for libc5 systems as well as + # glibc-2.1.x systems? + # We don't use __GLIBC__ and __GLIBC_MINOR__ because they + # are insufficiently precise to distinguish things like + # libc-2.0.6 and libc-2.0.7. + if test -L /lib/libc.so.6; then + libc=`ls -l /lib/libc.so.6 | awk '{print $NF}'` + libc=/lib/$libc + fi + # Configure may fail to find lstat() since it's a static/inline # function in . d_lstat=define *************** *** 194,204 **** # Shimpei Yamashita # Message-Id: <33EF1634.B36B6500@pobox.com> # ! # MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other ! # linuces, needs special flags passed in order for dynamic loading to work. ! # instead of the recommended: ! # ccdlflags='-rdynamic' ! # ! # it should be: ! # ccdlflags='-Wl,-E' ! --- 221,232 ---- # Shimpei Yamashita # Message-Id: <33EF1634.B36B6500@pobox.com> # ! # Date: Thu, 16 Oct 1997 ! # From: Chris Nandor ! # ! # MkLinux for PPC needs special flags passed in order for dynamic ! # loading to work. NOTE: Older versions of MkLinux might not ! # support dynamic loading at all. ! case "`uname -r | sed 's/^[0-9.-]*//'``arch`" in ! 'osfmach3ppc') ccdlflags='-Wl,-E' ;; ! esac diff -c 'perl5.004_04/hints/machten.sh' 'perl5.004_05/hints/machten.sh' Index: ./hints/machten.sh *** ./hints/machten.sh Wed Oct 15 06:25:51 1997 --- ./hints/machten.sh Wed Sep 23 19:47:32 1998 *************** *** 13,18 **** --- 13,29 ---- # Martijn Koster # Richard Yeh # + # For now, explicitly disable dynamic loading -- MT 4.1.1 has it, + # but these hints do not yet support it. + # Define NOTEDEF_MACHTEN to undo gratuitous Tenon hack to signal.h. + # -- Dominic Dunlop 9800802 + # Use vfork and perl's malloc by default + # -- Dominic Dunlop 980630 + # Raise perl's stack size again; cut down reg_infty; document + # -- Dominic Dunlop 980619 + # Use of semctl() can crash system: disable -- Dominic Dunlop 980506 + # Raise stack size further; slight tweaks to accomodate MT 4.1 + # -- Dominic Dunlop 980211 # Raise perl's stack size -- Dominic Dunlop 970922 # Reinstate sigsetjmp iff version is 4.0.3 or greater; use nm # (assumes Configure change); prune libswanted -- Dominic Dunlop 970113 *************** *** 23,43 **** # # Comments, questions, and improvements welcome! # ! # MachTen 4.X does support dynamic loading, but perl doesn't # know how to use it yet. # Power MachTen is a real memory system and its standard malloc # has been optimized for this. Using this malloc instead of Perl's ! # malloc may result in significant memory savings. ! usemymalloc='false' # Make symbol table listings les voluminous nmopts=-gp ! # Increase perl's stack size. Without this, lib/complex.t crashes out. ! # Particularly perverse programs may require that perl has an even larger ! # stack allocation than that specified here. (See man setstackspace ) ! ldflags='-Xlstack=0x014000' # Install in /usr/local by default prefix='/usr/local' --- 34,140 ---- # # Comments, questions, and improvements welcome! # ! # MachTen 4.1.1 does support dynamic loading, but perl doesn't # know how to use it yet. + usedl=${usedl:-undef} + + # MachTen 4.1.1 may have an unhelpful hack in /usr/include/signal.h. + # Undo it if so. + if grep NOTDEF_MACHTEN /usr/include/signal.h > /dev/null + then + ccflags="$ccflags -DNOTDEF_MACHTEN" + fi # Power MachTen is a real memory system and its standard malloc # has been optimized for this. Using this malloc instead of Perl's ! # malloc may result in significant memory savings. In particular, ! # unlike most UNIX memory allocation subsystems, MachTen's free() ! # really does return unneeded process data memory to the system. ! # However, MachTen's malloc() is woefully slow -- maybe 100 times ! # slower than perl's own, so perl's own is usually the better ! # choice. In order to use perl's malloc(), the sbrk() system call ! # must be simulated using MachTen's malloc(). See malloc.c for ! # precise details of how this is achieved. Improvements to perl's ! # malloc() in versions greater than 5.004_50 currently crash MachTen, ! # and so are disabled by -DPLAIN_MALLOC and -DNO_FANCY_MALLOC. ! usemymalloc=${usemymalloc:-y} ! ! # Do not wrap the following long line ! malloc_cflags='ccflags="$ccflags -DPLAIN_MALLOC -DNO_FANCY_MALLOC -DUSE_PERL_SBRK"' ! ! # Note that an empty malloc_cflags appears in config.sh if perl's ! # malloc() is not used. This is harmless. ! case "$usemymalloc" in ! n) unset malloc_cflags;; ! *) ccflags="$ccflags -DHIDEMYMALLOC" ! esac ! ! # When MachTen does a fork(), it immediately copies the whole of ! # the parent process' data space for the child. This can be ! # expensive. Using vfork() where appropriate avoids this cost. ! d_vfork=${d_vfork:-define} ! ! # Specify a high level of optimization (-O3 wouldn't do much more) ! optimize=${optimize:--O2 -fomit-frame-pointer} # Make symbol table listings les voluminous nmopts=-gp ! # Set reg_infty -- the maximum allowable number of repeats in regular ! # expressions such as /a{1,$max_repeats}/, and the maximum number of ! # times /a*/ will match. Setting this too high without having a stack ! # large enough to accommodate deep recursion in the regular expression ! # engine allows perl to crash your Mac due to stack overrun if it ! # encounters a pathological regular expression. The default is a ! # compromise between capability and required stack size (see below). ! # You may override the default value from the Configure command-line ! # like this: ! # ! # Configure -Dreg_infty=16368 ... ! ! reg_infty=${reg_infty:-2047} ! ! # If you want to have many perl processes active simultaneously -- ! # processing CGI forms -- for example, you should opt for a small stack. ! # For safety, you should set reg_infty no larger than the corresponding ! # value given in this table: ! # ! # Stack size reg_infty value supported ! # ---------- ------------------------- ! # 128k 2**8-1 (256) ! # 256k 2**9-1 (511) ! # 512k 2**10-1 (1023) ! # 1M 2**11-1 (2047) ! # ... ! # 16M 2**15-1 (32767) (perl's default value) ! ! # This script selects a safe stack size based on the value of reg_infty ! # specified above. However, you may choose to take a risk and set ! # stack size lower: pathological regular expressions are rare in real-world ! # programs. But be aware that, if perl does encounter one, it WILL ! # crash your system. Do not set stack size lower than 96k unless ! # you want perl's installation tests ( make test ) to crash your system. ! # ! # You may override the default value from the Configure command-line ! # by specifying the required size in kilobytes like this: ! # ! # Configure -Dstack_size=96 ! ! if [ "X$stack_size" = 'X' ] ! then ! stack_size=128 ! X=`expr $reg_infty / 256` ! ! while [ $X -gt 0 ] ! do ! X=`expr $X / 2` ! stack_size=`expr $stack_size \* 2` ! done ! X=`expr $stack_size \* 1024` ! fi ! ! ldflags="$ldflags -Xlstack=$X" ! ccflags="$ccflags -DREG_INFTY=$reg_infty" # Install in /usr/local by default prefix='/usr/local' *************** *** 51,56 **** --- 148,156 ---- # friends. Use setjmp and friends instead. expr "$osvers" \< "4.0.3" > /dev/null && d_sigsetjmp='undef' + # semctl(.., .., IPC_STATUS, ..) hangs system: say we don't have semctl() + d_semctl='undef' + # Get rid of some extra libs which it takes Configure a tediously # long time never to find on MachTen set `echo X "$libswanted "|sed -e 's/ net / /' -e 's/ socket / /' \ *************** *** 61,66 **** --- 161,168 ---- shift libswanted="$*" + # While link counts on MachTen 4.1's fast file systems work correctly, + # on Macintosh Heirarchical File Systems, (and on HFS+) # MachTen always reports ony two links to directories, even if they # contain subdirectories. Consequently, we use this variable to stop # File::Find using the link count to determine whether there are *************** *** 69,88 **** # Propagating recommended variable dont_use_nlink dont_use_nlink=define ! cat <<'EOM' >&4 ! Tests ! io/fs test 4 and ! op/stat test 3 ! may fail since MachTen does not return a useful nlinks field to stat ! on directories. At the end of Configure, you will see a harmless message Hmm...You had some extra variables I don't know about...I'll try to keep 'em. Propagating recommended variable dont_use_nlink Propagating recommended variable nmopts Read the File::Find documentation for more information about dont_use_nlink EOM ! test -r ./broken-db.msg && . ./broken-db.msg --- 171,217 ---- # Propagating recommended variable dont_use_nlink dont_use_nlink=define ! cat <&4 ! During Configure, you may see the message ! ! *** WHOA THERE!!! *** ! The recommended value for \$d_semctl on this machine was "undef"! ! Keep the recommended value? [y] ! ! Select the default answer: semctl() is buggy, and perl should be built ! without it. ! ! Similarly, when you see ! ! *** WHOA THERE!!! *** ! The recommended value for \$d_vfork on this machine was "define"! ! Keep the recommended value? [y] ! ! select the default answer: vfork() works, and avoids expensive data ! copying. At the end of Configure, you will see a harmless message Hmm...You had some extra variables I don't know about...I'll try to keep 'em. Propagating recommended variable dont_use_nlink Propagating recommended variable nmopts + Propagating recommended variable malloc_cflags... + Propagating recommended variable reg_infty Read the File::Find documentation for more information about dont_use_nlink + Your perl will be built with a stack size of ${stack_size}k and a regular + expression repeat count limit of $reg_infty. If you want alternative + values, see the file hints/machten.sh for advice on how to change them. + + Tests + io/fs test 4 and + op/stat test 3 + may fail since MachTen may not return a useful nlinks field to stat + on directories. + EOM ! expr "$osvers" \< "4.1" >/dev/null && test -r ./broken-db.msg && \ ! . ./broken-db.msg ! ! unset stack_size X diff -c 'perl5.004_04/hints/netbsd.sh' 'perl5.004_05/hints/netbsd.sh' Index: ./hints/netbsd.sh *** ./hints/netbsd.sh Thu May 8 11:52:59 1997 --- ./hints/netbsd.sh Tue Apr 13 00:18:04 1999 *************** *** 1,12 **** # hints/netbsd.sh # ! # talk to mrg@eterna.com.au if you want to change this file. # # netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o, # so Configure doesn't find them (unless you abandon the nm scan). # this should be *just* 0.9 below as netbsd 0.9a was the first to ! # introduce shared libraries. however, they don't work/build on ! # pmax, powerpc and alpha ports correctly, yet. case "$archname" in '') --- 1,11 ---- # hints/netbsd.sh # ! # talk to packages@netbsd.org if you want to change this file. # # netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o, # so Configure doesn't find them (unless you abandon the nm scan). # this should be *just* 0.9 below as netbsd 0.9a was the first to ! # introduce shared libraries. case "$archname" in '') *************** *** 19,44 **** usedl="$undef" ;; *) ! case `uname -m` in ! alpha|powerpc|pmax) d_dlopen=$undef ! ;; ! # this doesn't work (yet). ! # alpha) ! # d_dlopen=$define ! # d_dlerror=$define ! # cccdlflags="-DPIC -fPIC $cccdlflags" ! # lddlflags="-shared $lddlflags" ! # ;; ! *) d_dlopen=$define d_dlerror=$define # we use -fPIC here because -fpic is *NOT* enough for some of the # extensions like Tk on some netbsd platforms (the sparc is one) cccdlflags="-DPIC -fPIC $cccdlflags" lddlflags="-Bforcearchive -Bshareable $lddlflags" ! ;; ! esac ;; esac --- 18,43 ---- usedl="$undef" ;; *) ! if [ -f /usr/libexec/ld.elf_so ]; then ! d_dlopen=$define ! d_dlerror=$define ! ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags" ! cccdlflags="-DPIC -fPIC $cccdlflags" ! lddlflags="--whole-archive -shared $lddlflags" ! elif [ "`uname -m`" = "pmax" ]; then ! # NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work. d_dlopen=$undef ! elif [ -f /usr/libexec/ld.so ]; then d_dlopen=$define d_dlerror=$define + ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags" # we use -fPIC here because -fpic is *NOT* enough for some of the # extensions like Tk on some netbsd platforms (the sparc is one) cccdlflags="-DPIC -fPIC $cccdlflags" lddlflags="-Bforcearchive -Bshareable $lddlflags" ! else ! d_dlopen=$undef ! fi ;; esac *************** *** 47,61 **** # way to make perl call setuid() or setgid(). if they aren't, then # ($<, $>) = ($u, $u); will work (same for $(/$)). this is because # you can not change the real userid of a process under 4.4BSD. ! # netbsd fixed this in 1.2A. case "$osvers" in ! 0.9*|1.0*|1.1*|1.2_*|1.2|1.2.*) d_setregid="$undef" d_setreuid="$undef" - d_setrgid="$undef" - d_setruid="$undef" ;; esac # Avoid telldir prototype conflict in pp_sys.c (NetBSD uses const DIR *) # Configure should test for this. Volunteers? --- 46,70 ---- # way to make perl call setuid() or setgid(). if they aren't, then # ($<, $>) = ($u, $u); will work (same for $(/$)). this is because # you can not change the real userid of a process under 4.4BSD. ! # netbsd fixed this in 1.3.2. case "$osvers" in ! 0.9*|1.[012]*|1.3|1.3.1) d_setregid="$undef" d_setreuid="$undef" ;; esac + + # These are obsolete in any netbsd. + d_setrgid="$undef" + d_setruid="$undef" + + # there's no problem with vfork. + case "$usevfork" in + '') usevfork=true ;; + esac + + # Pre-empt the /usr/bin/perl question of installperl. + installusrbinperl='undef' # Avoid telldir prototype conflict in pp_sys.c (NetBSD uses const DIR *) # Configure should test for this. Volunteers? diff -c /dev/null 'perl5.004_05/hints/openbsd.sh' Index: ./hints/openbsd.sh *** ./hints/openbsd.sh Wed Dec 31 19:00:00 1969 --- ./hints/openbsd.sh Mon Apr 26 15:48:58 1999 *************** *** 0 **** --- 1,64 ---- + # hints/openbsd.sh + # + # hints file for OpenBSD; Todd Miller + # Edited to allow Configure command-line overrides by + # Andy Dougherty + # + + # OpenBSD has a better malloc than perl... + test "$usemymalloc" || usemymalloc='n' + + # Currently, vfork(2) is not a real win over fork(2) but this will + # change in a future release. + usevfork='true' + + # setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions + # in 4.4BSD. Configure will find these but they are just emulated + # and do not have the same semantics as in 4.3BSD. + d_setregid="$undef" + d_setreuid="$undef" + d_setrgid="$undef" + d_setruid="$undef" + + # + # Not all platforms support shared libs... + # + case `uname -m` in + alpha|mips|powerpc|vax) + d_dlopen="$undef" + ;; + *) + d_dlopen="$define" + d_dlerror="$define" + # we use -fPIC here because -fpic is *NOT* enough for some of the + # extensions like Tk on some OpenBSD platforms (ie: sparc) + cccdlflags="-DPIC -fPIC $cccdlflags" + lddlflags="-Bforcearchive -Bshareable $lddlflags" + ;; + esac + + # + # Tweaks for various versions of OpenBSD + # + case "$osvers" in + 2.5) + # OpenBSD 2.5 has broken odbm support + i_dbm="$undef" + ;; + esac + + # OpenBSD doesn't need libcrypt but many folks keep a stub lib + # around for old NetBSD binaries. + libswanted=`echo $libswanted | sed 's/ crypt / /'` + + # Avoid telldir prototype conflict in pp_sys.c (OpenBSD uses const DIR *) + pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' + + # Configure can't figure this out non-interactively + d_suidsafe="$define" + + # cc is gcc so we can do better than -O + # Allow a command-line override, such as -Doptimize=-g + test "$optimize" || optimize='-O2' + + # end diff -c 'perl5.004_04/hints/os2.sh' 'perl5.004_05/hints/os2.sh' Index: ./hints/os2.sh *** ./hints/os2.sh Tue Oct 14 08:47:46 1997 --- ./hints/os2.sh Fri Apr 10 10:35:34 1998 *************** *** 23,28 **** --- 23,36 ---- startsh="#!$sh" cc='gcc' + # Make denser object files and DLL + case "X$optimize" in + X) + optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s" + ld_dll_optimize="-s" + ;; + esac + # Get some standard things (indented to avoid putting in config.sh): oifs="$IFS" IFS=" ;" *************** *** 104,114 **** aout_lib_ext='.a' aout_ar='ar' aout_plibext='.a' ! aout_lddlflags='-Zdll' if [ $emxcrtrev -ge 50 ]; then ! aout_ldflags='-Zexe -Zsmall-conv' else ! aout_ldflags='-Zexe' fi # To get into config.sh: --- 112,122 ---- aout_lib_ext='.a' aout_ar='ar' aout_plibext='.a' ! aout_lddlflags="-Zdll $ld_dll_optimize" if [ $emxcrtrev -ge 50 ]; then ! aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000' else ! aout_ldflags='-Zexe -Zstack 32000' fi # To get into config.sh: *************** *** 152,158 **** else d_fork='undef' fi ! lddlflags='-Zdll -Zomf -Zmt -Zcrtdll' # Recursive regmatch may eat 2.5M of stack alone. ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' if [ $emxcrtrev -ge 50 ]; then --- 160,166 ---- else d_fork='undef' fi ! lddlflags="-Zdll -Zomf -Zmt -Zcrtdll $ld_dll_optimize" # Recursive regmatch may eat 2.5M of stack alone. ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' if [ $emxcrtrev -ge 50 ]; then *************** *** 237,249 **** d_getprior='define' d_setprior='define' - - # Make denser object files and DLL - case "X$optimize" in - X) - optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s" - ;; - esac # The next two are commented. pdksh handles #!, extproc gives no path part. # sharpbang='extproc ' --- 245,250 ---- diff -c 'perl5.004_04/hints/powerux.sh' 'perl5.004_05/hints/powerux.sh' Index: ./hints/powerux.sh *** ./hints/powerux.sh Mon Jan 20 12:08:42 1997 --- ./hints/powerux.sh Fri Jun 19 14:47:57 1998 *************** *** 75,80 **** --- 75,90 ---- # useshrplib='false' + # PowerMAX OS has support for a few different kinds of filesystems. The + # newer "xfs" filesystem does *not* report a reasonable value in the + # 'nlinks' field of stat() info for directories (in fact, it is always 1). + # Since xfs is the only filesystem which supports partitions bigger than + # 2gig and you can't hardly buy a disk that small anymore, xfs is coming in + # to greater and greater use, so we pretty much have no choice but to + # abandon all hope that number of links will mean anything. + # + dont_use_nlink=define + # Misc other flags that might be able to change, but I know these work right. # d_suidsafe='define' diff -c 'perl5.004_04/hints/qnx.sh' 'perl5.004_05/hints/qnx.sh' Index: ./hints/qnx.sh *** ./hints/qnx.sh Tue Oct 14 08:53:40 1997 --- ./hints/qnx.sh Fri Apr 10 10:35:34 1998 *************** *** 36,53 **** # Resolved in 970211 Beta # lib/io_udp.t test hangs because of a bug in getsockname(). # Fixed in latest BETA socket3r.lib - # If there is a softlink in your path, Findbin will fail. - # This is a documented feature of perl's getpwd(). # There is currently no support for dynamically linked # libraries. - # op/magic.t failure due to a feature of QNX which rewrites script - # names before they are executed. I think you'll find that if - # you cd `fullpath -t` before doing the make, the test will pass. - #---------------------------------------------------------------- - # At present, all QNX systems are equivalent architectures, - # so it might be reasonable to call archname=qnx rather than - # making an unnecessary distinction between AT-qnx and PCI-qnx, - # for example. #---------------------------------------------------------------- # These hints were submitted by: # Norton T. Allen --- 36,43 ---- *************** *** 60,65 **** --- 50,63 ---- echo "" echo "Some tests may fail. Please read the hints/qnx.sh file." echo "" + + #---------------------------------------------------------------- + # At present, all QNX systems are equivalent architectures, + # so it is reasonable to call archname=x86-qnx rather than + # making an unnecessary distinction between AT-qnx and PCI-qnx, + # for example. + #---------------------------------------------------------------- + archname='x86-qnx' #---------------------------------------------------------------- # QNX doesn't come with a csh and the ports of tcsh I've used diff -c 'perl5.004_04/hints/sco.sh' 'perl5.004_05/hints/sco.sh' Index: ./hints/sco.sh *** ./hints/sco.sh Tue Aug 12 09:00:39 1997 --- ./hints/sco.sh Sun Nov 22 11:36:13 1998 *************** *** 1,16 **** ! # 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. # figure out what SCO version we are. The output of uname -X is # something like: --- 1,15 ---- ! # sco.sh # Courtesy of Joel Rosi-Schwartz # Additional SCO version info from # Peter Wolfe ! # Last revised # Fri Jul 19 14:54:25 EDT 1996 ! # and again Tue Sep 29 16:37:25 EDT 1998 ! # by Andy Dougherty ! # To use gcc, use sh Configure -Dcc=gcc ! # To use icc, use sh Configure -Dcc=icc # figure out what SCO version we are. The output of uname -X is # something like: *************** *** 18,101 **** # Node = xxxxx # Release = 3.2v5.0.0 # KernelID = 95/08/08 ! # Machine = Pentium # BusType = ISA # Serial = xxxxx # Users = 5-user # OEM# = 0 # Origin# = 1 ! # NumCPU = 1 ! ! # Use /bin/uname (because Gnu may be first on the path and # it does not support -X) to figure out what SCO version we are: case `/bin/uname -X | egrep '^Release'` in ! *3.2v4.*) scorls=3 ;; # I don't know why this is 3 instead of 4 :-) *3.2v5.*) scorls=5 ;; ! *) scorls=3 ;; # this probabaly shouldn't happen esac # Try to use libintl.a since it has strcoll and strxfrm libswanted="intl $libswanted" # Try to use libdbm.nfs.a since it has dbmclose. ! # if test -f /usr/lib/libdbm.nfs.a ; then libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'` fi - set X $libswanted - shift - libswanted="$*" # We don't want Xenix cross-development libraries glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'` xlibpth='' case "$cc" in ! *gcc*) ccflags="$ccflags -U M_XENIX" ! optimize="$optimize -O2" ;; ! scocc) ;; ! ! # On SCO 3.2v5 both cc and icc can build dynamic load, but cc core ! # dumps if optimised, so I am only setting this up for icc. ! # It is possible that some 3.2v4.2 system have icc, I seem to ! # recall it was available as a seperate product but I have no ! # knowledge if it can do dynamic loading and if so how. ! # Joel Rosi-Schwartz ! icc)# Apparently, SCO's cc gives rather verbose warnings ! # Set -w0 to turn them off. case $scorls in ! 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;; ! 5) ccflags="$ccflags -belf -w0 -U M_XENIX" ! optimize="-O1" # -g -O1 will not work ! # optimize="-O0" may be needed for pack test to pass. ! lddlflags='-G -L/usr/local/lib' ! ldflags=' -W l,-Bexport -L/usr/local/lib' ! dlext='so' ! dlsrc='dl_dlopen.xs' ! usedl='define' ! ;; esac - ;; - - *) # Apparently, miniperl core dumps if -O is used. case "$optimize" in ! '') optimize=none ;; ! esac ! # Apparently, SCO's cc gives rather verbose warnings ! # Set -w0 to turn them off. ! case $scorls in ! 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;; ! 5) ccflags="$ccflags -w0 -U M_XENIX -DPERL_SCO5" ;; esac ;; esac ! i_varargs=undef # I have received one report that nm extraction doesn't work if you're # using the scocc compiler. This system had the following 'myconfig' # uname='xxx xxx 3.2 2 i386 ' # cc='scocc', optimize='-O' ! usenm='false' # If you want to use nm, you'll probably have to use nm -p. The # following does that for you: --- 17,110 ---- # Node = xxxxx # Release = 3.2v5.0.0 # KernelID = 95/08/08 ! # Machine = Pentium # BusType = ISA # Serial = xxxxx # Users = 5-user # OEM# = 0 # Origin# = 1 ! # NumCPU = 1 ! ! # Use /bin/uname (because GNU uname may be first in $PATH and # it does not support -X) to figure out what SCO version we are: 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=5 ;; # Hope the future will be compatible. esac # Try to use libintl.a since it has strcoll and strxfrm libswanted="intl $libswanted" # Try to use libdbm.nfs.a since it has dbmclose. ! # if test -f /usr/lib/libdbm.nfs.a ; then libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'` + set X $libswanted + shift + libswanted="$*" fi # We don't want Xenix cross-development libraries glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'` xlibpth='' + # Common fix for all compilers. + ccflags="$ccflags -U M_XENIX" + + # Set flags for optimization and warning levels. case "$cc" in ! *gcc*) case "$optimize" in ! '') optimize='-O2' ;; ! esac ;; ! scocc) ;; # Anybody know anything about this? ! *) # icc or cc -- only relevant difference is safe level of ! # optimization. Apparently. case $scorls in ! 3) ccflags="$ccflags -W0 -quiet" ;; ! *) ccflags="$ccflags -w0" ;; esac case "$optimize" in ! '') case "$cc" in ! icc) optimize="-O1" ;; ! *) optimize="-O0" ;; ! esac ! ;; esac ;; esac ! ! # DYNAMIC LOADING: Dynamic loading won't work with scorls=3. ! # It ought to work with Release = 3.2v5.0.0 or later. ! if test "$scorls" = "3" -a "X$usedl" = "X"; then ! usedl=$undef ! else ! # I do not know exactly which of these are essential, ! # but this set has been recommended. --AD ! # These ought to be patched back into metaconfig, but the ! # current metaconfig units don't touch ccflags. ! # Unfortunately, the default on SCO is to produce COFF output, but ! # ELF is needed for dynamic loading, and the cc man page recommends ! # "Always specify option -b elf if ELF and COFF files might be mixed." ! # Therefore, we'll compile everything with -b elf. ! case "$cc" in ! *gcc*) ;; ! *) ccflags="$ccflags -b elf" ;; ! esac ! cccdlflags=none ! ccdlflags='-W l,-Bexport' ! lddlflags="$lddlflags -b elf -G" ! ldflags="$ldflags -b elf -W l,-Bexport" ! fi # I have received one report that nm extraction doesn't work if you're # using the scocc compiler. This system had the following 'myconfig' # uname='xxx xxx 3.2 2 i386 ' # cc='scocc', optimize='-O' ! # You can override this with Configure -Dusenm. ! case "$usenm" in ! '') usenm='false' ;; ! esac # If you want to use nm, you'll probably have to use nm -p. The # following does that for you: *************** *** 104,138 **** # 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. --- 113,118 ---- diff -c 'perl5.004_04/hints/solaris_2.sh' 'perl5.004_05/hints/solaris_2.sh' Index: ./hints/solaris_2.sh *** ./hints/solaris_2.sh Thu May 8 21:53:06 1997 --- ./hints/solaris_2.sh Tue Apr 27 05:51:09 1999 *************** *** 1,6 **** # hints/solaris_2.sh ! # Last modified: Thu Feb 8 11:38:12 EST 1996 ! # Andy Dougherty # Based on input from lots of folks, especially # Dean Roehrich --- 1,6 ---- # hints/solaris_2.sh ! # Last modified: Tue Apr 13 13:12:49 EDT 1999 ! # Andy Dougherty # Based on input from lots of folks, especially # Dean Roehrich *************** *** 9,16 **** # way to do that is to invoke Configure with # # sh Configure -Dcc='gcc -B/usr/ccs/bin/' ! # ! # See man vfork. usevfork=false --- 9,19 ---- # way to do that is to invoke Configure with # # sh Configure -Dcc='gcc -B/usr/ccs/bin/' ! # ! # (Note that the trailing slash is *required*.) ! # gcc will occasionally emit warnings about "unused prefix", but ! # these ought to be harmless. See below for more details. ! # See man vfork. usevfork=false *************** *** 33,42 **** case "$archname" in '') if test -f /usr/bin/arch; then ! archname=`/usr/bin/arch` archname="${archname}-${osname}" elif test -f /usr/ucb/arch; then ! archname=`/usr/ucb/arch` archname="${archname}-${osname}" fi ;; --- 36,45 ---- case "$archname" in '') if test -f /usr/bin/arch; then ! archname=`/usr/bin/arch` archname="${archname}-${osname}" elif test -f /usr/ucb/arch; then ! archname=`/usr/ucb/arch` archname="${archname}-${osname}" fi ;; *************** *** 53,63 **** # Here's another draft of the perl5/solaris/gcc sanity-checker. ! case $PATH in ! */usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <&4 NOTE: Some people have reported problems with /usr/ucb/cc. ! Remove /usr/ucb from your PATH if you have difficulties. END ;; --- 56,67 ---- # Here's another draft of the perl5/solaris/gcc sanity-checker. ! case `type ${cc:-cc}` in ! */usr/ucb/cc*) cat <&4 NOTE: Some people have reported problems with /usr/ucb/cc. ! If you have difficulties, please make sure the directory ! containing your C compiler is before /usr/ucb in your PATH. END ;; *************** *** 95,107 **** ;; esac # See if make(1) is GNU make(1). # If it is, make sure the setgid bit is not set. make -v > make.vers 2>&1 if grep GNU make.vers > /dev/null 2>&1; then ! tmp=`/usr/bin/which make` ! case "`/usr/bin/ls -l $tmp`" in ??????s*) cat <&2 --- 99,120 ---- ;; esac + # Use shell built-in 'type' command instead of /usr/bin/which to + # avoid possible csh start-up problems and also to use the same shell + # we'll be using to Configure and make perl. + # The path name is the last field in the output, but the type command + # has an annoying array of possible outputs, e.g.: + # make is hashed (/opt/gnu/bin/make) + # cc is /usr/ucb/cc + # foo not found + # use a command like type make | awk '{print $NF}' | sed 's/[()]//g' # See if make(1) is GNU make(1). # If it is, make sure the setgid bit is not set. make -v > make.vers 2>&1 if grep GNU make.vers > /dev/null 2>&1; then ! tmp=`type make | awk '{print $NF}' | sed 's/[()]//g'` ! case "`/usr/bin/ls -lL $tmp`" in ??????s*) cat <&2 *************** *** 119,195 **** # If the C compiler is gcc: # - check the fixed-includes # - check as(1) and ld(1), they should not be GNU # If the C compiler is not gcc: # - check as(1) and ld(1), they should not be GNU # # Watch out in case they have not set $cc. ! case "`${cc:-cc} -v 2>&1`" in ! *gcc*) # # Using gcc. # - #echo Using gcc - # Get gcc to share its secrets. - echo 'main() { return 0; }' > try.c - verbose=`${cc:-cc} -v -o try try.c 2>&1` - rm -f try try.c tmp=`echo "$verbose" | grep '^Reading' | awk '{print $NF}' | sed 's/specs$/include/'` # Determine if the fixed-includes look like they'll work. # Doesn't work anymore for gcc-2.7.2. ! # See if as(1) is GNU as(1). GNU as(1) won't work for this job. ! case $verbose in ! */usr/ccs/bin/as*) ;; ! *) cat <&2 ! NOTE: You are using GNU as(1). GNU as(1) will not build Perl. ! You must arrange to use /usr/ccs/bin/as, perhaps by setting ! GCC_EXEC_PREFIX or by including -B/usr/ccs/bin/ in your cc command. ! (Note that the trailing "/" is required.) END ! ;; ! esac ! # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. ! case $verbose in ! */usr/ccs/bin/ld*) ;; ! *) ! cat <&2 ! NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. ! You must arrange to use /usr/ccs/bin/ld, perhaps by setting ! GCC_EXEC_PREFIX or by including -B/usr/ccs/bin/ in your cc command. END ! ;; ! esac ! ;; #using gcc ! *) # # Not using gcc. # - #echo Not using gcc ! # See if as(1) is GNU as(1). GNU as(1) won't work for this job. case `as --version < /dev/null 2>&1` in *GNU*) cat <&2 ! NOTE: You are using GNU as(1). GNU as(1) will not build Perl. ! You must arrange to use /usr/ccs/bin, perhaps by adding it to the ! beginning of your PATH. END ;; esac ! # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. # ld --version doesn't properly report itself as a GNU tool, # as of ld version 2.6, so we need to be more strict. TWP 9/5/96 gnu_ld=false --- 132,251 ---- # If the C compiler is gcc: # - check the fixed-includes # - check as(1) and ld(1), they should not be GNU + # (GNU as and ld 2.8.1 and later are reportedly ok, however.) # If the C compiler is not gcc: # - check as(1) and ld(1), they should not be GNU + # (GNU as and ld 2.8.1 and later are reportedly ok, however.) # # Watch out in case they have not set $cc. ! ! # Perl compiled with some combinations of GNU as and ld may not ! # be able to perform dynamic loading of extensions. If you have a ! # problem with dynamic loading, be sure that you are using the Solaris ! # /usr/ccs/bin/as and /usr/ccs/bin/ld. You can do that with ! # sh Configure -Dcc='gcc -B/usr/ccs/bin/' ! # (note the trailing slash is required). ! # Combinations that are known to work with the following hints: ! # ! # gcc-2.7.2, GNU as 2.7, GNU ld 2.7 ! # egcs-1.0.3, GNU as 2.9.1 and GNU ld 2.9.1 ! # --Andy Dougherty ! # Tue Apr 13 17:19:43 EDT 1999 ! ! # Get gcc to share its secrets. ! echo 'main() { return 0; }' > try.c ! # Indent to avoid propagation to config.sh ! verbose=`${cc:-cc} -v -o try try.c 2>&1` ! ! if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then # # Using gcc. # tmp=`echo "$verbose" | grep '^Reading' | awk '{print $NF}' | sed 's/specs$/include/'` # Determine if the fixed-includes look like they'll work. # Doesn't work anymore for gcc-2.7.2. ! # See if as(1) is GNU as(1). GNU as(1) might not work for this job. ! if echo "$verbose" | grep ' /usr/ccs/bin/as ' >/dev/null 2>&1; then ! : ! else cat <&2 ! NOTE: You are using GNU as(1). GNU as(1) might not build Perl. If you ! have trouble, you can use /usr/ccs/bin/as by including -B/usr/ccs/bin/ ! in your ${cc:-cc} command. (Note that the trailing "/" is required.) END ! # Apparently not needed, at least for as 2.7 and later. ! # cc="${cc:-cc} -B/usr/ccs/bin/" ! fi ! # See if ld(1) is GNU ld(1). GNU ld(1) might not work for this job. ! # Recompute $verbose since we may have just changed $cc. ! verbose=`${cc:-cc} -v -o try try.c 2>&1 | grep ld 2>&1` ! ! if echo "$verbose" | grep ' /usr/ccs/bin/ld ' >/dev/null 2>&1; then ! # Ok, gcc directly calls the Solaris /usr/ccs/bin/ld. ! : ! elif echo "$verbose" | grep "ld: Software Generation Utilities" >/dev/null 2>&1; then ! # Hmm. gcc doesn't call /usr/ccs/bin/ld directly, but it ! # does appear to be using it eventually. egcs-1.0.3's ld ! # wrapper does this. ! # All Solaris versions of ld I've seen contain the magic ! # string used in the grep. ! : ! else ! # No evidence yet of /usr/ccs/bin/ld. Some versions ! # of egcs's ld wrapper call /usr/ccs/bin/ld in turn but ! # apparently don't reveal that unless you pass in -V. ! # (This may all depend on local configurations too.) ! ! myld=`echo $verbose| grep ld | awk '/\/ld/ {print $1}'` ! # This assumes that gcc's output will not change, and that ! # /full/path/to/ld will be the first word of the output. ! # Thus myld is something like opt/gnu/sparc-sun-solaris2.5/bin/ld ! ! if $myld -V 2>&1 | grep "ld: Software Generation Utilities" >/dev/null 2>&1; then ! # Ok, /usr/ccs/bin/ld eventually does get called. ! : ! else ! cat <&2 ! ! NOTE: You are using GNU ld(1). GNU ld(1) might not build Perl. If you ! have trouble, you can use /usr/ccs/bin/ld by including -B/usr/ccs/bin/ ! in your ${cc:-cc} command. (Note that the trailing "/" is required.) ! I will try to use GNU ld by passing in the -Wl,-E flag, but if that ! doesn't work, you should use -B/usr/ccs/bin/ instead. END ! ccdlflags="$ccdlflags -Wl,-E" ! lddlflags="$lddlflags -W,l-E -G" ! fi ! fi ! else # # Not using gcc. # ! # See if as(1) is GNU as(1). GNU might not work for this job. case `as --version < /dev/null 2>&1` in *GNU*) cat <&2 ! NOTE: You are using GNU as(1). GNU as(1) might not build Perl. ! You must arrange to use /usr/ccs/bin/as, perhaps by adding /usr/ccs/bin ! to the beginning of your PATH. END ;; esac ! # See if ld(1) is GNU ld(1). GNU ld(1) might not work for this job. # ld --version doesn't properly report itself as a GNU tool, # as of ld version 2.6, so we need to be more strict. TWP 9/5/96 gnu_ld=false *************** *** 200,226 **** esac if $gnu_ld ; then : else ! case `which ld` in ! no\ ld\ in*|[Cc]ommand\ not\ found*) ! ;; ! /*gnu*/ld|/*GNU*/ld) gnu_ld=true ;; esac fi if $gnu_ld ; then cat <&2 ! NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. ! You must arrange to use /usr/ccs/bin, perhaps by adding it to the ! beginning of your PATH. END fi ! ;; #not using gcc ! esac # as --version or ld --version might dump core. rm -f core # This is just a trick to include some useful notes. --- 256,281 ---- esac if $gnu_ld ; then : else ! # Try to guess from path ! case `type ld | awk '{print $NF}'` in ! *gnu*|*GNU*|*FSF*) gnu_ld=true ;; esac fi if $gnu_ld ; then cat <&2 ! NOTE: You are apparently using GNU ld(1). GNU ld(1) might not build Perl. ! You should arrange to use /usr/ccs/bin/ld, perhaps by adding /usr/ccs/bin ! to the beginning of your PATH. END fi ! fi # as --version or ld --version might dump core. + rm -f try try.c rm -f core # This is just a trick to include some useful notes. diff -c 'perl5.004_04/hints/sunos_4_1.sh' 'perl5.004_05/hints/sunos_4_1.sh' Index: ./hints/sunos_4_1.sh *** ./hints/sunos_4_1.sh Wed Aug 13 13:52:48 1997 --- ./hints/sunos_4_1.sh Wed May 27 13:29:15 1998 *************** *** 1,5 **** # hints/sunos_4_1.sh ! # Last modified: Thu Feb 8 11:46:05 EST 1996 # Andy Dougherty case "$cc" in --- 1,5 ---- # hints/sunos_4_1.sh ! # Last modified: Wed May 27 11:00:02 EDT 1998 # Andy Dougherty case "$cc" in *************** *** 25,33 **** # The gcc fix-includes script exposes those incorrect prototypes. # There may be other examples as well. Volunteers are welcome to # track them all down :-). In the meantime, we'll just skip unistd.h ! # for SunOS in most of the code. The POSIX extension is built with ! # unistd.h because, even though unistd.h has problems, if used with ! # care, it helps create a better POSIX extension. i_unistd='undef' cat << 'EOM' >&4 --- 25,31 ---- # The gcc fix-includes script exposes those incorrect prototypes. # There may be other examples as well. Volunteers are welcome to # track them all down :-). In the meantime, we'll just skip unistd.h ! # for SunOS in most of the code. (However, see ext/POSIX/hints/sunos_4.pl.) i_unistd='undef' cat << 'EOM' >&4 *************** *** 36,45 **** d_tzname and i_unistd. Keep the recommended values. See hints/sunos_4_1.sh for more information. EOM - - # SunOS 4.1.3 has two extra fields in struct tm. This works around - # the problem. Other BSD platforms may have similar problems. - POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"' # The correct setting of groupstype depends on which version of the C # library is used. If you are in the 'System V environment' --- 34,39 ---- diff -c 'perl5.004_04/hints/svr4.sh' 'perl5.004_05/hints/svr4.sh' Index: ./hints/svr4.sh *** ./hints/svr4.sh Thu Jul 31 14:44:33 1997 --- ./hints/svr4.sh Mon Apr 27 16:20:21 1998 *************** *** 1,15 **** # svr4 hints, System V Release 4.x ! # Last modified 1995/01/28 by Tye McQueen, tye@metronet.com # Use Configure -Dcc=gcc to use gcc. case "$cc" in '') cc='/bin/cc' test -f $cc || cc='/usr/ccs/bin/cc' ;; esac # We include support for using libraries in /usr/ucblib, but the setting ! # of libswanted excludes some libraries found there. You may want to ! # prevent "ucb" from being removed from libswanted and see if perl will ! # build on your system. ldflags='-L/usr/ccs/lib -L/usr/ucblib' ccflags='-I/usr/include -I/usr/ucbinclude' # Don't use problematic libraries: --- 1,19 ---- # svr4 hints, System V Release 4.x ! # Last modified 1996/10/25 by Tye McQueen, tye@metronet.com ! # Merged 1998/04/24 with perl5.004_04 distribution by ! # Andy Dougherty ! # Use Configure -Dcc=gcc to use gcc. case "$cc" in '') cc='/bin/cc' test -f $cc || cc='/usr/ccs/bin/cc' ;; esac + # We include support for using libraries in /usr/ucblib, but the setting ! # of libswanted excludes some libraries found there. If you run into ! # problems, you may have to remove "ucb" from libswanted. Just delete ! # the comment '#' from the sed command below. ldflags='-L/usr/ccs/lib -L/usr/ucblib' ccflags='-I/usr/include -I/usr/ucbinclude' # Don't use problematic libraries: *************** *** 17,71 **** # libmalloc.a - Probably using Perl's malloc() anyway. # libucb.a - Remove it if you have problems ld'ing. We include it because # it is needed for ODBM_File and NDBM_File extensions. if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library: ! d_gconvert='undef' # Unusuable under UnixWare 1.1 [use gcvt() instead] # Use the "native" counterparts, not the BSD emulation stuff: d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef' d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef' ! d_setlinebuf='undef' d_setregid='undef' d_setreuid='undef' fi - d_suidsafe='define' # "./Configure -d" can't figure this out easilly - usevfork='false' ! # Configure may fail to find lstat() since it's a static/inline ! # function in on Unisys U6000 SVR4, and possibly ! # other SVR4 derivatives. ! d_lstat=define ! # UnixWare has a broken csh. The undocumented -X argument to uname is probably ! # a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in ! # FILE* got renamed! ! uw_ver=`uname -v` ! uw_isuw=`uname -X 2>&1 | grep Release` if [ "$uw_isuw" = "Release = 4.2MP" ]; then case $uw_ver in 2.1) ! d_csh='undef' ! ;; 2.1.*) ! d_csh='undef' ! stdio_cnt='((fp)->__cnt)' ! d_stdio_cnt_lval='define' ! stdio_ptr='((fp)->__ptr)' ! d_stdio_ptr_lval='define' ! ;; esac fi # DDE SMES Supermax Enterprise Server case "`uname -sm`" in "UNIX_SV SMES") ! if test "$cc" = '/bin/cc' -o "$gccversion" = "" ! then ! # for cc we need -K PIC (not -K pic) ! cccdlflags="$cccdlflags -K PIC" ! fi ! # the *grent functions are in libgen. ! libswanted="$libswanted gen" ! # csh is broken (also) in SMES ! d_csh='undef' ;; esac cat <<'EOM' >&4 --- 21,128 ---- # libmalloc.a - Probably using Perl's malloc() anyway. # libucb.a - Remove it if you have problems ld'ing. We include it because # it is needed for ODBM_File and NDBM_File extensions. + if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library: ! d_Gconvert='gcvt' # Try gcvt() before gconvert(). # Use the "native" counterparts, not the BSD emulation stuff: d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef' d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef' ! d_setlinebuf='undef' ! # d_setregid='undef' d_setreuid='undef' # ??? fi ! # UnixWare has /usr/lib/libc.so.1, /usr/lib/libc.so.1.1, and ! # /usr/ccs/lib/libc.so. Configure chooses libc.so.1.1 while it ! # appears that /usr/ccs/lib/libc.so contains more symbols: ! # ! # Try the following if you want to use nm-extraction. We'll just ! # skip the nm-extraction phase, since searching for all the different ! # library versions will be hard to keep up-to-date. ! # ! # if [ "" = "$libc" -a -f /usr/ccs/lib/libc.so -a \ ! # -f /usr/lib/libc.so.1 -a -f /usr/lib/libc.so.1.1 ]; then ! # if nm -h /usr/ccs/lib/libc.so | egrep '\<_?select$' >/dev/null; then ! # if nm -h /usr/lib/libc.so.1 | egrep '\<_?select$'` >/dev/null || ! # nm -h /usr/lib/libc.so.1.1 | egrep '\<_?select$'` >/dev/null; then ! # : ! # else ! # libc=/usr/ccs/lib/libc.so ! # fi ! # fi ! # fi ! # ! # Don't bother with nm. Just compile & link a small C program. ! case "$usenm" in ! '') usenm=false;; ! esac ! # Broken C-Shell tests (Thanks to Tye McQueen): ! # The OS-specific checks may be obsoleted by the this generic test. ! sh_cnt=`sh -c 'echo /*' | wc -c` ! csh_cnt=`csh -f -c 'glob /*' 2>/dev/null | wc -c` ! csh_cnt=`expr 1 + $csh_cnt` ! if [ "$sh_cnt" -ne "$csh_cnt" ]; then ! echo "You're csh has a broken 'glob', disabling..." >&2 ! d_csh='undef' ! fi ! ! # Unixware-specific problems. The undocumented -X argument to uname ! # is probably a reasonable way of detecting UnixWare. ! # UnixWare has a broken csh. (This might already be detected above). ! # In Unixware 2.1.1 the fields in FILE* got renamed! ! $ Unixware 1.1 can't cast large floats to 32-bit ints. ! # ! # Leave leading tabs on the next two lines so Configure doesn't ! # propagate these variables to config.sh ! uw_ver=`uname -v` ! uw_isuw=`uname -X 2>&1 | grep Release` ! ! if [ "$uw_isuw" = "Release = 4.2" ]; then ! case $uw_ver in ! 1.1) ! d_casti32='undef' ! ;; ! esac ! fi if [ "$uw_isuw" = "Release = 4.2MP" ]; then case $uw_ver in 2.1) ! d_csh='undef' ! ;; 2.1.*) ! d_csh='undef' ! stdio_cnt='((fp)->__cnt)' ! d_stdio_cnt_lval='define' ! stdio_ptr='((fp)->__ptr)' ! d_stdio_ptr_lval='define' ! ;; esac fi + # End of Unixware-specific tests. # DDE SMES Supermax Enterprise Server case "`uname -sm`" in "UNIX_SV SMES") ! # the *grent functions are in libgen. ! libswanted="$libswanted gen" ! # csh is broken (also) in SMES ! # This may already be detected by the generic test above. ! d_csh='undef' ! case "$cc" in ! *gcc*) ;; ! *) # for cc we need -K PIC (not -K pic) ! cccdlflags="$cccdlflags -K PIC" ;; + esac + ;; esac + + # Configure may fail to find lstat() since it's a static/inline function + # in on Unisys U6000 SVR4, UnixWare 2.x, and possibly other + # SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.) + d_lstat=define + + d_suidsafe='define' # "./Configure -d" can't figure this out easilly cat <<'EOM' >&4 diff -c 'perl5.004_04/hints/unicos.sh' 'perl5.004_05/hints/unicos.sh' Index: ./hints/unicos.sh *** ./hints/unicos.sh Mon Dec 23 16:55:18 1996 --- ./hints/unicos.sh Sun Nov 22 12:42:59 1998 *************** *** 1,7 **** case `uname -r` in 6.1*) shellflags="-m+65536" ;; esac ! optimize="-O1" d_setregid='undef' d_setreuid='undef' ! --- 1,16 ---- case `uname -r` in 6.1*) shellflags="-m+65536" ;; esac ! case "$optimize" in ! '') optimize="-O1" ;; ! esac d_setregid='undef' d_setreuid='undef' ! case "$usemymalloc" in ! '') # The perl malloc.c SHOULD work says Ilya. ! # But for the time being (5.004_68), alas, it doesn't. ! # usemymalloc='y' ! # ccflags="$ccflags -DNO_RCHECK" ! usemymalloc='n' ! ;; ! esac diff -c 'perl5.004_04/hv.c' 'perl5.004_05/hv.c' Index: ./hv.c *** ./hv.c Tue Oct 14 08:58:10 1997 --- ./hv.c Sun Nov 22 12:13:21 1998 *************** *** 19,24 **** --- 19,31 ---- static HE* more_he(); + #if defined(STRANGE_MALLOC) || defined(MYMALLOC) + # define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) ) + #else + # define MALLOC_OVERHEAD 16 + # define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD ) + #endif + static HE* new_he() { *************** *** 44,50 **** { register HE* he; register HE* heend; ! he_root = (HE*)safemalloc(1008); he = he_root; heend = &he[1008 / sizeof(HE) - 1]; while (he < heend) { --- 51,57 ---- { register HE* he; register HE* heend; ! New(54, he_root, 1008/sizeof(HE), HE); he = he_root; heend = &he[1008 / sizeof(HE) - 1]; while (he < heend) { *************** *** 100,110 **** if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); ! Sv = sv; ! return &Sv; } } xhv = (XPVHV*)SvANY(hv); --- 107,131 ---- if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { + static SV *mysv; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); ! mysv = sv; ! return &mysv; } + #ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + U32 i; + for (i = 0; i < klen; ++i) + if (isLOWER(key[i])) { + char *nkey = strupr(SvPVX(sv_2mortal(newSVpv(key,klen)))); + SV **ret = hv_fetch(hv, nkey, klen, 0); + if (!ret && lval) + ret = hv_store(hv, key, klen, NEWSV(61,0), 0); + return ret; + } + } + #endif } xhv = (XPVHV*)SvANY(hv); *************** *** 114,120 **** || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) #endif ) ! Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); else return 0; } --- 135,141 ---- || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) #endif ) ! Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); else return 0; } *************** *** 167,186 **** if (!hv) return 0; ! if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) { ! static HE mh; ! sv = sv_newmortal(); ! keysv = sv_2mortal(newSVsv(keysv)); ! mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); ! if (!HeKEY_hek(&mh)) { ! char *k; ! New(54, k, HEK_BASESIZE + sizeof(SV*), char); ! HeKEY_hek(&mh) = (HEK*)k; } ! HeSVKEY_set(&mh, keysv); ! HeVAL(&mh) = sv; ! return &mh; } xhv = (XPVHV*)SvANY(hv); --- 188,224 ---- if (!hv) return 0; ! if (SvRMAGICAL(hv)) { ! if (mg_find((SV*)hv,'P')) { ! static HE mh; ! sv = sv_newmortal(); ! keysv = sv_2mortal(newSVsv(keysv)); ! mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); ! if (!HeKEY_hek(&mh)) { ! char *k; ! New(54, k, HEK_BASESIZE + sizeof(SV*), char); ! HeKEY_hek(&mh) = (HEK*)k; ! } ! HeSVKEY_set(&mh, keysv); ! HeVAL(&mh) = sv; ! return &mh; ! } ! #ifdef ENV_IS_CASELESS ! else if (mg_find((SV*)hv,'E')) { ! U32 i; ! key = SvPV(keysv, klen); ! for (i = 0; i < klen; ++i) ! if (isLOWER(key[i])) { ! SV *nkeysv = sv_2mortal(newSVpv(key,klen)); ! (void)strupr(SvPVX(nkeysv)); ! entry = hv_fetch_ent(hv, nkeysv, 0, 0); ! if (!entry && lval) ! entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash); ! return entry; ! } } ! #endif } xhv = (XPVHV*)SvANY(hv); *************** *** 190,196 **** || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) #endif ) ! Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); else return 0; } --- 228,234 ---- || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) #endif ) ! Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); else return 0; } *************** *** 255,266 **** #endif /* OVERLOAD */ ))) return 0; } if (!hash) PERL_HASH(hash, key, klen); if (!xhv->xhv_array) ! Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; --- 293,311 ---- #endif /* OVERLOAD */ ))) return 0; + #ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + SV *sv = sv_2mortal(newSVpv(key,klen)); + key = strupr(SvPVX(sv)); + hash = 0; + } + #endif } if (!hash) PERL_HASH(hash, key, klen); if (!xhv->xhv_array) ! Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; *************** *** 329,343 **** #endif /* OVERLOAD */ ))) return Nullhe; } key = SvPV(keysv, klen); ! if (!hash) PERL_HASH(hash, key, klen); if (!xhv->xhv_array) ! Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; --- 374,396 ---- #endif /* OVERLOAD */ ))) return Nullhe; + #ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + key = SvPV(keysv, klen); + keysv = sv_2mortal(newSVpv(key,klen)); + (void)strupr(SvPVX(keysv)); + hash = 0; + } + #endif } key = SvPV(keysv, klen); ! if (!hash) PERL_HASH(hash, key, klen); if (!xhv->xhv_array) ! Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; *************** *** 391,403 **** return Nullsv; if (SvRMAGICAL(hv)) { sv = *hv_fetch(hv, key, klen, TRUE); ! mg_clear(sv); ! if (mg_find(sv, 's')) { ! return Nullsv; /* %SIG elements cannot be deleted */ ! } ! if (mg_find(sv, 'p')) { ! sv_unmagic(sv, 'p'); /* No longer an element */ ! return sv; } } xhv = (XPVHV*)SvANY(hv); --- 444,467 ---- return Nullsv; if (SvRMAGICAL(hv)) { sv = *hv_fetch(hv, key, klen, TRUE); ! /* If sv isn't magical, do nothing. This enables the HV to have ! * magic that doesn't propagate to the elements (such as '~'). ! */ ! if (SvRMAGICAL(sv)) { ! mg_clear(sv); ! if (mg_find(sv, 's')) { ! return Nullsv; /* %SIG elements cannot be deleted */ ! } ! if (mg_find(sv, 'p')) { ! sv_unmagic(sv, 'p'); /* No longer an element */ ! return sv; ! } ! #ifdef ENV_IS_CASELESS ! if (mg_find((SV*)hv,'E')) { ! sv = sv_2mortal(newSVpv(key,klen)); ! key = strupr(SvPVX(sv)); ! } ! #endif } } xhv = (XPVHV*)SvANY(hv); *************** *** 453,462 **** if (SvRMAGICAL(hv)) { entry = hv_fetch_ent(hv, keysv, TRUE, hash); sv = HeVAL(entry); ! mg_clear(sv); ! if (mg_find(sv, 'p')) { ! sv_unmagic(sv, 'p'); /* No longer an element */ ! return sv; } } xhv = (XPVHV*)SvANY(hv); --- 517,539 ---- if (SvRMAGICAL(hv)) { entry = hv_fetch_ent(hv, keysv, TRUE, hash); sv = HeVAL(entry); ! /* If sv isn't magical, do nothing. This enables the HV to have ! * magic that doesn't propagate to the elements (such as '~'). ! */ ! if (SvRMAGICAL(sv)) { ! mg_clear(sv); ! if (mg_find(sv, 'p')) { ! sv_unmagic(sv, 'p'); /* No longer an element */ ! return sv; ! } ! #ifdef ENV_IS_CASELESS ! else if (mg_find((SV*)hv,'E')) { ! key = SvPV(keysv, klen); ! keysv = sv_2mortal(newSVpv(key,klen)); ! (void)strupr(SvPVX(keysv)); ! hash = 0; ! } ! #endif } } xhv = (XPVHV*)SvANY(hv); *************** *** 516,521 **** --- 593,604 ---- magic_existspack(sv, mg_find(sv, 'p')); return SvTRUE(sv); } + #ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + sv = sv_2mortal(newSVpv(key,klen)); + key = strupr(SvPVX(sv)); + } + #endif } xhv = (XPVHV*)SvANY(hv); *************** *** 561,566 **** --- 644,657 ---- magic_existspack(sv, mg_find(sv, 'p')); return SvTRUE(sv); } + #ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + key = SvPV(keysv, klen); + keysv = sv_2mortal(newSVpv(key,klen)); + (void)strupr(SvPVX(keysv)); + hash = 0; + } + #endif } xhv = (XPVHV*)SvANY(hv); *************** *** 592,650 **** I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ register I32 newsize = oldsize * 2; register I32 i; ! register HE **a; ! register HE **b; register HE *entry; register HE **oentry; - #ifndef STRANGE_MALLOC - I32 tmp; - #endif - a = (HE**)xhv->xhv_array; nomemok = TRUE; ! #ifdef STRANGE_MALLOC ! Renew(a, newsize, HE*); #else - i = newsize * sizeof(HE*); #define MALLOC_OVERHEAD 16 ! tmp = MALLOC_OVERHEAD; ! while (tmp - MALLOC_OVERHEAD < i) ! tmp += tmp; ! tmp -= MALLOC_OVERHEAD; ! tmp /= sizeof(HE*); ! assert(tmp >= newsize); ! New(2,a, tmp, HE*); ! Copy(xhv->xhv_array, a, oldsize, HE*); if (oldsize >= 64 && !nice_chunk) { ! nice_chunk = (char*)xhv->xhv_array; ! nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; } else Safefree(xhv->xhv_array); #endif nomemok = FALSE; ! Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/ xhv->xhv_max = --newsize; ! xhv->xhv_array = (char*)a; ! for (i=0; ixhv_fill++; ! *b = entry; continue; } else oentry = &HeNEXT(entry); } ! if (!*a) /* everything moved */ xhv->xhv_fill--; } } --- 683,740 ---- I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ register I32 newsize = oldsize * 2; register I32 i; ! register char *a = xhv->xhv_array; ! register HE **aep; ! register HE **bep; register HE *entry; register HE **oentry; nomemok = TRUE; ! #if defined(STRANGE_MALLOC) || defined(MYMALLOC) ! Renew(a, ARRAY_ALLOC_BYTES(newsize), char); ! if (!a) { ! nomemok = FALSE; ! return; ! } #else #define MALLOC_OVERHEAD 16 ! New(2, a, ARRAY_ALLOC_BYTES(newsize), char); ! if (!a) { ! nomemok = FALSE; ! return; ! } ! Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char); if (oldsize >= 64 && !nice_chunk) { ! nice_chunk = xhv->xhv_array; ! nice_chunk_size = ARRAY_ALLOC_BYTES(oldsize); } else Safefree(xhv->xhv_array); #endif nomemok = FALSE; ! Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ xhv->xhv_max = --newsize; ! xhv->xhv_array = a; ! aep = (HE**)a; ! for (i=0; ixhv_fill++; ! *bep = entry; continue; } else oentry = &HeNEXT(entry); } ! if (!*aep) /* everything moved */ xhv->xhv_fill--; } } *************** *** 659,665 **** register I32 newsize; register I32 i; register I32 j; ! register HE **a; register HE *entry; register HE **oentry; --- 749,756 ---- register I32 newsize; register I32 i; register I32 j; ! register char *a; ! register HE **aep; register HE *entry; register HE **oentry; *************** *** 674,728 **** if (newsize < newmax) return; /* overflow detection */ ! a = (HE**)xhv->xhv_array; if (a) { nomemok = TRUE; ! #ifdef STRANGE_MALLOC ! Renew(a, newsize, HE*); #else ! i = newsize * sizeof(HE*); ! j = MALLOC_OVERHEAD; ! while (j - MALLOC_OVERHEAD < i) ! j += j; ! j -= MALLOC_OVERHEAD; ! j /= sizeof(HE*); ! assert(j >= newsize); ! New(2, a, j, HE*); ! Copy(xhv->xhv_array, a, oldsize, HE*); if (oldsize >= 64 && !nice_chunk) { ! nice_chunk = (char*)xhv->xhv_array; ! nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; } else Safefree(xhv->xhv_array); #endif nomemok = FALSE; ! Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/ } else { ! Newz(0, a, newsize, HE*); } xhv->xhv_max = --newsize; ! xhv->xhv_array = (char*)a; if (!xhv->xhv_fill) /* skip rest if no entries */ return; ! for (i=0; ixhv_fill++; ! a[j] = entry; continue; } else oentry = &HeNEXT(entry); } ! if (!*a) /* everything moved */ xhv->xhv_fill--; } } --- 765,821 ---- if (newsize < newmax) return; /* overflow detection */ ! a = xhv->xhv_array; if (a) { nomemok = TRUE; ! #if defined(STRANGE_MALLOC) || defined(MYMALLOC) ! Renew(a, ARRAY_ALLOC_BYTES(newsize), char); ! if (!a) { ! nomemok = FALSE; ! return; ! } #else ! New(2, a, ARRAY_ALLOC_BYTES(newsize), char); ! if (!a) { ! nomemok = FALSE; ! return; ! } ! Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char); if (oldsize >= 64 && !nice_chunk) { ! nice_chunk = xhv->xhv_array; ! nice_chunk_size = ARRAY_ALLOC_BYTES(oldsize); } else Safefree(xhv->xhv_array); #endif nomemok = FALSE; ! Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ } else { ! Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char); } xhv->xhv_max = --newsize; ! xhv->xhv_array = a; if (!xhv->xhv_fill) /* skip rest if no entries */ return; ! aep = (HE**)a; ! for (i=0; ixhv_fill++; ! aep[j] = entry; continue; } else oentry = &HeNEXT(entry); } ! if (!*aep) /* everything moved */ xhv->xhv_fill--; } } *************** *** 753,763 **** HV *hv; register HE *entry; { if (!entry) return; ! if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) sub_generation++; /* may be deletion of method from stash */ ! SvREFCNT_dec(HeVAL(entry)); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); Safefree(HeKEY_hek(entry)); --- 846,859 ---- HV *hv; register HE *entry; { + SV *val; + if (!entry) return; ! val = HeVAL(entry); ! if (val && isGV(val) && GvCVu(val) && HvNAME(hv)) sub_generation++; /* may be deletion of method from stash */ ! SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); Safefree(HeKEY_hek(entry)); *************** *** 886,892 **** } xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); ! return xhv->xhv_fill; /* should be xhv->xhv_keys? May change later */ } HE * --- 982,988 ---- } xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); ! return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */ } HE * *************** *** 935,941 **** } if (!xhv->xhv_array) ! Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); if (entry) entry = HeNEXT(entry); while (!entry) { --- 1031,1037 ---- } if (!xhv->xhv_array) ! Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); if (entry) entry = HeNEXT(entry); while (!entry) { diff -c 'perl5.004_04/hv.h' 'perl5.004_05/hv.h' Index: ./hv.h *** ./hv.h Thu Mar 6 10:46:35 1997 --- ./hv.h Tue May 19 17:26:03 1998 *************** *** 22,32 **** char hek_key[1]; }; struct xpvhv { char * xhv_array; /* pointer to malloced string */ STRLEN xhv_fill; /* how full xhv_array currently is */ STRLEN xhv_max; /* subscript of last element of xhv_array */ ! I32 xhv_keys; /* how many elements in the array */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ --- 22,33 ---- char hek_key[1]; }; + /* This structure must match the beginning of struct xpvmg in sv.h. */ struct xpvhv { char * xhv_array; /* pointer to malloced string */ STRLEN xhv_fill; /* how full xhv_array currently is */ STRLEN xhv_max; /* subscript of last element of xhv_array */ ! IV xhv_keys; /* how many elements in the array */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ diff -c 'perl5.004_04/installhtml' 'perl5.004_05/installhtml' Index: ./installhtml *** ./installhtml Mon Aug 18 14:23:52 1997 --- ./installhtml Wed Mar 4 07:12:27 1998 *************** *** 295,301 **** # get the list of .html files in this directory opendir(DIR, $dir) || die "$0: error opening directory $dir for reading: $!\n"; ! @files = sort(grep(/\.html$/, readdir(DIR))); closedir(DIR); open(HTML, ">$html") || --- 295,301 ---- # get the list of .html files in this directory opendir(DIR, $dir) || die "$0: error opening directory $dir for reading: $!\n"; ! @files = sort(grep(/\.html?$/, readdir(DIR))); closedir(DIR); open(HTML, ">$html") || diff -c 'perl5.004_04/installperl' 'perl5.004_05/installperl' Index: ./installperl *** ./installperl Wed Oct 8 09:53:24 1997 --- ./installperl Tue Apr 13 00:17:27 1999 *************** *** 2,11 **** --- 2,14 ---- BEGIN { require 5.004; + chdir '..' if !-d 'lib' and -d '..\lib'; @INC = 'lib'; $ENV{PERL5LIB} = 'lib'; } + $scr_ext = ($^O eq 'MSWin32' ? '.bat' : ''); + use File::Find; use File::Compare; use File::Copy (); *************** *** 34,42 **** x2p/s2p x2p/find2perl pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); @pods = (); ! %archpms = (Config => 1, FileHandle => 1, overload => 1); find(sub { if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) { (my $pm = $1) =~ s{^lib/}{}; --- 37,55 ---- x2p/s2p x2p/find2perl pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); + if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; } + @pods = (); ! %archpms = ( ! Config => 1, FileHandle => 1, overload => 1, ! ); ! ! if ($^O eq 'dos') { ! push(@scripts,'djgpp/fixpmain'); ! $archpms{config} = $archpms{filehand} = 1; ! } ! find(sub { if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) { (my $pm = $1) =~ s{^lib/}{}; *************** *** 81,94 **** -x 'perl' . $exe_ext || die "perl isn't executable!\n"; -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid; ! -x 't/TEST' || warn "WARNING: You've never run 'make test'!!!", ! " (Installing anyway.)\n"; # First we install the version-numbered executables. ! safe_unlink("$installbin/perl$ver$exe_ext"); ! copy("perl$exe_ext", "$installbin/perl$ver$exe_ext"); ! chmod(0755, "$installbin/perl$ver$exe_ext"); safe_unlink("$installbin/sperl$ver$exe_ext"); if ($d_dosuid) { --- 94,124 ---- -x 'perl' . $exe_ext || die "perl isn't executable!\n"; -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid; ! -x 't/TEST' || $^O eq 'MSWin32' ! || warn "WARNING: You've never run 'make test'!!!", ! " (Installing anyway.)\n"; ! ! if ($^O eq 'MSWin32') { ! ! -f 'perl.' . $dlext || die "No perl DLL built\n"; ! ! # Install the DLL ! ! safe_unlink("$installbin/perl.$dlext"); ! copy("perl.$dlext", "$installbin/perl.$dlext"); ! chmod(0755, "$installbin/perl.$dlext"); ! } # First we install the version-numbered executables. ! if ($^O ne 'dos') { ! safe_unlink("$installbin/perl$ver$exe_ext"); ! copy("perl$exe_ext", "$installbin/perl$ver$exe_ext"); ! chmod(0755, "$installbin/perl$ver$exe_ext"); ! } else { ! safe_unlink("$installbin/perl.exe"); ! copy("perl.exe", "$installbin/perl.exe"); ! } safe_unlink("$installbin/sperl$ver$exe_ext"); if ($d_dosuid) { *************** *** 134,144 **** "$installarchlib/CORE/$file"); } # Offer to install perl in a "standard" location $mainperl_is_instperl = 0; ! if (!$versiononly && !$nonono && -t STDIN && -t STDERR && -w $mainperldir && ! samepath($mainperldir, $installbin)) { local($usrbinperl) = "$mainperldir/perl$exe_ext"; local($instperl) = "$installbin/perl$exe_ext"; --- 164,185 ---- "$installarchlib/CORE/$file"); } + # Install main perl executables + # Make links to ordinary names if installbin directory isn't current directory. + + if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) { + safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); + link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); + link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") + if $d_dosuid; + } + # Offer to install perl in a "standard" location $mainperl_is_instperl = 0; ! if ($Config{installusrbinperl} eq 'define' && ! !$versiononly && !$nonono && $^O ne 'MSWin32' && -t STDIN && -t STDERR && -w $mainperldir && ! samepath($mainperldir, $installbin)) { local($usrbinperl) = "$mainperldir/perl$exe_ext"; local($instperl) = "$installbin/perl$exe_ext"; *************** *** 171,183 **** # Make links to ordinary names if installbin directory isn't current directory. - if (! $versiononly && ! samepath($installbin, '.')) { - safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); - link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); - link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") - if $d_dosuid; - } - if (!$versiononly && ! samepath($installbin, 'x2p')) { safe_unlink("$installbin/a2p$exe_ext"); copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext"); --- 212,217 ---- *************** *** 210,216 **** if (! $versiononly) { safe_unlink("$installscript/pstruct"); ! link("$installscript/c2ph","$installscript/pstruct"); } # Install pod pages. Where? I guess in $installprivlib/pod. --- 244,254 ---- if (! $versiononly) { safe_unlink("$installscript/pstruct"); ! if ($^O eq 'dos') { ! copy("$installscript/c2ph$scr_ext","$installscript/pstruct$scr_ext"); ! } else { ! link("$installscript/c2ph$scr_ext","$installscript/pstruct$scr_ext"); ! } } # Install pod pages. Where? I guess in $installprivlib/pod. *************** *** 244,250 **** if (compare($from, $to) || $nonono) { mkpath("${installarchlib}/pod", 1, 0777); unlink($to); ! link($from, $to); } } --- 282,288 ---- if (compare($from, $to) || $nonono) { mkpath("${installarchlib}/pod", 1, 0777); unlink($to); ! link($from, $to) if ($^O ne 'dos'); } } *************** *** 256,262 **** if (!$versiononly) { ! $dirsep = ($^O eq 'os2') ? ';' : ':' ; ($path = $ENV{"PATH"}) =~ s:\\:/:g ; @path = split(/$dirsep/, $path); @otherperls = (); --- 294,300 ---- if (!$versiononly) { ! $dirsep = ($^O eq 'os2' || $^O eq 'MSWin32') ? ';' : ':' ; ($path = $ENV{"PATH"}) =~ s:\\:/:g ; @path = split(/$dirsep/, $path); @otherperls = (); *************** *** 302,308 **** foreach $name (@names) { next unless -e $name; ! chmod 0777, $name if $^O eq 'os2'; print STDERR " unlink $name\n"; ( CORE::unlink($name) and ++$cnt or warn "Couldn't unlink $name: $!\n" ) unless $nonono; --- 340,346 ---- foreach $name (@names) { next unless -e $name; ! chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32'); print STDERR " unlink $name\n"; ( CORE::unlink($name) and ++$cnt or warn "Couldn't unlink $name: $!\n" ) unless $nonono; *************** *** 315,321 **** local @names = @_; foreach $name (@names) { next unless -e $name; ! chmod 0777, $name if $^O eq 'os2'; print STDERR " unlink $name\n"; next if CORE::unlink($name); warn "Couldn't unlink $name: $!\n"; --- 353,359 ---- local @names = @_; foreach $name (@names) { next unless -e $name; ! chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32'); print STDERR " unlink $name\n"; next if CORE::unlink($name); warn "Couldn't unlink $name: $!\n"; *************** *** 366,371 **** --- 404,410 ---- sub chmod { local($mode,$name) = @_; + return if ($^O eq 'dos'); printf STDERR " chmod %o %s\n", $mode, $name; CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name) *************** *** 383,391 **** sub samepath { local($p1, $p2) = @_; ! local($dev1, $ino1, $dev2, $ino2); if ($p1 ne $p2) { ($dev1, $ino1) = stat($p1); ($dev2, $ino2) = stat($p2); ($dev1 == $dev2 && $ino1 == $ino2); --- 422,432 ---- sub samepath { local($p1, $p2) = @_; ! ! return (lc($p1) eq lc($p2)) if ($^O eq 'MSWin32'); if ($p1 ne $p2) { + local($dev1, $ino1, $dev2, $ino2); ($dev1, $ino1) = stat($p1); ($dev2, $ino2) = stat($p2); ($dev1 == $dev2 && $ino1 == $ino2); *************** *** 414,420 **** my $installlib = $installprivlib; if ($dir =~ /^auto/ || ! ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1})) { $installlib = $installarchlib; return unless $do_installarchlib; } else { --- 455,463 ---- my $installlib = $installprivlib; if ($dir =~ /^auto/ || ! ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) || ! ($name =~ /^(.*)\.(?:h|lib)$/i && $^O eq 'MSWin32') ! ) { $installlib = $installarchlib; return unless $do_installarchlib; } else { diff -c 'perl5.004_04/interp.sym' 'perl5.004_05/interp.sym' Index: ./interp.sym *** ./interp.sym Wed Apr 23 15:08:58 1997 --- ./interp.sym Sat Jul 18 17:57:50 1998 *************** *** 43,50 **** doswitches dowarn dumplvl ! e_fp ! e_tmpname endav envgv errgv --- 43,49 ---- doswitches dowarn dumplvl ! e_script endav envgv errgv *************** *** 139,144 **** --- 138,144 ---- sv_objcount sv_root sv_arenaroot + sys_intern tainted tainting tmps_floor diff -c 'perl5.004_04/lib/AutoLoader.pm' 'perl5.004_05/lib/AutoLoader.pm' Index: ./lib/AutoLoader.pm *** ./lib/AutoLoader.pm Tue Oct 7 04:30:08 1997 --- ./lib/AutoLoader.pm Mon Apr 26 15:46:06 1999 *************** *** 1,43 **** package AutoLoader; ! use vars qw(@EXPORT @EXPORT_OK); BEGIN { require Exporter; @EXPORT = (); @EXPORT_OK = qw(AUTOLOAD); } AUTOLOAD { ! my $name; # Braces used to preserve $1 et al. { ! my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/; ! $pkg =~ s#::#/#g; ! if (defined($name=$INC{"$pkg.pm"})) ! { ! $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#; ! $name = undef unless (-r $name); ! } ! unless (defined $name) ! { ! $name = "auto/$AUTOLOAD.al"; ! $name =~ s#::#/#g; ! } } my $save = $@; ! eval {local $SIG{__DIE__};require $name}; if ($@) { ! if (substr($AUTOLOAD,-9) eq '::DESTROY') { ! *$AUTOLOAD = sub {}; } else { # The load might just have failed because the filename was too # long for some old SVR3 systems which treat long names as errors. # If we can succesfully truncate a long name then it's worth a go. # There is a slight risk that we could pick up the wrong file here # but autosplit should have warned about that when splitting. ! if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ ! eval {local $SIG{__DIE__};require $name}; } if ($@){ $@ =~ s/ at .*\n//; --- 1,87 ---- package AutoLoader; ! use vars qw(@EXPORT @EXPORT_OK $VERSION); ! ! my $is_dosish; ! my $is_vms; BEGIN { require Exporter; @EXPORT = (); @EXPORT_OK = qw(AUTOLOAD); + $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32'; + $is_vms = $^O eq 'VMS'; + $VERSION = '5.56'; } AUTOLOAD { ! my $sub = $AUTOLOAD; ! my $filename; # Braces used to preserve $1 et al. { ! # Try to find the autoloaded file from the package-qualified ! # name of the sub. e.g., if the sub needed is ! # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is ! # something like '/usr/lib/perl5/Getopt/Long.pm', and the ! # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'. ! # ! # However, if @INC is a relative path, this might not work. If, ! # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is ! # 'lib/Getopt/Long.pm', and we want to require ! # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib'). ! # In this case, we simple prepend the 'auto/' and let the ! # C take care of the searching for us. ! ! my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); ! $pkg =~ s#::#/#g; ! if (defined($filename = $INC{"$pkg.pm"})) { ! $filename =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#; ! ! # if the file exists, then make sure that it is a ! # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', ! # or './lib/auto/foo/bar.al'. This avoids C searching ! # (and failing) to find the 'lib/auto/foo/bar.al' because it ! # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). ! ! if (-r $filename) { ! unless ($filename =~ m|^/|) { ! if ($is_dosish) { ! unless ($filename =~ m{^([a-z]:)?[\\/]}i) { ! $filename = "./$filename"; ! } ! } ! elsif ($is_vms) { ! # XXX todo by VMSmiths ! $filename = "./$filename"; ! } ! else { ! $filename = "./$filename"; ! } ! } ! } ! else { ! $filename = undef; ! } ! } ! unless (defined $filename) { ! # let C do the searching ! $filename = "auto/$sub.al"; ! $filename =~ s#::#/#g; ! } } my $save = $@; ! eval { local $SIG{__DIE__}; require $filename }; if ($@) { ! if (substr($sub,-9) eq '::DESTROY') { ! *$sub = sub {}; } else { # The load might just have failed because the filename was too # long for some old SVR3 systems which treat long names as errors. # If we can succesfully truncate a long name then it's worth a go. # There is a slight risk that we could pick up the wrong file here # but autosplit should have warned about that when splitting. ! if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ ! eval { local $SIG{__DIE__}; require $filename }; } if ($@){ $@ =~ s/ at .*\n//; *************** *** 48,54 **** } } $@ = $save; ! goto &$AUTOLOAD; } sub import { --- 92,98 ---- } } $@ = $save; ! goto &$sub; } sub import { *************** *** 73,79 **** # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). # ! (my $calldir = $callpkg) =~ s#::#/#; my $path = $INC{$calldir . '.pm'}; if (defined($path)) { # Try absolute path name. --- 117,123 ---- # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). # ! (my $calldir = $callpkg) =~ s#::#/#g; my $path = $INC{$calldir . '.pm'}; if (defined($path)) { # Try absolute path name. *************** *** 136,142 **** 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 future calls to the subroutine will bypass the AUTOLOAD mechanism. =head2 Subroutine Stubs --- 180,186 ---- thus (presumably) defining the needed subroutine. AUTOLOAD will then C the newly defined subroutine. ! Once this process completes for a given function, it is defined, so future calls to the subroutine will bypass the AUTOLOAD mechanism. =head2 Subroutine Stubs *************** *** 177,196 **** use Carp; sub AUTOLOAD { ! my $constname; ! ($constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { ! $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined constant $constname"; } } ! *$AUTOLOAD = sub { $val }; # same as: eval "sub $AUTOLOAD { $val }"; ! goto &$AUTOLOAD; } If any module's own AUTOLOAD subroutine has no need to fallback to the --- 221,240 ---- use Carp; sub AUTOLOAD { ! my $sub = $AUTOLOAD; ! (my $constname = $sub) =~ s/.*:://; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { ! $AutoLoader::AUTOLOAD = $sub; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined constant $constname"; } } ! *$sub = sub { $val }; # same as: eval "sub $sub { $val }"; ! goto &$sub; } If any module's own AUTOLOAD subroutine has no need to fallback to the *************** *** 224,230 **** 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 create the individual files. L will invoke B automatically if B is used in a module source file. --- 268,274 ---- handle multiple packages in a file. B only reads code as it is requested, and in many cases ! 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. *************** *** 241,246 **** --- 285,294 ---- to a subroutine may have a shorter name that the routine itself. This can lead to conflicting file names. The I package warns of these potential conflicts when used to split a module. + + AutoLoader may fail to find the autosplit files (or even find the wrong + ones) in cases where C<@INC> contains relative paths, B the program + does C. =head1 SEE ALSO diff -c 'perl5.004_04/lib/AutoSplit.pm' 'perl5.004_05/lib/AutoSplit.pm' Index: ./lib/AutoSplit.pm *** ./lib/AutoSplit.pm Fri Jun 13 10:03:11 1997 --- ./lib/AutoSplit.pm Tue Apr 13 00:35:32 1999 *************** *** 1,12 **** package AutoSplit; ! require 5.000; ! require Exporter; ! ! use Config; ! use Carp; use File::Path qw(mkpath); @ISA = qw(Exporter); @EXPORT = qw(&autosplit &autosplit_lib_modules); @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); --- 1,17 ---- package AutoSplit; ! use Exporter (); ! use Config qw(%Config); ! use Carp qw(carp); ! use File::Basename (); use File::Path qw(mkpath); + use strict; + use vars qw( + $VERSION @ISA @EXPORT @EXPORT_OK + $Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime + ); + $VERSION = "1.0303"; @ISA = qw(Exporter); @EXPORT = qw(&autosplit &autosplit_lib_modules); @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); *************** *** 17,29 **** =head1 SYNOPSIS ! perl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... ! ! use AutoSplit; autosplit($file, $dir, $keep, $check, $modtime); ! ! for perl versions 5.002 and later: ! perl -MAutoSplit -e 'autosplit($ARGV[0], $ARGV[1], $k, $chk, $modtime)' ... =head1 DESCRIPTION --- 22,30 ---- =head1 SYNOPSIS ! autosplit($file, $dir, $keep, $check, $modtime); ! autosplit_lib_modules(@modules); =head1 DESCRIPTION *************** *** 37,52 **** both forward declaration of all package routines, and as timestamp for the last update of the hierarchy. ! The remaining three arguments to C govern other options to the ! autosplitter. If the third argument, I<$keep>, is false, then any pre-existing ! C<*.al> files in the autoload directory are removed if they are no longer ! part of the module (obsoleted functions). The fourth argument, I<$check>, ! instructs C to check the module currently being split to ensure ! that it does include a C specification for the AutoLoader module, and ! skips the module if AutoLoader is not detected. Lastly, the I<$modtime> ! argument specifies that C is to check the modification time of the ! module against that of the C file, and only split the module ! if it is newer. Typical use of AutoSplit in the perl MakeMaker utility is via the command-line with: --- 38,73 ---- both forward declaration of all package routines, and as timestamp for the last update of the hierarchy. ! The remaining three arguments to C govern other options to ! the autosplitter. ! ! =over 2 ! ! =item $keep ! ! If the third argument, I<$keep>, is false, then any ! pre-existing C<*.al> files in the autoload directory are removed if ! they are no longer part of the module (obsoleted functions). ! $keep defaults to 0. ! ! =item $check ! ! The ! fourth argument, I<$check>, instructs C to check the module ! currently being split to ensure that it does include a C ! specification for the AutoLoader module, and skips the module if ! AutoLoader is not detected. ! $check defaults to 1. ! ! =item $modtime ! ! Lastly, the I<$modtime> argument specifies ! that C is to check the modification time of the module ! against that of the C file, and only split the module if ! it is newer. ! $modtime defaults to 1. ! ! =back Typical use of AutoSplit in the perl MakeMaker utility is via the command-line with: *************** *** 65,97 **** autosplitter one at a time, to be split into the directory B. In both usages of the autosplitter, only subroutines defined following the ! perl special marker I<__END__> are split out into separate files. Some routines may be placed prior to this marker to force their immediate loading and parsing. ! =head1 CAVEATS ! Currently, C cannot handle multiple package specifications ! within one file. =head1 DIAGNOSTICS ! C will inform the user if it is necessary to create the top-level ! directory specified in the invocation. It is preferred that the script or ! installation process that invokes C have created the full directory ! path ahead of time. This warning may indicate that the module is being split ! into an incorrect path. ! ! C will warn the user of all subroutines whose name causes potential ! file naming conflicts on machines with drastically limited (8 characters or ! less) file name length. Since the subroutine name is used as the file name, ! these warnings can aid in portability to such systems. ! Warnings are issued and the file skipped if C cannot locate either ! the I<__END__> marker or a "package Name;"-style specification. ! C will also emit general diagnostics for inability to create ! directories or files. =cut --- 86,134 ---- autosplitter one at a time, to be split into the directory B. In both usages of the autosplitter, only subroutines defined following the ! perl I<__END__> token are split out into separate files. Some routines may be placed prior to this marker to force their immediate loading and parsing. ! =head2 Multiple packages ! As of version 1.01 of the AutoSplit module it is possible to have ! multiple packages within a single file. Both of the following cases ! are supported: ! ! package NAME; ! __END__ ! sub AAA { ... } ! package NAME::option1; ! sub BBB { ... } ! package NAME::option2; ! sub BBB { ... } ! ! package NAME; ! __END__ ! sub AAA { ... } ! sub NAME::option1::BBB { ... } ! sub NAME::option2::BBB { ... } =head1 DIAGNOSTICS ! C will inform the user if it is necessary to create the ! top-level directory specified in the invocation. It is preferred that ! the script or installation process that invokes C have ! created the full directory path ahead of time. This warning may ! indicate that the module is being split into an incorrect path. ! ! C will warn the user of all subroutines whose name causes ! potential file naming conflicts on machines with drastically limited ! (8 characters or less) file name length. Since the subroutine name is ! used as the file name, these warnings can aid in portability to such ! systems. ! Warnings are issued and the file skipped if C cannot locate ! either the I<__END__> marker or a "package Name;"-style specification. ! C will also emit general diagnostics for inability to ! create directories or files. =cut *************** *** 102,119 **** $CheckForAutoloader = 1; $CheckModTime = 1; ! $IndexFile = "autosplit.ix"; # file also serves as timestamp ! $maxflen = 255; $maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; ! $Is_VMS = ($^O eq 'VMS'); sub autosplit{ ! my($file, $autodir, $k, $ckal, $ckmt) = @_; # $file - the perl source file to be split (after __END__) # $autodir - the ".../auto" dir below which to write split subs # Handle optional flags: ! $keep = $Keep unless defined $k; $ckal = $CheckForAutoloader unless defined $ckal; $ckmt = $CheckModTime unless defined $ckmt; autosplit_file($file, $autodir, $keep, $ckal, $ckmt); --- 139,159 ---- $CheckForAutoloader = 1; $CheckModTime = 1; ! my $IndexFile = "autosplit.ix"; # file also serves as timestamp ! my $maxflen = 255; $maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; ! if (defined (&Dos::UseLFN)) { ! $maxflen = Dos::UseLFN() ? 255 : 11; ! } ! my $Is_VMS = ($^O eq 'VMS'); sub autosplit{ ! my($file, $autodir, $keep, $ckal, $ckmt) = @_; # $file - the perl source file to be split (after __END__) # $autodir - the ".../auto" dir below which to write split subs # Handle optional flags: ! $keep = $Keep unless defined $keep; $ckal = $CheckForAutoloader unless defined $ckal; $ckmt = $CheckModTime unless defined $ckmt; autosplit_file($file, $autodir, $keep, $ckal, $ckmt); *************** *** 136,142 **** $dir =~ s#[\.\]]#/#g; $_ = $dir . $name; } ! autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime); } 0; } --- 176,183 ---- $dir =~ s#[\.\]]#/#g; $_ = $dir . $name; } ! autosplit_file("lib/$_", "lib/auto", ! $Keep, $CheckForAutoloader, $CheckModTime); } 0; } *************** *** 144,205 **** # private functions ! sub autosplit_file{ ! my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_; ! my(@names); local($_); # where to write output files ! $autodir = "lib/auto" unless $autodir; if ($Is_VMS) { ! ($autodir = VMS::Filespec::unixpath($autodir)) =~ s{/$}{}; $filename = VMS::Filespec::unixify($filename); # may have dirs } unless (-d $autodir){ mkpath($autodir,0,0755); ! # We should never need to create the auto dir here. installperl ! # (or similar) should have done it. Expecting it to exist is a valuable ! # sanity check against autosplitting into some random directory by mistake. ! print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n"; } # allow just a package name to be used $filename .= ".pm" unless ($filename =~ m/\.pm$/); ! open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n"; my($pm_mod_time) = (stat($filename))[9]; my($autoloader_seen) = 0; my($in_pod) = 0; while () { # Skip pod text. ! $in_pod = 1 if /^=/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # record last package name seen ! $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; last if /^__END__/; } if ($check_for_autoloader && !$autoloader_seen){ ! print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2); ! return 0 } $_ or die "Can't find __END__ in $filename\n"; ! $package or die "Can't find 'package Name;' in $filename\n"; ! my($modpname) = $package; ! if ($^O eq 'MSWin32') { ! $modpname =~ s#::#\\#g; ! } else { ! $modpname =~ s#::#/#g; ! } ! die "Package $package ($modpname.pm) does not match filename $filename" unless ($filename =~ m/\Q$modpname.pm\E$/ or ! ($^O eq "msdos") or ($^O eq 'MSWin32') or $Is_VMS && $filename =~ m/$modpname.pm/i); my($al_idx_file) = "$autodir/$modpname/$IndexFile"; --- 185,250 ---- # private functions ! sub autosplit_file { ! my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) ! = @_; ! my(@outfiles); local($_); + local($/) = "\n"; # where to write output files ! $autodir ||= "lib/auto"; if ($Is_VMS) { ! ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/$||; $filename = VMS::Filespec::unixify($filename); # may have dirs } unless (-d $autodir){ mkpath($autodir,0,0755); ! # We should never need to create the auto dir ! # here. installperl (or similar) should have done ! # it. Expecting it to exist is a valuable sanity check against ! # autosplitting into some random directory by mistake. ! print "Warning: AutoSplit had to create top-level " . ! "$autodir unexpectedly.\n"; } # allow just a package name to be used $filename .= ".pm" unless ($filename =~ m/\.pm$/); ! open(IN, "<$filename") or die "AutoSplit: Can't open $filename: $!\n"; my($pm_mod_time) = (stat($filename))[9]; my($autoloader_seen) = 0; my($in_pod) = 0; + my($def_package,$last_package,$this_package,$fnr); while () { # Skip pod text. ! $fnr++; ! $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # record last package name seen ! $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; last if /^__END__/; } if ($check_for_autoloader && !$autoloader_seen){ ! print "AutoSplit skipped $filename: no AutoLoader used\n" ! if ($Verbose>=2); ! return 0; } $_ or die "Can't find __END__ in $filename\n"; ! $def_package or die "Can't find 'package Name;' in $filename\n"; ! my($modpname) = _modpname($def_package); ! # this _has_ to match so we have a reasonable timestamp file ! die "Package $def_package ($modpname.pm) does not ". ! "match filename $filename" unless ($filename =~ m/\Q$modpname.pm\E$/ or ! ($^O eq 'dos') or ($^O eq 'MSWin32') or $Is_VMS && $filename =~ m/$modpname.pm/i); my($al_idx_file) = "$autodir/$modpname/$IndexFile"; *************** *** 207,220 **** if ($check_mod_time){ my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; if ($al_ts_time >= $pm_mod_time){ ! print "AutoSplit skipped ($al_idx_file newer that $filename)\n" if ($Verbose >= 2); return undef; # one undef, not a list } } ! my($from) = ($Verbose>=2) ? "$filename => " : ""; ! print "AutoSplitting $package ($from$autodir/$modpname)\n" if $Verbose; unless (-d "$autodir/$modpname"){ --- 252,264 ---- if ($check_mod_time){ my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; if ($al_ts_time >= $pm_mod_time){ ! print "AutoSplit skipped ($al_idx_file newer than $filename)\n" if ($Verbose >= 2); return undef; # one undef, not a list } } ! print "AutoSplitting $filename ($autodir/$modpname)\n" if $Verbose; unless (-d "$autodir/$modpname"){ *************** *** 228,295 **** # This is a problem because some systems silently truncate the file # names while others treat long file names as an error. ! # We do not yet deal with multiple packages within one file. ! # Ideally both of these styles should work. ! # ! # package NAME; ! # __END__ ! # sub AAA { ... } ! # package NAME::option1; ! # sub BBB { ... } ! # package NAME::option2; ! # sub BBB { ... } ! # ! # package NAME; ! # __END__ ! # sub AAA { ... } ! # sub NAME::option1::BBB { ... } ! # sub NAME::option2::BBB { ... } ! # ! # For now both of these produce warnings. ! open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning ! my(@subnames, %proto); my @cache = (); my $caching = 1; while () { ! next if /^=\w/ .. /^=cut/; ! if (/^package ([\w:]+)\s*;/) { ! warn "package $1; in AutoSplit section ignored. Not currently supported."; } if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) { ! print OUT "1;\n"; ! my $subname = $1; ! $proto{$1} = $2 || ''; ! if ($subname =~ m/::/){ ! warn "subs with package names not currently supported in AutoSplit section"; } ! push(@subnames, $subname); my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); my($lpath) = "$autodir/$modpname/$lname.al"; my($spath) = "$autodir/$modpname/$sname.al"; ! unless(open(OUT, ">$lpath")){ open(OUT, ">$spath") or die "Can't create $spath: $!\n"; ! push(@names, $sname); print " writing $spath (with truncated name)\n" if ($Verbose>=1); - }else{ - push(@names, $lname); - print " writing $lpath\n" if ($Verbose>=2); } ! print OUT "# NOTE: Derived from $filename. ", ! "Changes made here will be lost.\n"; ! print OUT "package $package;\n\n"; print OUT @cache; @cache = (); $caching = 0; } if($caching) { push(@cache, $_) if @cache || /\S/; ! } ! else { print OUT $_; } ! if(/^}/) { if($caching) { print OUT @cache; @cache = (); --- 272,342 ---- # This is a problem because some systems silently truncate the file # names while others treat long file names as an error. ! my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames ! my(@subnames, $subname, %proto, %package); my @cache = (); my $caching = 1; + $last_package = ''; while () { ! $fnr++; ! $in_pod = 1 if /^=\w/; ! $in_pod = 0 if /^=cut/; ! next if ($in_pod || /^=cut/); ! # the following (tempting) old coding gives big troubles if a ! # cut is forgotten at EOF: ! # next if /^=\w/ .. /^=cut/; ! if (/^package\s+([\w:]+)\s*;/) { ! $this_package = $def_package = $1; } if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) { ! print OUT "# end of $last_package\::$subname\n1;\n" ! if $last_package; ! $subname = $1; ! my $proto = $2 || ''; ! if ($subname =~ s/(.*):://){ ! $this_package = $1; ! } else { ! $this_package = $def_package; } ! my $fq_subname = "$this_package\::$subname"; ! $package{$fq_subname} = $this_package; ! $proto{$fq_subname} = $proto; ! push(@subnames, $fq_subname); my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); + $modpname = _modpname($this_package); + mkpath("$autodir/$modpname",0,0777); my($lpath) = "$autodir/$modpname/$lname.al"; my($spath) = "$autodir/$modpname/$sname.al"; ! my $path; ! if (!$Is83 and open(OUT, ">$lpath")){ ! $path=$lpath; ! print " writing $lpath\n" if ($Verbose>=2); ! } else { open(OUT, ">$spath") or die "Can't create $spath: $!\n"; ! $path=$spath; print " writing $spath (with truncated name)\n" if ($Verbose>=1); } ! push(@outfiles, $path); ! print OUT <=2); ! my($deleted,$thistime); # catch all versions on VMS ! do { $deleted += ($thistime = unlink $file) } while ($thistime); ! carp "Unable to delete $file: $!" unless $deleted; } - closedir(OUTDIR); } open(TS,">$al_idx_file") or carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!"; ! print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n"; ! print TS "package $package;\n"; ! print TS map("sub $_$proto{$_} ;\n", @subnames); print TS "1;\n"; close(TS); ! check_unique($package, $Maxlen, 1, @names); ! @names; } ! sub check_unique{ ! my($module, $maxlen, $warn, @names) = @_; my(%notuniq) = (); my(%shorts) = (); ! my(@toolong) = grep(length > $maxlen, @names); ! ! foreach(@toolong){ ! my($trunc) = substr($_,0,$maxlen); ! $notuniq{$trunc}=1 if $shorts{$trunc}; ! $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_; } if (%notuniq && $warn){ ! print "$module: some names are not unique when truncated to $maxlen characters:\n"; ! foreach(keys %notuniq){ ! print " $shorts{$_} truncate to $_\n"; } } - %notuniq; } 1; __END__ # test functions so AutoSplit.pm can be applied to itself: ! sub test1{ "test 1\n"; } ! sub test2{ "test 2\n"; } ! sub test3{ "test 3\n"; } ! sub test4{ "test 4\n"; } ! ! --- 344,461 ---- print OUT "\n"; $caching = 1; } + $last_package = $this_package if defined $this_package; } ! print OUT @cache,"1;\n# end of $last_package\::$subname\n"; close(OUT); close(IN); ! if (!$keep){ # don't keep any obsolete *.al files in the directory ! my(%outfiles); ! # @outfiles{@outfiles} = @outfiles; ! # perl downcases all filenames on VMS (which upcases all filenames) so ! # we'd better downcase the sub name list too, or subs with upper case ! # letters in them will get their .al files deleted right after they're ! # created. (The mixed case sub name won't match the all-lowercase ! # filename, and so be cleaned up as a scrap file) ! if ($Is_VMS or $Is83) { ! %outfiles = map {lc($_) => lc($_) } @outfiles; ! } else { ! @outfiles{@outfiles} = @outfiles; ! } ! my(%outdirs,@outdirs); ! for (@outfiles) { ! $outdirs{File::Basename::dirname($_)}||=1; ! } ! for my $dir (keys %outdirs) { ! opendir(OUTDIR,$dir); ! foreach (sort readdir(OUTDIR)){ ! next unless /\.al$/; ! my($file) = "$dir/$_"; ! $file = lc $file if $Is83 or $Is_VMS; ! next if $outfiles{$file}; ! print " deleting $file\n" if ($Verbose>=2); ! my($deleted,$thistime); # catch all versions on VMS ! do { $deleted += ($thistime = unlink $file) } while ($thistime); ! carp "Unable to delete $file: $!" unless $deleted; ! } ! closedir(OUTDIR); } } open(TS,">$al_idx_file") or carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!"; ! print TS "# Index created by AutoSplit for $filename\n"; ! print TS "# (file acts as timestamp)\n"; ! $last_package = ''; ! for my $fqs (@subnames) { ! my($subname) = $fqs; ! $subname =~ s/.*:://; ! print TS "package $package{$fqs};\n" ! unless $last_package eq $package{$fqs}; ! print TS "sub $subname $proto{$fqs};\n"; ! $last_package = $package{$fqs}; ! } print TS "1;\n"; close(TS); ! _check_unique($filename, $Maxlen, 1, @outfiles); ! @outfiles; } + sub _modpname ($) { + my($package) = @_; + my $modpname = $package; + if ($^O eq 'MSWin32') { + $modpname =~ s#::#\\#g; + } else { + $modpname =~ s#::#/#g; + } + $modpname; + } ! sub _check_unique { ! my($filename, $maxlen, $warn, @outfiles) = @_; my(%notuniq) = (); my(%shorts) = (); ! my(@toolong) = grep( ! length(File::Basename::basename($_)) ! > $maxlen, ! @outfiles ! ); ! ! foreach (@toolong){ ! my($dir) = File::Basename::dirname($_); ! my($file) = File::Basename::basename($_); ! my($trunc) = substr($file,0,$maxlen); ! $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc}; ! $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ? ! "$shorts{$dir}{$trunc}, $file" : $file; } if (%notuniq && $warn){ ! print "$filename: some names are not unique when " . ! "truncated to $maxlen characters:\n"; ! foreach my $dir (sort keys %notuniq){ ! print " directory $dir:\n"; ! foreach my $trunc (sort keys %{$notuniq{$dir}}) { ! print " $shorts{$dir}{$trunc} truncate to $trunc\n"; ! } } } } 1; __END__ # test functions so AutoSplit.pm can be applied to itself: ! sub test1 ($) { "test 1\n"; } ! sub test2 ($$) { "test 2\n"; } ! sub test3 ($$$) { "test 3\n"; } ! sub testtesttesttest4_1 { "test 4\n"; } ! sub testtesttesttest4_2 { "duplicate test 4\n"; } ! sub Just::Another::test5 { "another test 5\n"; } ! sub test6 { return join ":", __FILE__,__LINE__; } ! package Yet::Another::AutoSplit; ! sub testtesttesttest4_1 ($) { "another test 4\n"; } ! sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; } diff -c 'perl5.004_04/lib/Benchmark.pm' 'perl5.004_05/lib/Benchmark.pm' Index: ./lib/Benchmark.pm *** ./lib/Benchmark.pm Thu Apr 3 17:54:50 1997 --- ./lib/Benchmark.pm Wed Sep 23 19:47:32 1998 *************** *** 82,87 **** --- 82,111 ---- TITLE defaults to "timethis COUNT" if none is provided. STYLE determines the format of the output, as described for timestr() below. + The COUNT can be zero or negative: this means the I to run. A zero signifies the default of 3 seconds. For + example to run at least for 10 seconds: + + timethis(-10, $code) + + or to run two pieces of code tests for at least 3 seconds: + + timethese(0, { test1 => '...', test2 => '...'}) + + CPU seconds is, in UNIX terms, the user time plus the system time of + the process itself, as opposed to the real (wallclock) time and the + time spent by the child processes. Less than 0.1 seconds is not + accepted (-0.01 as the count, for example, will cause a fatal runtime + exception). + + Note that the CPU seconds is the B time: CPU scheduling and + other operating system factors may complicate the attempt so that a + little bit more time is spent. The benchmark output will, however, + also tell the number of C<$code> runs/second, which should be a more + interesting number than the actually spent seconds. + + Returns a Benchmark object. + =item timethese ( COUNT, CODEHASHREF, [ STYLE ] ) The CODEHASHREF is a reference to a hash containing names as keys *************** *** 91,102 **** timethis(COUNT, VALUE, KEY, STYLE) =item timediff ( T1, T2 ) Returns the difference between 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 the requested STYLE. TIMEDIFF is expected to be a Benchmark object --- 115,130 ---- timethis(COUNT, VALUE, KEY, STYLE) + The routines are called in string comparison order of KEY. + + The COUNT can be zero or negative, see timethis(). + =item timediff ( T1, T2 ) Returns the difference between 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 the requested STYLE. TIMEDIFF is expected to be a Benchmark object *************** *** 205,212 **** --- 233,250 ---- references and the already documented 'debug' method; revamped documentation. + April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time + functionality. + =cut + # evaluate something in a clean lexical environment + sub _doeval { eval shift } + + # + # put any lexicals at file scope AFTER here + # + use Carp; use Exporter; @ISA=(Exporter); *************** *** 237,243 **** # --- Functions to process the 'time' data type ! sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; } sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } --- 275,283 ---- # --- Functions to process the 'time' data type ! sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0); ! print "new=@t\n" if $debug; ! bless \@t; } sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } *************** *** 247,253 **** sub timediff { my($a, $b) = @_; my @r; ! for ($i=0; $i < @$a; ++$i) { push(@r, $a->[$i] - $b->[$i]); } bless \@r; --- 287,293 ---- sub timediff { my($a, $b) = @_; my @r; ! for (my $i=0; $i < @$a; ++$i) { push(@r, $a->[$i] - $b->[$i]); } bless \@r; *************** *** 256,275 **** sub timestr { my($tr, $style, $f) = @_; my @t = @$tr; ! warn "bad time value" unless @t==5; ! my($r, $pu, $ps, $cu, $cs) = @t; my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); $f = $defaultfmt unless defined $f; # format a time in the required style, other formats may be added here $style ||= $defaultstyle; $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; my $s = "@t $style"; # default for unknown style ! $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)", @t,$t) if $style eq 'all'; ! $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)", $r,$pu,$ps,$pt) if $style eq 'noc'; ! $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)", $r,$cu,$cs,$ct) if $style eq 'nop'; $s; } --- 296,316 ---- sub timestr { my($tr, $style, $f) = @_; my @t = @$tr; ! warn "bad time value (@t)" unless @t==6; ! my($r, $pu, $ps, $cu, $cs, $n) = @t; my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); $f = $defaultfmt unless defined $f; # format a time in the required style, other formats may be added here $style ||= $defaultstyle; $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; my $s = "@t $style"; # default for unknown style ! $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)", @t,$t) if $style eq 'all'; ! $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)", $r,$pu,$ps,$pt) if $style eq 'noc'; ! $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)", $r,$cu,$cs,$ct) if $style eq 'nop'; + $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n; $s; } *************** *** 295,310 **** last if $pack ne $curpack; } ! my $subcode = (ref $c eq 'CODE') ! ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }" ! : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; ! my $subref = eval $subcode; croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; print STDERR "runloop $n '$subcode'\n" if $debug; ! $t0 = &new; &$subref; ! $t1 = &new; $td = &timediff($t1, $t0); timedebug("runloop:",$td); --- 336,356 ---- last if $pack ne $curpack; } ! my ($subcode, $subref); ! if (ref $c eq 'CODE') { ! $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }"; ! $subref = eval $subcode; ! } ! else { ! $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }"; ! $subref = _doeval($subcode); ! } croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; print STDERR "runloop $n '$subcode'\n" if $debug; ! $t0 = Benchmark->new(0); &$subref; ! $t1 = Benchmark->new($n); $td = &timediff($t1, $t0); timedebug("runloop:",$td); *************** *** 336,351 **** $wd; } # --- Functions implementing high-level time-then-print utilities sub timethis{ my($n, $code, $title, $style) = @_; ! my $t = timeit($n, $code); local $| = 1; - $title = "timethis $n" unless defined $title; $style = "" unless defined $style; printf("%10s: ", $title); ! print timestr($t, $style),"\n"; # A conservative warning to spot very silly tests. # Don't assume that your benchmark is ok simply because --- 382,479 ---- $wd; } + + my $default_for = 3; + my $min_for = 0.1; + + sub runfor { + my ($code, $tmax) = @_; + + if ( not defined $tmax or $tmax == 0 ) { + $tmax = $default_for; + } elsif ( $tmax < 0 ) { + $tmax = -$tmax; + } + + die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n" + if $tmax < $min_for; + + my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot ); + + # First find the minimum $n that gives a non-zero timing. + + my $nmin; + + for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) { + $td = timeit($n, $code); + $tc = $td->[1] + $td->[2]; + } + + $nmin = $n; + + my $ttot = 0; + my $tpra = 0.05 * $tmax; # Target/time practice. + + # Double $n until we have think we have practiced enough. + for ( $n = 1; $ttot < $tpra; $n *= 2 ) { + $td = timeit($n, $code); + $tc = $td->cpu_p; + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $ttot = $utot + $stot; + $cutot += $td->[3]; + $cstot += $td->[4]; + } + + my $r; + + # Then iterate towards the $tmax. + while ( $ttot < $tmax ) { + $r = $tmax / $ttot - 1; # Linear approximation. + $n = int( $r * $n ); + $n = $nmin if $n < $nmin; + $td = timeit($n, $code); + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $ttot = $utot + $stot; + $cutot += $td->[3]; + $cstot += $td->[4]; + } + + return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ]; + } + # --- Functions implementing high-level time-then-print utilities + sub n_to_for { + my $n = shift; + return $n == 0 ? $default_for : $n < 0 ? -$n : undef; + } + sub timethis{ my($n, $code, $title, $style) = @_; ! my($t, $for, $forn); ! ! if ( $n > 0 ) { ! croak "non-integer loopcount $n, stopped" if int($n)<$n; ! $t = timeit($n, $code); ! $title = "timethis $n" unless defined $title; ! } else { ! $fort = n_to_for( $n ); ! $t = runfor($code, $fort); ! $title = "timethis for $fort" unless defined $title; ! $forn = $t->[-1]; ! } local $| = 1; $style = "" unless defined $style; printf("%10s: ", $title); ! print timestr($t, $style, $defaultfmt),"\n"; ! ! $n = $forn if defined $forn; # A conservative warning to spot very silly tests. # Don't assume that your benchmark is ok simply because *************** *** 363,373 **** unless ref $alt eq HASH; my @names = sort keys %$alt; $style = "" unless defined $style; ! print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; # we could save the results in an array and produce a summary here # sum, min, max, avg etc etc ! map timethis($n, $alt->{$_}, $_, $style), @names; } 1; --- 491,515 ---- unless ref $alt eq HASH; my @names = sort keys %$alt; $style = "" unless defined $style; ! print "Benchmark: "; ! if ( $n > 0 ) { ! croak "non-integer loopcount $n, stopped" if int($n)<$n; ! print "timing $n iterations of"; ! } else { ! print "running"; ! } ! print " ", join(', ',@names); ! unless ( $n > 0 ) { ! my $for = n_to_for( $n ); ! print ", each for at least $for CPU seconds"; ! } ! print "...\n"; # we could save the results in an array and produce a summary here # sum, min, max, avg etc etc ! foreach my $name (@names) { ! timethis ($n, $alt -> {$name}, $name, $style); ! } } 1; diff -c 'perl5.004_04/lib/CGI.pm' 'perl5.004_05/lib/CGI.pm' Index: ./lib/CGI.pm Prereq: 2.36 *** ./lib/CGI.pm Fri May 9 22:26:32 1997 --- ./lib/CGI.pm Sun Nov 22 16:12:04 1998 *************** *** 1,5 **** package CGI; ! require 5.001; # See the bottom of this file for the POD documentation. Search for the # string '=head'. --- 1,5 ---- package CGI; ! require 5.004; # See the bottom of this file for the POD documentation. Search for the # string '=head'. *************** *** 8,14 **** # documentation in manual or html file format (these utilities are part of the # Perl 5 distribution). ! # 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 --- 8,14 ---- # documentation in manual or html file format (these utilities are part of the # Perl 5 distribution). ! # Copyright 1995-1998 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 *************** *** 18,56 **** # http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ ! # Set this to 1 to enable copious autoloader debugging messages ! $AUTOLOAD_DEBUG=0; ! ! # Set this to 1 to enable NPH scripts ! # or: ! # 1) use CGI qw(:nph) ! # 2) $CGI::nph(1) ! # 3) print header(-nph=>1) ! $NPH=0; ! ! # Set this to 1 to make the temporary files created ! # during file uploads safe from prying eyes ! # or do... ! # 1) use CGI qw(:private_tempfiles) ! # 2) $CGI::private_tempfiles(1); ! $PRIVATE_TEMPFILES=0; ! ! $CGI::revision = '$Id: CGI.pm,v 2.36 1997/5/10 8:22 lstein Exp $'; ! $CGI::VERSION='2.36'; ! ! # OVERRIDE THE OS HERE IF CGI.pm GUESSES WRONG ! # $OS = 'UNIX'; ! # $OS = 'MACINTOSH'; ! # $OS = 'WINDOWS'; ! # $OS = 'VMS'; ! # $OS = 'OS2'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. # $TempFile::TMPDIRECTORY = '/usr/tmp'; # ------------------ START OF THE LIBRARY ------------ # FIGURE OUT THE OS WE'RE RUNNING UNDER # Some systems support the $^O variable. If not # available then require() the Config library --- 18,79 ---- # http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ ! $CGI::revision = '$Id: CGI.pm,v 1.32 1998/05/28 21:55:43 lstein Exp lstein $'; ! $CGI::VERSION='2.42'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. # $TempFile::TMPDIRECTORY = '/usr/tmp'; + # >>>>> Here are some globals that you might want to adjust <<<<<< + sub initialize_globals { + # Set this to 1 to enable copious autoloader debugging messages + $AUTOLOAD_DEBUG = 0; + + # Change this to the preferred DTD to print in start_html() + # or use default_dtd('text of DTD to use'); + $DEFAULT_DTD = '-//IETF//DTD HTML//EN'; + + # Set this to 1 to enable NPH scripts + # or: + # 1) use CGI qw(-nph) + # 2) $CGI::nph(1) + # 3) print header(-nph=>1) + $NPH = 0; + + # Set this to 1 to disable debugging from the + # command line + $NO_DEBUG = 0; + + # Set this to 1 to make the temporary files created + # during file uploads safe from prying eyes + # or do... + # 1) use CGI qw(:private_tempfiles) + # 2) $CGI::private_tempfiles(1); + $PRIVATE_TEMPFILES = 0; + + # Set this to a positive value to limit the size of a POSTing + # to a certain number of bytes: + $POST_MAX = -1; + + # Change this to 1 to disable uploads entirely: + $DISABLE_UPLOADS = 0; + + # Other globals that you shouldn't worry about. + undef $Q; + $BEEN_THERE = 0; + undef @QUERY_PARAM; + undef %EXPORT; + + # prevent complaints by mod_perl + 1; + } + # ------------------ START OF THE LIBRARY ------------ + # make mod_perlhappy + initialize_globals(); + # FIGURE OUT THE OS WE'RE RUNNING UNDER # Some systems support the $^O variable. If not # available then require() the Config library *************** *** 64,70 **** $OS = 'WINDOWS'; } elsif ($OS=~/vms/i) { $OS = 'VMS'; ! } elsif ($OS=~/Mac/i) { $OS = 'MACINTOSH'; } elsif ($OS=~/os2/i) { $OS = 'OS2'; --- 87,93 ---- $OS = 'WINDOWS'; } elsif ($OS=~/vms/i) { $OS = 'VMS'; ! } elsif ($OS=~/^MacOS$/i) { $OS = 'MACINTOSH'; } elsif ($OS=~/os2/i) { $OS = 'OS2'; *************** *** 77,108 **** # This is the default class for the CGI object to use when all else fails. $DefaultClass = 'CGI' unless defined $CGI::DefaultClass; # This is where to look for autoloaded routines. $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass; # The path separator is a slash, backslash or semicolon, depending # on the paltform. $SL = { ! UNIX=>'/', ! OS2=>'\\', ! WINDOWS=>'\\', ! MACINTOSH=>':', ! VMS=>'\\' }->{$OS}; # Turn on NPH scripts by default when running under IIS server! ! $NPH++ 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/)) { ! $NPH++; $| = 1; ! $SEQNO = 1; } ! # This is really "\r\n", but the meaning of \n is different ! # in MacPerl, so we resort to octal here. ! $CRLF = "\015\012"; if ($needs_binmode) { $CGI::DefaultClass->binmode(main::STDOUT); --- 100,144 ---- # This is the default class for the CGI object to use when all else fails. $DefaultClass = 'CGI' unless defined $CGI::DefaultClass; + # This is where to look for autoloaded routines. $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass; # The path separator is a slash, backslash or semicolon, depending # on the paltform. $SL = { ! UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', MACINTOSH=>':', VMS=>'/' }->{$OS}; + # This no longer seems to be necessary # Turn on NPH scripts by default when running under IIS server! ! # $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; ! $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; # Turn on special checking for Doug MacEachern's modperl ! if (defined($ENV{'GATEWAY_INTERFACE'}) && ! ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)) ! { $| = 1; ! require Apache; } + # Turn on special checking for ActiveState's PerlEx + $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; ! # Define the CRLF sequence. I can't use a simple "\r\n" because the meaning ! # of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF ! # and sometimes CR). The most popular VMS web server ! # doesn't accept CRLF -- instead it wants a LR. EBCDIC machines don't ! # use ASCII, so \015\012 means something different. I find this all ! # really annoying. ! $EBCDIC = "\t" ne "\011"; ! if ($OS eq 'VMS') { ! $CRLF = "\n"; ! } elsif ($EBCDIC) { ! $CRLF= "\r\n"; ! } else { ! $CRLF = "\015\012"; ! } if ($needs_binmode) { $CGI::DefaultClass->binmode(main::STDOUT); *************** *** 110,153 **** $CGI::DefaultClass->binmode(main::STDERR); } - # Cute feature, but it broke when the overload mechanism changed... - # %OVERLOAD = ('""'=>'as_string'); - %EXPORT_TAGS = ( ! ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em ! tt 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/], ! ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont style span/], ! ':netscape'=>[qw/blink frameset frame script font fontsize center/], ! ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group ! submit reset defaults radio_group popup_menu button autoEscape ! scrolling_list image_button start_form end_form startform endform ! start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], ! ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump ! raw_cookie request_method query_string accept user_agent remote_host ! remote_addr referer server_name server_software server_port server_protocol ! virtual_host remote_ident auth_type http use_named_parameters ! remote_user user_name header redirect import_names put/], ! ':ssl' => [qw/https/], ! ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/], ! ':html' => [qw/:html2 :html3 :netscape/], ! ':standard' => [qw/:html2 :form :cgi/], ! ':all' => [qw/:html2 :html3 :netscape :form :cgi/] ! ); # to import symbols into caller sub import { my $self = shift; my ($callpack, $callfile, $callline) = caller; ! foreach (@_) { ! $NPH++, next if $_ eq ':nph'; ! $PRIVATE_TEMPFILES++, next if $_ eq ':private_tempfiles'; ! foreach (&expand_tags($_)) { ! tr/a-zA-Z0-9_//cd; # don't allow weird function names ! $EXPORT{$_}++; ! } ! } # To allow overriding, search through the packages # Till we find one in which the correct subroutine is defined. my @packages = ($self,@{"$self\:\:ISA"}); --- 146,188 ---- $CGI::DefaultClass->binmode(main::STDERR); } %EXPORT_TAGS = ( ! ':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em ! tt u i b blockquote pre img a address cite samp dfn html head ! base body Link nextid title meta kbd start_html end_html ! input Select option comment/], ! ':html3'=>[qw/div table caption th td TR Tr sup sub strike applet Param ! embed basefont style span layer ilayer font frameset frame script small big/], ! ':netscape'=>[qw/blink fontsize center/], ! ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group ! submit reset defaults radio_group popup_menu button autoEscape ! scrolling_list image_button start_form end_form startform endform ! start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], ! ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump ! raw_cookie request_method query_string accept user_agent remote_host ! remote_addr referer server_name server_software server_port server_protocol ! virtual_host remote_ident auth_type http use_named_parameters ! save_parameters restore_parameters param_fetch ! remote_user user_name header redirect import_names put Delete Delete_all url_param/], ! ':ssl' => [qw/https/], ! ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/], ! ':html' => [qw/:html2 :html3 :netscape/], ! ':standard' => [qw/:html2 :html3 :form :cgi/], ! ':push' => [qw/multipart_init multipart_start multipart_end/], ! ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/] ! ); # to import symbols into caller sub import { my $self = shift; + + # This causes modules to clash. + # undef %EXPORT_OK; + # undef %EXPORT; + + $self->_setup_symbols(@_); my ($callpack, $callfile, $callline) = caller; ! # To allow overriding, search through the packages # Till we find one in which the correct subroutine is defined. my @packages = ($self,@{"$self\:\:ISA"}); *************** *** 164,169 **** --- 199,209 ---- } } + sub compile { + my $pack = shift; + $pack->_setup_symbols('-compile',@_); + } + sub expand_tags { my($tag) = @_; my(@r); *************** *** 182,189 **** my($class,$initializer) = @_; my $self = {}; bless $self,ref $class || $class || $DefaultClass; ! $CGI::DefaultClass->_reset_globals() if $MOD_PERL; ! $initializer = to_filehandle($initializer) if $initializer; $self->init($initializer); return $self; } --- 222,232 ---- my($class,$initializer) = @_; my $self = {}; bless $self,ref $class || $class || $DefaultClass; ! if ($MOD_PERL) { ! Apache->request->register_cleanup(\&CGI::_reset_globals); ! undef $NPH; ! } ! $self->_reset_globals if $PERLEX; $self->init($initializer); return $self; } *************** *** 234,327 **** return wantarray ? @{$self->{$name}} : $self->{$name}->[0]; } - #### Method: delete - # Deletes the named parameter entirely. - #### - sub delete { - my($self,$name) = self_or_default(@_); - delete $self->{$name}; - delete $self->{'.fieldnames'}->{$name}; - @{$self->{'.parameters'}}=grep($_ ne $name,$self->param()); - return wantarray ? () : undef; - } - sub self_or_default { ! return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI'); unless (defined($_[0]) && ! ref($_[0]) && ! (ref($_[0]) eq 'CGI' || ! eval "\$_[0]->isaCGI()")) { # optimize for the common case ! $CGI::DefaultClass->_reset_globals() ! if defined($Q) && $MOD_PERL && $CGI::DefaultClass->_new_request(); $Q = $CGI::DefaultClass->new unless defined($Q); unshift(@_,$Q); } return @_; } - sub _new_request { - return undef unless (defined(Apache->seqno()) or eval { require Apache }); - if (Apache->seqno() != $SEQNO) { - $SEQNO = Apache->seqno(); - return 1; - } else { - return undef; - } - } - - sub _reset_globals { - undef $Q; - undef @QUERY_PARAM; - } - sub self_or_CGI { local $^W=0; # prevent a warning if (defined($_[0]) && (substr(ref($_[0]),0,3) eq 'CGI' ! || eval "\$_[0]->isaCGI()")) { return @_; } else { return ($DefaultClass,@_); } } - sub isaCGI { - return 1; - } - - #### Method: import_names - # Import all parameters into the given namespace. - # Assumes namespace 'Q' if not specified - #### - sub import_names { - my($self,$namespace) = self_or_default(@_); - $namespace = 'Q' unless defined($namespace); - die "Can't import names into 'main'\n" - if $namespace eq 'main'; - my($param,@value,$var); - foreach $param ($self->param) { - # protect against silly names - ($var = $param)=~tr/a-zA-Z0-9_/_/c; - $var = "${namespace}::$var"; - @value = $self->param($param); - @{$var} = @value; - ${$var} = $value[0]; - } - } - - #### Method: use_named_parameters - # Force CGI.pm to use named parameter-style method calls - # rather than positional parameters. The same effect - # will happen automatically if the first parameter - # begins with a -. - sub use_named_parameters { - my($self,$use_named) = self_or_default(@_); - return $self->{'.named'} unless defined ($use_named); - - # stupidity to avoid annoying warnings - return $self->{'.named'}=$use_named; - } - ######################################## # THESE METHODS ARE MORE OR LESS PRIVATE # GO TO THE __DATA__ SECTION TO SEE MORE --- 277,304 ---- return wantarray ? @{$self->{$name}} : $self->{$name}->[0]; } sub self_or_default { ! return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI'); unless (defined($_[0]) && ! (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case ! ) { $Q = $CGI::DefaultClass->new unless defined($Q); unshift(@_,$Q); } return @_; } sub self_or_CGI { local $^W=0; # prevent a warning if (defined($_[0]) && (substr(ref($_[0]),0,3) eq 'CGI' ! || UNIVERSAL::isa($_[0],'CGI'))) { return @_; } else { return ($DefaultClass,@_); } } ######################################## # THESE METHODS ARE MORE OR LESS PRIVATE # GO TO THE __DATA__ SECTION TO SEE MORE *************** *** 337,350 **** sub init { my($self,$initializer) = @_; ! my($query_string,@lines); ! my($meth) = ''; # if we get called more than once, we want to initialize # ourselves from the original query (which may be gone # if it was read from STDIN originally.) if (defined(@QUERY_PARAM) && !defined($initializer)) { - foreach (@QUERY_PARAM) { $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_}); } --- 314,325 ---- sub init { my($self,$initializer) = @_; ! my($query_string,$meth,$content_length,$fh,@lines) = ('','','',''); # if we get called more than once, we want to initialize # ourselves from the original query (which may be gone # if it was read from STDIN originally.) if (defined(@QUERY_PARAM) && !defined($initializer)) { foreach (@QUERY_PARAM) { $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_}); } *************** *** 352,363 **** } $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'}); - # If initializer is defined, then read parameters - # from it. METHOD: { - if (defined($initializer)) { if (ref($initializer) && ref($initializer) eq 'HASH') { foreach (keys %$initializer) { $self->param('-name'=>$_,'-value'=>$initializer->{$_}); --- 327,358 ---- } $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'}); + $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0; + die "Client attempted to POST $content_length bytes, but POSTs are limited to $POST_MAX" + if ($POST_MAX > 0) && ($content_length > $POST_MAX); + $fh = to_filehandle($initializer) if $initializer; METHOD: { + # Process multipart postings, but only if the initializer is + # not defined. + if ($meth eq 'POST' + && defined($ENV{'CONTENT_TYPE'}) + && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data| + && !defined($initializer) + ) { + my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";]+)\"?/; + $self->read_multipart($boundary,$content_length); + last METHOD; + } + + # If initializer is defined, then read parameters + # from it. + if (defined($initializer)) { + if (UNIVERSAL::isa($initializer,'CGI')) { + $query_string = $initializer->query_string; + last METHOD; + } if (ref($initializer) && ref($initializer) eq 'HASH') { foreach (keys %$initializer) { $self->param('-name'=>$_,'-value'=>$initializer->{$_}); *************** *** 365,373 **** last METHOD; } ! $initializer = $$initializer if ref($initializer); ! if (defined(fileno($initializer))) { ! while (<$initializer>) { chomp; last if /^=/; push(@lines,$_); --- 360,367 ---- last METHOD; } ! if (defined($fh) && ($fh ne '')) { ! while (<$fh>) { chomp; last if /^=/; push(@lines,$_); *************** *** 380,428 **** } last METHOD; } $query_string = $initializer; last METHOD; } - # If method is GET or HEAD, fetch the query from - # the environment. - if ($meth=~/^(GET|HEAD)$/) { - $query_string = $ENV{'QUERY_STRING'}; - last METHOD; - } - - # If the method is POST, fetch the query from standard - # input. - if ($meth eq 'POST') { ! if (defined($ENV{'CONTENT_TYPE'}) ! && ! $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|) { ! my($boundary) = $ENV{'CONTENT_TYPE'}=~/boundary=(\S+)/; ! $self->read_multipart($boundary,$ENV{'CONTENT_LENGTH'}); ! ! } else { ! ! $self->read_from_client(\*STDIN,\$query_string,$ENV{'CONTENT_LENGTH'},0) ! if $ENV{'CONTENT_LENGTH'} > 0; ! } # Some people want to have their cake and eat it too! # Uncomment this line to have the contents of the query string # APPENDED to the POST data. ! # $query_string .= ($query_string ? '&' : '') . $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'}; last METHOD; } ! ! # If neither is set, assume we're being debugged offline. # Check the command line and then the standard input for data. # We use the shellwords package in order to behave the way that # UN*X programmers expect. ! $query_string = &read_from_cmdline; } ! # We now have the query string in hand. We do slightly # different things for keyword lists and parameter lists. ! if ($query_string) { if ($query_string =~ /=/) { $self->parse_params($query_string); } else { --- 374,414 ---- } last METHOD; } + + # last chance -- treat it as a string + $initializer = $$initializer if ref($initializer) eq 'SCALAR'; $query_string = $initializer; + last METHOD; } ! # If method is GET or HEAD, fetch the query from ! # the environment. ! if ($meth=~/^(GET|HEAD)$/) { ! $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; ! last METHOD; ! } ! if ($meth eq 'POST') { ! $self->read_from_client(\*STDIN,\$query_string,$content_length,0) ! if $content_length > 0; # Some people want to have their cake and eat it too! # Uncomment this line to have the contents of the query string # APPENDED to the POST data. ! # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; last METHOD; } ! ! # If $meth is not of GET, POST or HEAD, assume we're being debugged offline. # Check the command line and then the standard input for data. # We use the shellwords package in order to behave the way that # UN*X programmers expect. ! $query_string = read_from_cmdline() unless $NO_DEBUG; } ! # We now have the query string in hand. We do slightly # different things for keyword lists and parameter lists. ! if ($query_string ne '') { if ($query_string =~ /=/) { $self->parse_params($query_string); } else { *************** *** 447,485 **** $self->delete('.submit'); $self->delete('.cgifields'); $self->save_request unless $initializer; - } - # FUNCTIONS TO OVERRIDE: - # Turn a string into a filehandle sub to_filehandle { ! my $string = shift; ! if ($string && !ref($string)) { ! my($package) = caller(1); ! my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string"; ! return $tmp if defined(fileno($tmp)); } ! return $string; ! } ! ! # Create a new multipart buffer ! sub new_MultipartBuffer { ! my($self,$boundary,$length,$filehandle) = @_; ! return MultipartBuffer->new($self,$boundary,$length,$filehandle); ! } ! ! # Read data from a file handle ! sub read_from_client { ! my($self, $fh, $buff, $len, $offset) = @_; ! local $^W=0; # prevent a warning ! return read($fh, $$buff, $len, $offset); ! } ! ! # put a filehandle into binary mode (DOS) ! sub binmode { ! binmode($_[1]); } # send output to the browser --- 433,455 ---- $self->delete('.submit'); $self->delete('.cgifields'); $self->save_request unless $initializer; } # FUNCTIONS TO OVERRIDE: # Turn a string into a filehandle sub to_filehandle { ! my $thingy = shift; ! return undef unless $thingy; ! return $thingy if UNIVERSAL::isa($thingy,'GLOB'); ! return $thingy if UNIVERSAL::isa($thingy,'FileHandle'); ! if (!ref($thingy)) { ! my $caller = 1; ! while (my $package = caller($caller++)) { ! my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; ! return $tmp if defined(fileno($tmp)); ! } } ! return undef; } # send output to the browser *************** *** 496,502 **** # unescape URL-encoded data sub unescape { ! my($todecode) = @_; $todecode =~ tr/+/ /; # pluses become spaces $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; return $todecode; --- 466,474 ---- # unescape URL-encoded data sub unescape { ! shift() if ref($_[0]); ! my $todecode = shift; ! return undef unless defined($todecode); $todecode =~ tr/+/ /; # pluses become spaces $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; return $todecode; *************** *** 504,511 **** # URL-encode data sub escape { ! my($toencode) = @_; ! $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } --- 476,485 ---- # URL-encode data sub escape { ! shift() if ref($_[0]) || $_[0] eq $DefaultClass; ! my $toencode = shift; ! return undef unless defined($toencode); ! $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } *************** *** 520,541 **** } } - sub parse_keywordlist { - my($self,$tosplit) = @_; - $tosplit = &unescape($tosplit); # unescape the keywords - $tosplit=~tr/+/ /; # pluses to spaces - my(@keywords) = split(/\s+/,$tosplit); - return @keywords; - } - sub parse_params { my($self,$tosplit) = @_; my(@pairs) = split('&',$tosplit); my($param,$value); foreach (@pairs) { ! ($param,$value) = split('='); ! $param = &unescape($param); ! $value = &unescape($value); $self->add_parameter($param); push (@{$self->{$param}},$value); } --- 494,507 ---- } } sub parse_params { my($self,$tosplit) = @_; my(@pairs) = split('&',$tosplit); my($param,$value); foreach (@pairs) { ! ($param,$value) = split('=',$_,2); ! $param = unescape($param); ! $value = unescape($value); $self->add_parameter($param); push (@{$self->{$param}},$value); } *************** *** 554,599 **** return @{$self->{'.parameters'}}; } ! #### Method as_string ! # ! # synonym for "dump" ! #### ! sub as_string { ! &dump(@_); } sub AUTOLOAD { print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG; ! my($func) = $AUTOLOAD; ! my($pack,$func_name) = $func=~/(.+)::([^:]+)$/; ! $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass ! unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"}); ! ! my($sub) = \%{"$pack\:\:SUBS"}; ! unless (%$sub) { ! my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"}; ! eval "package $pack; $$auto"; ! die $@ if $@; ! } ! my($code) = $sub->{$func_name}; ! ! $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY'); ! if (!$code) { ! if ($EXPORT{':any'} || ! $EXPORT{$func_name} || ! (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html'))) ! && $EXPORT_OK{$func_name}) { ! $code = $sub->{'HTML_FUNC'}; ! $code=~s/func_name/$func_name/mg; ! } ! } ! die "Undefined subroutine $AUTOLOAD\n" unless $code; ! eval "package $pack; $code"; ! if ($@) { ! $@ =~ s/ at .*\n//; ! die $@; ! } ! goto &{"$pack\:\:$func_name"}; } # PRIVATE SUBROUTINE --- 520,559 ---- return @{$self->{'.parameters'}}; } ! # put a filehandle into binary mode (DOS) ! sub binmode { ! CORE::binmode($_[1]); ! } ! ! sub _make_tag_func { ! my $tagname = shift; ! return qq{ ! sub $tagname { ! # handle various cases in which we're called ! # most of this bizarre stuff is to avoid -w errors ! shift if \$_[0] && ! (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) || ! (ref(\$_[0]) && ! (substr(ref(\$_[0]),0,3) eq 'CGI' || ! UNIVERSAL::isa(\$_[0],'CGI'))); ! ! my(\$attr) = ''; ! if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') { ! my(\@attr) = make_attributes( '',shift() ); ! \$attr = " \@attr" if \@attr; ! } ! my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U\E"); ! return \$tag unless \@_; ! my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; ! return "\@result"; ! } ! } } sub AUTOLOAD { print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG; ! my $func = &_compile; ! goto &$func; } # PRIVATE SUBROUTINE *************** *** 604,641 **** sub rearrange { my($self,$order,@param) = @_; return () unless @param; - - return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-') - || $self->use_named_parameters; ! my $i; ! for ($i=0;$i<@param;$i+=2) { ! $param[$i]=~s/^\-//; # get rid of initial - if present ! $param[$i]=~tr/a-z/A-Z/; # parameters are upper case ! } ! ! my(%param) = @param; # convert into associative array ! my(@return_array); ! ! my($key)=''; ! foreach $key (@$order) { ! my($value); ! # this is an awful hack to fix spurious warnings when the ! # -w switch is set. ! if (ref($key) && ref($key) eq 'ARRAY') { ! foreach (@$key) { ! last if defined($value); ! $value = $param{$_}; ! delete $param{$_}; ! } } else { ! $value = $param{$key}; ! delete $param{$key}; } - push(@return_array,$value); } ! push (@return_array,$self->make_attributes(\%param)) if %param; ! return (@return_array); } ############################################################################### --- 564,673 ---- sub rearrange { my($self,$order,@param) = @_; return () unless @param; ! if (ref($param[0]) eq 'HASH') { ! @param = %{$param[0]}; ! } else { ! return @param ! unless (defined($param[0]) && substr($param[0],0,1) eq '-') ! || $self->use_named_parameters; ! } ! ! # map parameters into positional indices ! my ($i,%pos); ! $i = 0; ! foreach (@$order) { ! foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; } ! $i++; ! } ! ! my (@result,%leftover); ! $#result = $#$order; # preextend ! while (@param) { ! my $key = uc(shift(@param)); ! $key =~ s/^\-//; ! if (exists $pos{$key}) { ! $result[$pos{$key}] = shift(@param); } else { ! $leftover{$key} = shift(@param); ! } ! } ! ! push (@result,$self->make_attributes(\%leftover)) if %leftover; ! @result; ! } ! ! sub _compile { ! my($func) = $AUTOLOAD; ! my($pack,$func_name); ! { ! local($1,$2); # this fixes an obscure variable suicide problem. ! $func=~/(.+)::([^:]+)$/; ! ($pack,$func_name) = ($1,$2); ! $pack=~s/::SUPER$//; # fix another obscure problem ! $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass ! unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"}); ! ! my($sub) = \%{"$pack\:\:SUBS"}; ! unless (%$sub) { ! my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"}; ! eval "package $pack; $$auto"; ! die $@ if $@; ! $$auto = ''; # Free the unneeded storage (but don't undef it!!!) ! } ! my($code) = $sub->{$func_name}; ! ! $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY'); ! if (!$code) { ! if ($EXPORT{':any'} || ! $EXPORT{'-any'} || ! $EXPORT{$func_name} || ! (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html'))) ! && $EXPORT_OK{$func_name}) { ! $code = _make_tag_func($func_name); ! } ! } ! die "Undefined subroutine $AUTOLOAD\n" unless $code; ! eval "package $pack; $code"; ! if ($@) { ! $@ =~ s/ at .*\n//; ! die $@; ! } ! }