diff options
| author | Jarkko Hietaniemi <jhi@iki.fi> | 2000-02-02 13:17:25 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2000-02-02 13:17:25 +0000 |
| commit | b94b5eb1a9bac58070d115eb906a4c45140721e8 (patch) | |
| tree | cf1b431af892f9497970c3670b4a40e023823269 | |
| parent | 8686eb6248feaadcd94f1958d084afd376f084e7 (diff) | |
| parent | ce7dc536b5c179e3a7bb126f63a00e6705c10f70 (diff) | |
| download | perl-b94b5eb1a9bac58070d115eb906a4c45140721e8.tar.gz | |
Integrate with Sarathy.
p4raw-id: //depot/cfgperl@4968
| -rw-r--r-- | Changes | 276 | ||||
| -rwxr-xr-x | Configure | 283 | ||||
| -rw-r--r-- | INSTALL | 2 | ||||
| -rw-r--r-- | MANIFEST | 2 | ||||
| -rw-r--r-- | Porting/makerel | 11 | ||||
| -rw-r--r-- | README.threads | 27 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | hints/dynixptx.sh | 3 | ||||
| -rw-r--r-- | lib/Benchmark.pm | 4 | ||||
| -rw-r--r-- | lib/Cwd.pm | 2 | ||||
| -rw-r--r-- | lib/English.pm | 16 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_Unix.pm | 2 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_Win32.pm | 1 | ||||
| -rw-r--r-- | lib/ExtUtils/Manifest.pm | 2 | ||||
| -rw-r--r-- | lib/Fatal.pm | 2 | ||||
| -rw-r--r-- | lib/File/Spec/Win32.pm | 1 | ||||
| -rw-r--r-- | lib/Math/BigFloat.pm | 2 | ||||
| -rw-r--r-- | lib/Pod/Checker.pm | 849 | ||||
| -rw-r--r-- | lib/Pod/Find.pm | 259 | ||||
| -rw-r--r-- | lib/Pod/ParseUtils.pm | 792 | ||||
| -rw-r--r-- | lib/Text/ParseWords.pm | 2 | ||||
| -rw-r--r-- | lib/perl5db.pl | 18 | ||||
| -rw-r--r-- | lib/utf8_heavy.pl | 2 | ||||
| -rwxr-xr-x | perlapi.h | 2 | ||||
| -rw-r--r-- | pod/perldebug.pod | 6 | ||||
| -rw-r--r-- | pod/perldelta.pod | 113 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 9 | ||||
| -rw-r--r-- | pp_hot.c | 1 | ||||
| -rw-r--r-- | pp_sys.c | 2 | ||||
| -rwxr-xr-x | t/pod/poderrs.t | 10 | ||||
| -rw-r--r-- | t/pod/poderrs.xr | 23 | ||||
| -rw-r--r-- | win32/win32.h | 1 |
32 files changed, 2066 insertions, 661 deletions
@@ -75,10 +75,284 @@ indicator: ---------------- -Version v5.5.640 Development release working toward 5.6 +Version v5.5.640 Development release working toward v5.6 ---------------- ____________________________________________________________________________ +[ 4966] By: gsar on 2000/02/02 11:42:03 + Log: workaround for undefined symbol + Branch: perl + ! win32/win32.h +____________________________________________________________________________ +[ 4965] By: gsar on 2000/02/02 11:19:19 + Log: on cygwin, h_errno is now "__declspec(dllimport) int h_errno" + (from Eric Fifer <EFifer@sanwaint.com>) + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 4964] By: gsar on 2000/02/02 11:11:15 + Log: adjust notes on use5005threads + Branch: perl + ! Configure INSTALL README.threads +____________________________________________________________________________ +[ 4963] By: gsar on 2000/02/02 10:14:30 + Log: fix typo + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4962] By: gsar on 2000/02/02 10:13:10 + Log: integrate selected changes from cfgperl (#4899,4900,4904,4918) + Branch: perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH ext/IO/IO.xs lib/Benchmark.pm +____________________________________________________________________________ +[ 4961] By: gsar on 2000/02/02 09:55:45 + Log: PodParser-1.092 update via CPAN (from Brad Appleton) + Branch: perl + + lib/Pod/Find.pm lib/Pod/ParseUtils.pm + ! MANIFEST lib/Pod/Checker.pm t/pod/poderrs.t t/pod/poderrs.xr +____________________________________________________________________________ +[ 4960] By: gsar on 2000/02/02 08:22:31 + Log: replace misleading docs with a BUGS section + Branch: perl + ! lib/English.pm +____________________________________________________________________________ +[ 4959] By: gsar on 2000/02/02 08:16:17 + Log: remove FUD from perlfunc/use (from M J T Guy) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4958] By: gsar on 2000/02/02 08:13:04 + Log: Benchmark displays bogus CPU stats (suggested by Cedric Auzanne + <cedric.auzanne@nist.gov>) + Branch: perl + ! Changes lib/Benchmark.pm +____________________________________________________________________________ +[ 4957] By: gsar on 2000/02/02 08:04:52 + Log: fix coredump on C<"x" =~ /x/; print @-> (from Ilya Zakharevich) + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 4956] By: gsar on 2000/02/02 08:02:57 + Log: flock() pod talks about "adding" in the sense of "or-ing" + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4955] By: gsar on 2000/02/02 07:58:35 + Log: fixes for switching files in the debugger (from Ilya Zakharevich) + Branch: perl + ! lib/perl5db.pl pod/perldebug.pod +____________________________________________________________________________ +[ 4954] By: gsar on 2000/02/02 07:53:51 + Log: use warnings rather than fiddling with $^W (from Paul Marquess) + Branch: perl + ! lib/Cwd.pm lib/English.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_Win32.pm lib/ExtUtils/Manifest.pm lib/Fatal.pm + ! lib/File/Spec/Win32.pm lib/Math/BigFloat.pm + ! lib/Text/ParseWords.pm lib/utf8_heavy.pl +____________________________________________________________________________ +[ 4953] By: gsar on 2000/02/02 07:40:33 + Log: dynixptx hints tweak (from Martin J. Bligh <mbligh@sequent.com>) + Branch: perl + ! hints/dynixptx.sh +____________________________________________________________________________ +[ 4952] By: gsar on 2000/02/02 07:36:39 + Log: deltanotes on weakrefs and Pod::Parser (from Tuomas Lukka and + Brad Appleton) + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4951] By: gsar on 2000/02/02 06:54:22 + Log: avoid mismatched type warnings + Branch: perl + ! embed.pl perlapi.h +____________________________________________________________________________ +[ 4950] By: jhi on 2000/02/02 06:49:10 + Log: Integrate with Sarathy. + Branch: cfgperl + +> pod/perlunicode.pod + !> MANIFEST Makefile.SH lib/File/Spec/Win32.pm lib/Text/Tabs.pm + !> lib/byte.pm lib/byte_heavy.pl lib/utf8.pm lib/warnings.pm + !> makedef.pl op.c perl.h pod/perldelta.pod pp_ctl.c regcomp.c + !> regexec.c t/pragma/warn/2use utf8.h utils/perldoc.PL + !> vms/descrip_mms.template warnings.pl +____________________________________________________________________________ +[ 4949] By: gsar on 2000/02/02 06:41:17 + Log: fix broken abs2rel() (from François Allard <franka@host.ott.igs.net>) + Branch: perl + ! lib/File/Spec/Win32.pm +____________________________________________________________________________ +[ 4948] By: gsar on 2000/02/02 06:30:41 + Log: makefile tweak + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4947] By: gsar on 2000/02/02 06:27:43 + Log: future-proof unknown warning categories (from Greg Bacon + <gbacon@cs.uah.edu>) + Branch: perl + ! lib/warnings.pm t/pragma/warn/2use warnings.pl +____________________________________________________________________________ +[ 4946] By: gsar on 2000/02/02 06:21:34 + Log: doc tweak (from Michael G Schwern <schwern@pobox.com>) + Branch: perl + ! lib/Text/Tabs.pm +____________________________________________________________________________ +[ 4945] By: gsar on 2000/02/02 06:03:04 + Log: more meaningful message on invalid pattern argument (from + Kevin Meltzer <KMeltzer@USCO.com>) + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 4944] By: gsar on 2000/02/02 05:43:49 + Log: XSLoader build patch for VMS (from Craig A. Berry + <craig.berry@metamorgs.com>) + Branch: perl + ! vms/descrip_mms.template +____________________________________________________________________________ +[ 4943] By: gsar on 2000/02/02 03:40:49 + Log: reword some sections of perlunicode.pod + Branch: perl + ! pod/perlunicode.pod +____________________________________________________________________________ +[ 4942] By: gsar on 2000/02/01 21:02:01 + Log: AIX warning on undefined symbol + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 4941] By: gsar on 2000/02/01 20:29:30 + Log: HINT_UTF8 is not propagated to the op tree anymore; add a + perlunicode.pod that reflects changes to unicode support so far + Branch: perl + + pod/perlunicode.pod + ! MANIFEST lib/byte.pm lib/byte_heavy.pl lib/utf8.pm op.c perl.h + ! pod/perldelta.pod pp_ctl.c regcomp.c regexec.c utf8.h +____________________________________________________________________________ +[ 4940] By: jhi on 2000/02/01 12:22:30 + Log: Integrate with Sarathy. + Branch: cfgperl + !> embed.pl embedvar.h global.sym gv.c intrpvar.h + !> lib/charnames.pm lib/utf8.pm mg.c objXSUB.h op.c op.h + !> perlapi.c perlapi.h pod/perlvar.pod pp.c sv.c sv.h + !> t/lib/charnames.t toke.c win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 4939] By: gsar on 2000/02/01 08:52:16 + Log: export pregexec(), Tk uses it + Branch: perl + ! embed.pl global.sym objXSUB.h perlapi.c +____________________________________________________________________________ +[ 4938] By: gsar on 2000/02/01 04:00:09 + Log: mark literal utf8 in string literals properly + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4937] By: gsar on 2000/01/31 20:19:34 + Log: introduce $^U, a global bit to indicate whether system + calls should using widechar APIs; chr and sprintf "%c" also + follow this flag in the absense of "use byte"; "use utf8" + sets $^U=1 (this appears kludgey) + Branch: perl + ! embedvar.h gv.c intrpvar.h lib/charnames.pm lib/utf8.pm mg.c + ! op.c op.h perlapi.h pod/perlvar.pod pp.c sv.c sv.h + ! t/lib/charnames.t win32/win32.h +____________________________________________________________________________ +[ 4936] By: jhi on 2000/01/31 20:17:44 + Log: HP-UX (induced) fixes. + Branch: cfgperl + ! Configure config_h.SH hints/hpux.sh + Branch: metaconfig + ! U/modified/Oldconfig.U U/modified/libs.U + Branch: metaconfig/U/perl + ! quadfio.U +____________________________________________________________________________ +[ 4935] By: jhi on 2000/01/31 19:15:43 + Log: Cosmetics. + Branch: metaconfig + ! U/compline/d_gconvert.U +____________________________________________________________________________ +[ 4934] By: jhi on 2000/01/31 19:15:22 + Log: Cppsym saga continues. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Cppsym.U +____________________________________________________________________________ +[ 4933] By: gsar on 2000/01/31 18:45:07 + Log: !USING_WIDE() branch is busted in win32_stat() + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 4932] By: jhi on 2000/01/31 06:41:47 + Log: Reveal even more symbols. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Cppsym.U +____________________________________________________________________________ +[ 4931] By: jhi on 2000/01/31 06:21:41 + Log: Integrate with Sarathy. + Branch: cfgperl + - lib/caller.pm + !> (integrate 29 files) +____________________________________________________________________________ +[ 4930] By: gsar on 2000/01/31 04:57:42 + Log: runtime now looks at the SVf_UTF8 bit on the SV to decide + whether to use widechar semantics; lexer and RE engine continue + to need "use utf8" to enable unicode awareness in literals + and patterns (TODO: this needs to be fixed); $1 et al are marked + SvUTF8 if the pattern was compiled for utf8 (TODO: propagating + it from the data is probably better) + Branch: perl + ! doop.c gv.c mg.c op.c op.h pp.c pp_ctl.c pp_hot.c regcomp.c + ! sv.c t/pragma/warn/doop t/pragma/warn/pp t/pragma/warn/sv + ! t/pragma/warn/toke t/pragma/warn/utf8 toke.c utf8.h +____________________________________________________________________________ +[ 4929] By: gsar on 2000/01/31 04:17:09 + Log: remove caller.pm from change#3534 (flawed idea) + Branch: perl + - lib/caller.pm + ! MANIFEST pod/perldelta.pod pod/perlfunc.pod +____________________________________________________________________________ +[ 4928] By: gsar on 2000/01/31 04:16:01 + Log: fix factual regression (-e doesn't create temporary files anymore) + Branch: perl + ! pod/perlfilter.pod +____________________________________________________________________________ +[ 4927] By: gsar on 2000/01/30 21:27:12 + Log: introduce $^V (eq chr($revision) . chr($version) . chr($subversion)); + document version tuples + Branch: perl + ! gv.c pod/perldelta.pod pod/perlfunc.pod pod/perlop.pod + ! pod/perlvar.pod +____________________________________________________________________________ +[ 4926] By: gsar on 2000/01/28 18:10:12 + Log: implement -follow option in find2perl (from Helmut Jarausch + <jarausch@igpm.rwth-aachen.de>) + Branch: perl + ! lib/File/Find.pm x2p/find2perl.PL +____________________________________________________________________________ +[ 4925] By: gsar on 2000/01/28 18:03:28 + Log: document what chdir() without an argument does (from Mark-Jason + Dominus <mjd@plover.com>) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4924] By: gsar on 2000/01/28 17:49:34 + Log: README.cygwin update (from Eric Fifer <EFifer@sanwaint.com>) + Branch: perl + ! README.cygwin +____________________________________________________________________________ +[ 4923] By: gsar on 2000/01/28 17:10:08 + Log: avoid leaking lexicals into program being debugged (from Ilya + Zakharevich) + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 4922] By: gsar on 2000/01/28 16:36:13 + Log: perldelta note about export list changes + Branch: perl + ! Changes pod/perldelta.pod +____________________________________________________________________________ [ 4921] By: gsar on 2000/01/28 15:49:04 Log: alias realpath() to abs_path() (from Tom Christiansen) Branch: perl @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Mon Jan 31 22:19:42 EET 2000 [metaconfig 3.0 PL70] +# Generated on Wed Jan 26 09:59:39 EET 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -907,6 +907,66 @@ if test -f /etc/unixtovms.exe; then fi i_whoami='' +: list of known cpp symbols, sorted alphabetically +al="386BSD 3b1 a29k ABI64 aegis AES_SOURCE AIX AIX32 AIX370" +al="$al AIX41 AIX42 AIX43 AIX_SOURCE aixpc ALL_SOURCE" +al="$al alliant alpha am29000 AM29000 amiga AMIGAOS AMIX" +al="$al ansi ANSI_C_SOURCE apollo ardent atarist att386 att3b BeOS" +al="$al BIG_ENDIAN BIT_MSF bsd BSD bsd43 bsd4_2 bsd4_3 BSD4_3 bsd4_4" +al="$al BSD_4_3 BSD_4_4 BSD_NET2 BSD_TIME BSD_TYPES BSDCOMPAT bsdi" +al="$al bull c cadmus clipper CMU COFF COMPILER_VERSION" +al="$al concurrent convex cpu cray CRAY CRAYMPP ctix CX_UX" +al="$al CYGWIN DGUX DGUX_SOURCE DJGPP dmert DOLPHIN DPX2 DSO" +al="$al Dynix DynixPTX ELF encore EPI EXTENSIONS FILE_OFFSET_BITS" +al="$al FreeBSD GCC_NEW_VARARGS gcos gcx gimpel" +al="$al GNU_SOURCE GNUC GNUC_MINOR GO32 gould GOULD_PN" +al="$al H3050R H3050RX hbullx20 hcx host_mips" +al="$al hp200 hp300 hp700 HP700 hp800 hp9000" +al="$al hp9000s200 hp9000s300 hp9000s400 hp9000s500" +al="$al hp9000s700 hp9000s800 hp9k8 hp_osf hppa hpux HPUX_SOURCE" +al="$al i186 i286 i386 i486 i586 i686 i8086 i80960 i860 I960" +al="$al iAPX286 ibm ibm032 ibmesa IBMR2 ibmrt ILP32 ILP64" +al="$al INLINE_INTRINSICS INTRINSICS INT64 interdata is68k ksr1" +al="$al LANGUAGE_C LARGE_FILE_API LARGEFILE64_SOURCE" +al="$al LARGEFILE_SOURCE LFS64_LARGEFILE LFS_LARGEFILE" +al="$al Linux LITTLE_ENDIAN LONG64 LONG_DOUBLE LONG_LONG" +al="$al LONGDOUBLE LONGLONG LP64 luna luna88k Lynx" +al="$al M68000 m68k m88100 m88k M88KBCS_TARGET M_COFF" +al="$al M_I186 M_I286 M_I386 M_I8086 M_I86 M_I86SM M_SYS3" +al="$al M_SYS5 M_SYSIII M_SYSV M_UNIX M_XENIX MACH machine MachTen" +al="$al MATH_HAS_NO_SIDE_EFFECTS" +al="$al mc300 mc500 mc68000 mc68010 mc68020 mc68030 mc68040" +al="$al mc68060 mc68k mc68k32 mc700 mc88000 mc88100 merlin" +al="$al mert MiNT mips MIPS_FPSET MIPS_ISA MIPS_SIM MIPS_SZINT" +al="$al MIPS_SZLONG MIPS_SZPTR MIPSEB MIPSEL MODERN_C motorola" +al="$al mpeix MSDOS MTXINU MULTIMAX mvs MVS n16 ncl_el ncl_mr" +al="$al NetBSD news1500 news1700 news1800 news1900 news3700" +al="$al news700 news800 news900 NeXT NLS ns16000 ns32000" +al="$al ns32016 ns32332 ns32k nsc32000" +al="$al OCS88 OEMVS OpenBSD os OS2 OS390 osf OSF1 OSF_SOURCE" +al="$al pa_risc PA_RISC1_1 PA_RISC2_0 PARAGON parisc" +al="$al pc532 pdp11 PGC PIC plexus PORTAR posix" +al="$al POSIX1B_SOURCE POSIX2_SOURCE POSIX4_SOURCE" +al="$al POSIX_C_SOURCE POSIX_SOURCE POWER" +al="$al PROTOTYPES PWB pyr QNX R3000 REENTRANT RES Rhapsody RISC6000" +al="$al riscix riscos RT scs SCO sequent sgi SGI_SOURCE sinix" +al="$al SIZE_INT SIZE_LONG SIZE_PTR SOCKET_SOURCE SOCKETS_SOURCE" +al="$al sony sony_news sonyrisc sparc sparclite spectrum" +al="$al stardent stdc STDC_EXT stratos sun sun3 sun386" +al="$al Sun386i svr3 svr4 SVR4_2 SVR4_SOURCE svr5" +al="$al SX system SYSTYPE_BSD SYSTYPE_BSD43 SYSTYPE_BSD44" +al="$al SYSTYPE_SVR4 SYSTYPE_SVR5 SYSTYPE_SYSV SYSV SYSV3 SYSV4 SYSV5" +al="$al sysV68 sysV88 Tek4132 Tek4300 titan" +al="$al tower tower32 tower32_200 tower32_600 tower32_700" +al="$al tower32_800 tower32_850 tss" +al="$al u370 u3b u3b2 u3b20 u3b200 u3b20d u3b5" +al="$al ultrix UMAXV UnicomPBB UnicomPBD UNICOS UNICOSMK" +al="$al unix UNIX95 UNIX99 unixpc unos USGr4 USGr4_2" +al="$al Utek UTek UTS UWIN uxpm uxps vax venix VMESA vms xenix Xenix286" +al="$al XOPEN_SOURCE XOPEN_SOURCE_EXTENDED XPG2 XPG2_EXTENDED" +al="$al XPG3 XPG3_EXTENDED XPG4 XPG4_EXTENDED" +al="$al z8000" + : 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. @@ -2065,8 +2125,7 @@ $eunicefix tr : Try to determine whether config.sh was made on this system case "$config_sh" in '') -myuname=`$uname -a 2>/dev/null` -$test -z "$myuname" && myuname=`hostname 2>/dev/null` +myuname=`( ($uname -a) 2>/dev/null || hostname) 2>&1` # tr '[A-Z]' '[a-z]' would not work in EBCDIC # because the A-Z/a-z are not consecutive. myuname=`echo $myuname | $sed -e 's/^[^=]*=//' -e 's/\///g' | \ @@ -2593,7 +2652,7 @@ esac' cat <<EOM -Perl can be built to take advantage of threads, on some systems. +Perl can be built to take advantage of threads on some systems. To do so, Configure must be run with -Dusethreads. Note that threading is a highly experimental feature, and @@ -2624,6 +2683,10 @@ the 5.005 version (5005threads) and an interpreter-based version (ithreads) that has one interpreter per thread. Both are very experimental. This arrangement exists to help developers work out which one is better. + +If you're a casual user, you probably don't want interpreter-threads +at this time. There doesn't yet exist a way to create threads from +within Perl in this model, i.e., "use Thread;" will NOT work. EOM : Default to ithreads unless overridden on command line or with : old config.sh @@ -3676,42 +3739,42 @@ $define) esac for thislib in $libswanted; do - libname="$thislib" - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then - if $test -a "X$ignore_versioned_solibs" = "X"; then - xxx=/ignored/$xxx - else - libstyle=shared - fi + if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; + $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then + echo "Found -l$thislib (shared)." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then - libstyle=shared + echo "Found -l$thislib (shared)." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac elif xxx=`./loc lib$thislib$_a X $libpth`; $test -f "$xxx"; then - libstyle=static + echo "Found -l$thislib." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac elif xxx=`./loc $thislib$_a X $libpth`; $test -f "$xxx"; then - libstyle=static + echo "Found -l$thislib." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac elif xxx=`./loc lib${thislib}_s$_a X $libpth`; $test -f "$xxx"; then - libstyle=static - libname=${thislib}_s - elif xxx=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$xxx"; then - libstyle="static" - fi - if $test -f "$xxx"; then - if test X"$osname" = Xhpux -a -f /lib/pa20_64/libc.sl; then - case "`file $xxx`" in - *LP64*) ;; - *) xxx=/non/64/bit/$xxx ;; - esac - fi - fi - if $test -f "$xxx"; then - case "$libstyle" in - shared) echo "Found -l$libname (shared)." ;; - static) echo "Found -l$libname." ;; - *) echo "Found -l$libname ($libstyle)." ;; + echo "Found -l${thislib}_s." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l${thislib}_s";; esac + elif xxx=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$xxx"; then + echo "Found -l$thislib." case " $dflt " in *"-l$thislib "*);; - *) dflt="$dflt -l$libname";; + *) dflt="$dflt -l$thislib";; esac else echo "No -l$thislib." @@ -4626,7 +4689,7 @@ $echo $n " patchlevel $patchlevel" $c test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c echo ".)" case "$osname" in -dos|cygwin|vms|win32) +dos|vms) : XXX Should be a Configure test for double-dots in filenames. version=`echo $baserev $patchlevel $subversion | \ $awk '{ printf "%d_%d_%d\n", $1, $2, $3 }'` @@ -7207,7 +7270,6 @@ char *myname = "sprintf"; #include <stdio.h> -#define I_STDLIB $i_stdlib #ifdef I_STDLIB #include <stdlib.h> #endif @@ -13635,111 +13697,66 @@ eval $inhdr set poll.h i_poll eval $inhdr +: get C preprocessor symbols handy echo " " $echo "Guessing which symbols your C compiler and preprocessor define..." >&4 -$cat <<'EOSH' > Cppsym.know -a29k ABI64 aegis AES_SOURCE AIX AIX32 AIX370 -AIX41 AIX42 AIX43 AIX_SOURCE aixpc ALL_SOURCE -alliant alpha am29000 AM29000 amiga AMIGAOS AMIX -ansi ANSI_C_SOURCE apollo ardent atarist att386 att3b BeOS -BIG_ENDIAN BIT_MSF bsd BSD bsd43 bsd4_2 bsd4_3 BSD4_3 bsd4_4 -BSD_4_3 BSD_4_4 BSD_NET2 BSD_TIME BSD_TYPES BSDCOMPAT bsdi -bull c cadmus clipper CMU COFF COMPILER_VERSION -concurrent convex cpu cray CRAY CRAYMPP ctix CX_UX -CYGWIN DGUX DGUX_SOURCE DJGPP dmert DOLPHIN DPX2 DSO -Dynix DynixPTX ELF encore EPI EXTENSIONS FILE_OFFSET_BITS -FreeBSD GCC_NEW_VARARGS gcos gcx gimpel -GNU_SOURCE GNUC GNUC_MINOR GO32 gould GOULD_PN -H3050R H3050RX hbullx20 hcx host_mips -hp200 hp300 hp700 HP700 hp800 hp9000 -hp9000s200 hp9000s300 hp9000s400 hp9000s500 -hp9000s700 hp9000s800 hp9k8 hp_osf hppa hpux HPUX_SOURCE -i186 i286 i386 i486 i586 i686 i8086 i80960 i860 I960 -iAPX286 ibm ibm032 ibmesa IBMR2 ibmrt ILP32 ILP64 -INLINE_INTRINSICS INTRINSICS INT64 interdata is68k ksr1 -LANGUAGE_C LARGE_FILE_API LARGEFILE64_SOURCE -LARGEFILE_SOURCE LFS64_LARGEFILE LFS_LARGEFILE -Linux LITTLE_ENDIAN LONG64 LONG_DOUBLE LONG_LONG -LONGDOUBLE LONGLONG LP64 luna luna88k Lynx -M68000 m68k m88100 m88k M88KBCS_TARGET M_COFF -M_I186 M_I286 M_I386 M_I8086 M_I86 M_I86SM M_SYS3 -M_SYS5 M_SYSIII M_SYSV M_UNIX M_XENIX MACH machine MachTen -MATH_HAS_NO_SIDE_EFFECTS -mc300 mc500 mc68000 mc68010 mc68020 mc68030 mc68040 -mc68060 mc68k mc68k32 mc700 mc88000 mc88100 merlin -mert MiNT mips MIPS_FPSET MIPS_ISA MIPS_SIM MIPS_SZINT -MIPS_SZLONG MIPS_SZPTR MIPSEB MIPSEL MODERN_C motorola -mpeix MSDOS MTXINU MULTIMAX mvs MVS n16 ncl_el ncl_mr -NetBSD news1500 news1700 news1800 news1900 news3700 -news700 news800 news900 NeXT NLS ns16000 ns32000 -ns32016 ns32332 ns32k nsc32000 -OCS88 OEMVS OpenBSD os OS2 OS390 osf OSF1 OSF_SOURCE -pa_risc PA_RISC1_1 PA_RISC2_0 PARAGON parisc -pc532 pdp11 PGC PIC plexus PORTAR posix -POSIX1B_SOURCE POSIX2_SOURCE POSIX4_SOURCE -POSIX_C_SOURCE POSIX_SOURCE POWER -PROTOTYPES PWB pyr QNX R3000 REENTRANT RES Rhapsody RISC6000 -riscix riscos RT scs SCO sequent sgi SGI_SOURCE sinix -SIZE_INT SIZE_LONG SIZE_PTR SOCKET_SOURCE SOCKETS_SOURCE -sony sony_news sonyrisc sparc sparclite spectrum -stardent stdc STDC_EXT stratos sun sun3 sun386 -Sun386i svr3 svr4 SVR4_2 SVR4_SOURCE svr5 -SX system SYSTYPE_BSD SYSTYPE_BSD43 SYSTYPE_BSD44 -SYSTYPE_SVR4 SYSTYPE_SVR5 SYSTYPE_SYSV SYSV SYSV3 SYSV4 SYSV5 -sysV68 sysV88 Tek4132 Tek4300 titan -tower tower32 tower32_200 tower32_600 tower32_700 -tower32_800 tower32_850 tss -u370 u3b u3b2 u3b20 u3b200 u3b20d u3b5 -ultrix UMAXV UnicomPBB UnicomPBD UNICOS UNICOSMK -unix UNIX95 UNIX99 unixpc unos USGr4 USGr4_2 -Utek UTek UTS UWIN uxpm uxps vax venix VMESA vms xenix Xenix286 -XOPEN_SOURCE XOPEN_SOURCE_EXTENDED XPG2 XPG2_EXTENDED -XPG3 XPG3_EXTENDED XPG4 XPG4_EXTENDED -z8000 -EOSH -# Maybe put other stuff here too. -cat <<EOSH >>Cppsym.know -$osname -EOSH +echo $al $osname | $tr ' ' $trnl >Cppsym.know ./tr '[a-z]' '[A-Z]' < Cppsym.know > Cppsym.a ./tr '[A-Z]' '[a-z]' < Cppsym.know > Cppsym.b -$cat Cppsym.a Cppsym.b | $tr ' ' $trnl | sort | uniq > Cppsym.know -$rm -f Cppsym.a Cppsym.b -cat <<EOSH > Cppsym +cat Cppsym.a Cppsym.b >> Cppsym.know +$sed 's/^/_/' < Cppsym.know > Cppsym.a +$sed 's/^/__/' < Cppsym.know > Cppsym.b +$sed 's/\(.*\)/__\1__/' < Cppsym.know > Cppsym.c +$cat Cppsym.know Cppsym.a Cppsym.b Cppsym.c | sort | uniq > Cppsym.d +mv Cppsym.d Cppsym.know +rm Cppsym.? +$cat <<EOSS >Cppsym $startsh -if $test \$# -gt 0; then - echo \$* | $tr " " "$trnl" | ./Cppsym.try > Cppsym.got -else - $tr " " "$trnl" | ./Cppsym.try > Cppsym.got -fi -$test -s Cppsym.got && exit 0 -exit 1 -EOSH +case "\$1" in +-l) list=true + shift + ;; +esac +unknown='' +case "\$list\$#" in +1|2) + for sym do + if $contains "^\$1$" Cppsym.true >/dev/null 2>&1; then + exit 0 + elif $contains "^\$1$" Cppsym.know >/dev/null 2>&1; then + : + else + unknown="\$unknown \$sym" + fi + done + set X \$unknown + shift + ;; +esac +case \$# in +0) exit 1;; +esac +echo \$* | $tr ' ' '$trnl' | $sed -e 's/\(.*\)/\\ +#ifdef \1\\ +exit 0; _ _ _ _\1\\ \1\\ +#endif\\ +/' >Cppsym\$\$ +echo "exit 1; _ _ _" >>Cppsym\$\$ +$cppstdin $cppminus <Cppsym\$\$ | $grep '^exit [01]; _ _' >Cppsym2\$\$ +case "\$list" in +true) $awk 'NF > 5 {print substr(\$6,2,100)}' <Cppsym2\$\$ ;; +*) + sh Cppsym2\$\$ + status=\$? + ;; +esac +$rm -f Cppsym\$\$ Cppsym2\$\$ +exit \$status +EOSS chmod +x Cppsym $eunicefix Cppsym -cat <<EOSH > Cppsym.try -cat <<'EOCP' > try.c -#include <stdio.h> -int main() { -EOCP -$awk \\ -EOSH -cat <<'EOSH' >> Cppsym.try -'length($1) > 0 { - printf "#ifdef %s\nprintf(\"%s\\n\");\n#endif\n", $1, $1 - printf "#ifdef _%s\nprintf(\"_%s\\n\");\n#endif\n", $1, $1 - printf "#ifdef __%s\nprintf(\"__%s\\n\");\n#endif\n", $1, $1 - printf "#ifdef __%s__\nprintf(\"__%s__\\n\");\n#endif\n", $1, $1 }' \ - >> try.c -echo '}' >> try.c -EOSH -cat <<'EOSH' >> Cppsym.try -set try -eval $compile_ok && ./try$exe_ext -EOSH -chmod +x Cppsym.try -$eunicefix Cppsym.try -./Cppsym < Cppsym.know > Cppsym.true +./Cppsym -l $al | $sort | $grep -v '^$' >Cppsym.true + : now check the C compiler for additional symbols postprocess_cc_v='' case "$osname" in @@ -917,7 +917,7 @@ to turn off each extension: SDBM_File (Always included by default) Opcode useopcode Socket d_socket - Threads usethreads + Threads use5005threads attrs (Always included by default) Thus to skip the NDBM_File extension, you can use @@ -626,10 +626,12 @@ lib/Net/netent.pm By-name interface to Perl's builtin getnet* lib/Net/protoent.pm By-name interface to Perl's builtin getproto* lib/Net/servent.pm By-name interface to Perl's builtin getserv* lib/Pod/Checker.pm Pod-Parser - check POD documents for syntax errors +lib/Pod/Find.pm used by pod/splitpod lib/Pod/Functions.pm used by pod/splitpod lib/Pod/Html.pm Convert POD data to HTML lib/Pod/InputObjects.pm Pod-Parser - define objects for input streams lib/Pod/Man.pm Convert POD data to *roff +lib/Pod/ParseUtils.pm Pod-Parser - pod utility functions lib/Pod/Parser.pm Pod-Parser - define base class for parsing POD lib/Pod/Select.pm Pod-Parser - select portions of POD docs lib/Pod/Text.pm Pod-Parser - convert POD data to formatted ASCII text diff --git a/Porting/makerel b/Porting/makerel index f51b4a5478..2052fc85f7 100644 --- a/Porting/makerel +++ b/Porting/makerel @@ -22,17 +22,12 @@ my @patchlevel_h = <PATCHLEVEL>; close PATCHLEVEL; my $patchlevel_h = join "", grep { /^#\s*define/ } @patchlevel_h; print $patchlevel_h; +$revision = $1 if $patchlevel_h =~ /PERL_REVISION\s+(\d+)/; $patchlevel = $1 if $patchlevel_h =~ /PERL_VERSION\s+(\d+)/; $subversion = $1 if $patchlevel_h =~ /PERL_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.= " "; -} +$vers = sprintf("%d.%d.%d", $revision, $patchlevel, $subversion); +$vms_vers = sprintf("%d_%d_%d", $revision, $patchlevel, $subversion); # fetch list of local patches my (@local_patches, @lpatch_tags, $lpatch_tags); diff --git a/README.threads b/README.threads index b02e607d2b..1f5f7ea070 100644 --- a/README.threads +++ b/README.threads @@ -1,7 +1,20 @@ -NOTE +NOTE: This documentation describes the style of threading that was +available in 5.005. Perl v5.6 also has the early beginnings of +interpreter-based threads support (which is what will be enabled by +default when you simply ask for -Dusethreads). However, be advised +that interpreter threads cannot as yet be created from the Perl level +yet. If you're looking to create threads from within Perl, chances +are you _don't_ want interpreter threads, but want the older support +for threads described below, enabled with: + + sh Configure -Dusethreads -Duse5005threads + +The rest of this document only applies to the use5005threads style of +threads. +--------------------------------------------------------------------------- -Threading is a highly experimental feature. There are still a -few race conditions that show up under high contention on SMP +Support for threading is still in the highly experimental stages. There +are known race conditions that show up under high contention on SMP machines. Internal implementation is still subject to changes. It is not recommended for production use at this time. @@ -11,7 +24,7 @@ Building If your system is in the following list you should be able to just: - ./Configure -Dusethreads -des + ./Configure -Dusethreads -Duse5005threads -des make and ignore the rest of this "Building" section. If not, continue @@ -58,7 +71,7 @@ subdirectory. On platforms that use Configure to build perl, omit the -d from your ./Configure arguments. For example, use: - ./Configure -Dusethreads + ./Configure -Dusethreads -Duse5005threads When Configure prompts you for ccflags, insert any other arguments in there that your compiler needs to use POSIX threads (-D_REENTRANT, @@ -168,8 +181,8 @@ has this fixed but the following patch can be applied to 0.5 for now: Building the Thread extension The Thread extension is now part of the main perl distribution tree. -If you did Configure -Dusethreads then it will have been added to -the list of extensions automatically. +If you did Configure -Dusethreads -Duse5005threads then it will have been +added to the list of extensions automatically. You can try some of the tests with cd ext/Thread @@ -821,7 +821,7 @@ EXT void *PL_force_link_funcs[] = { #undef PERLVARA #undef PERLVARI #undef PERLVARIC -#define PERLVAR(v,t) Perl_##v##_ptr, +#define PERLVAR(v,t) (void*)Perl_##v##_ptr, #define PERLVARA(v,n,t) PERLVAR(v,t) #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v,t) diff --git a/hints/dynixptx.sh b/hints/dynixptx.sh index 5320030176..11c6b5b3b0 100644 --- a/hints/dynixptx.sh +++ b/hints/dynixptx.sh @@ -19,9 +19,8 @@ libswanted=`echo $libswanted | sed -e 's/ inet / /'` # Configure defaults to usenm='y', which doesn't work very well usenm='n' -# for performance, apparently this makes a huge difference (~krader) +# removed d_vfork='define'; we can't use it any more ... -d_vfork='define' case "$optimize" in '') optimize='-Wc,-O3 -W0,-xstring' ;; esac diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index f9ade27bc5..3c10a5bc52 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -423,14 +423,14 @@ sub timestr { 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); + my($pt, $ct, $tt) = ($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'; + $r,$pu,$ps,$cu,$cs,$tt) 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)", diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 5a23911437..e3c45903c3 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -342,7 +342,7 @@ sub _qnx_abs_path { } { - local $^W = 0; # assignments trigger 'subroutine redefined' warning + no warnings; # assignments trigger 'subroutine redefined' warning if ($^O eq 'VMS') { *cwd = \&_vms_cwd; diff --git a/lib/English.pm b/lib/English.pm index 9f29a487dc..86d75a4268 100644 --- a/lib/English.pm +++ b/lib/English.pm @@ -15,14 +15,6 @@ English - use nice English (or awk) names for ugly punctuation variables =head1 DESCRIPTION -You should I<not> use this module in programs intended to be portable -among Perl versions, programs that must perform regular expression -matching operations efficiently, or libraries intended for use with -such programs. In a sense, this module is deprecated. The reasons -for this have to do with implementation details of the Perl -interpreter which are too thorny to go into here. Perhaps someday -they will be fixed to make "C<use English>" more practical. - This module provides aliases for the built-in variables whose names no one seems to like to read. Variables with side-effects which get triggered just by accessing them (like $0) will still @@ -35,9 +27,15 @@ $INPUT_RECORD_SEPARATOR if you are using the English module. See L<perlvar> for a complete list of these. +=head1 BUGS + +This module provokes sizeable inefficiencies for regular expressions, +due to unfortunate implementation details. If performance matters, +consider avoiding English. + =cut -local $^W = 0; +no warnings; # Grandfather $NAME import sub import { diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index f4329e13d7..c5cf7066bf 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -2766,7 +2766,7 @@ sub parse_version { $_ }; \$$2 }; - local($^W) = 0; + no warnings; $result = eval($eval); warn "Could not eval '$eval' in $parsefile: $@" if $@; $result = "undef" unless defined $result; diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index 534f26d823..e08c6791ee 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -388,7 +388,6 @@ PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ sub path { - local $^W = 1; my($self) = @_; my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; my @path = split(';',$path); diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index 58c91bc44b..8bb3fc8ebd 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -25,7 +25,7 @@ $MANIFEST = 'MANIFEST'; # Really cool fix from Ilya :) unless (defined $Config{d_link}) { - local $^W; + no warnings; *ln = \&cp; } diff --git a/lib/Fatal.pm b/lib/Fatal.pm index 12fef27d61..5b832f6427 100644 --- a/lib/Fatal.pm +++ b/lib/Fatal.pm @@ -116,7 +116,7 @@ EOS no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ... $code = eval("package $pkg; use Carp; $code"); die if $@; - local($^W) = 0; # to avoid: Subroutine foo redefined ... + no warnings; # to avoid: Subroutine foo redefined ... *{$sub} = $code; } } diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 48ad8479c7..120b799cd2 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -81,7 +81,6 @@ sub catfile { } sub path { - local $^W = 1; my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; my @path = split(';',$path); foreach (@path) { $_ = '.' if $_ eq '' } diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 1a9195e185..d8d643ca3e 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -74,7 +74,7 @@ sub fnorm; sub fsqrt; sub fnorm { #(string) return fnum_str local($_) = @_; s/\s+//g; # strip white space - local $^W = 0; # $4 and $5 below might legitimately be undefined + no warnings; # $4 and $5 below might legitimately be undefined if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') { &norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6)); } else { diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm index aa5c5490ae..c661c7527e 100644 --- a/lib/Pod/Checker.pm +++ b/lib/Pod/Checker.pm @@ -10,9 +10,11 @@ package Pod::Checker; use vars qw($VERSION); -$VERSION = 1.090; ## Current version of this package +$VERSION = 1.096; ## Current version of this package require 5.004; ## requires this Perl version or later +use Pod::ParseUtils; ## for hyperlinks and lists + =head1 NAME Pod::Checker, podchecker() - check pod documents for syntax errors @@ -23,15 +25,19 @@ Pod::Checker, podchecker() - check pod documents for syntax errors $syntax_okay = podchecker($filepath, $outputpath, %options); + my $checker = new Pod::Checker %options; + =head1 OPTIONS/ARGUMENTS C<$filepath> is the input POD to read and C<$outputpath> is where to write POD syntax error messages. Either argument may be a scalar -indcating a file-path, or else a reference to an open filehandle. +indicating a file-path, or else a reference to an open filehandle. If unspecified, the input-file it defaults to C<\*STDIN>, and the output-file defaults to C<\*STDERR>. -=head2 Options +=head2 podchecker() + +This function can take a hash of options: =over 4 @@ -45,20 +51,25 @@ Turn warnings on/off. See L<"Warnings">. B<podchecker> will perform syntax checking of Perl5 POD format documentation. -I<NOTE THAT THIS MODULE IS CURRENTLY IN THE INITIAL DEVELOPMENT STAGE!> -As of this writing, all it does is check for unknown '=xxxx' commands, -unknown 'X<...>' interior-sequences, and unterminated interior sequences. +I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!> It is hoped that curious/ambitious user will help flesh out and add the -additional features they wish to see in B<Pod::Checker> and B<podchecker>. +additional features they wish to see in B<Pod::Checker> and B<podchecker> +and verify that the checks are consistent with L<perlpod>. -The following additional checks are preformed: +The following checks are preformed: =over 4 =item * -Check for proper balancing of C<=begin> and C<=end>. +Unknown '=xxxx' commands, unknown 'X<...>' interior-sequences, +and unterminated interior sequences. + +=item * + +Check for proper balancing of C<=begin> and C<=end>. The contents of such +a block are generally ignored, i.e. no syntax checks are performed. =item * @@ -66,55 +77,156 @@ Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. =item * -Check for same nested interior-sequences (e.g. C<LE<lt>...LE<lt>...E<gt>...E<gt>>). +Check for same nested interior-sequences (e.g. +C<LE<lt>...LE<lt>...E<gt>...E<gt>>). =item * -Check for malformed entities. +Check for malformed or nonexisting entities C<EE<lt>...E<gt>>. =item * -Check for correct syntax of hyperlinks C<LE<lt>E<gt>>. See L<perlpod> for -details. +Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod> +for details. =item * -Check for unresolved document-internal links. +Check for unresolved document-internal links. This check may also reveal +misspelled links that seem to be internal links but should be links +to something else. =back -=head2 Warnings +=head2 Additional Features + +While checking, this module collects document properties, e.g. the nodes +for hyperlinks (C<=headX>, C<=item>). POD translators can use this feature +to syntax-check and get the nodes in a first pass before actually starting +to convert. This is expensive in terms of execution time, but allows for +very robust conversions. + +=head1 DIAGNOSTICS -The following warnings are printed. These may not necessarily cause trouble, -but indicate mediocre style. +=head2 Errors =over 4 -=item * +=item * =over on line I<N> without closing =back -Spurious characters after C<=back> and C<=end>. +The C<=over> command does not have a corresponding C<=back> before the +next heading (C<=head1> or C<=head2>) or the end of the file. -=item * +=item * =item without previous =over -Unescaped C<E<lt>> and C<E<gt>> in the text. +=item * =back without previous =over -=item * +An C<=item> or C<=back> command has been found outside a +C<=over>/C<=back> block. -Missing arguments for C<=begin> and C<=over>. +=item * No argument for =begin -=item * +A C<=begin> command was found that is not followed by the formatter +specification. -Empty C<=over> / C<=back> list. +=item * =end without =begin -=item * +A standalone C<=end> command was found. + +=item * Nested =begin's + +There were at least two concecutive C<=begin> commands without +the corresponding C<=end>. Only one C<=begin> may be active at +a time. + +=item * =for without formatter specification -Hyperlinks: leading/trailing whitespace, brackets C<()> in the page name. +There is no specification of the formatter after the C<=for> command. + +=item * unresolved internal link I<NAME> + +The given link to I<NAME> does not have a matching node in the current +POD. This also happend when a single word node name is not enclosed in +C<"">. + +=item * Unknown command "I<CMD>" + +An invalid POD command has been found. Valid are C<=head1>, C<=head2>, +C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, C<=for>, C<=pod>, +C<=cut> + +=item * Unknown interior-sequence "I<SEQ>" + +An invalid markup command has been encountered. Valid are: +C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, +C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, +C<ZE<lt>E<gt>> + +=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt> + +Two nested identical markup commands have been found. Generally this +does not make sense. + +=item * garbled entity I<STRING> + +The I<STRING> found cannot be interpreted as an character entity. + +=item * malformed link LE<lt>E<gt> + +The link found cannot be parsed because it does not conform to the +syntax described in L<perlpod>. =back -=head1 DIAGNOSTICS +=head2 Warnings -I<[T.B.D.]> +These may not necessarily cause trouble, but indicate mediocre style. + +=over 4 + +=item * No numeric argument for =over + +The C<=over> command is supposed to have a numeric argument (the +indentation). + +=item * Spurious character(s) after =back + +The C<=back> command does not take any arguments. + +=item * I<N> unescaped C<E<lt>E<gt>> in paragraph + +Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> +can potentially cause errors as they could be misinterpreted as +markup commands. + +=item * Non-standard entity + +A character entity was found that does not belong to the standard +ISO set. + +=item * No items in =over + +The list does not contain any items. + +=item * No argument for =item + +C<=item> without any parameters is deprecated. It should either be followed +by C<*> to indicate an unordered list, by a number (optionally followed +by a dot) to indicate an ordered (numbered) list or simple text for a +definition list. + +=item * Verbatim paragraph in NAME section + +The NAME section (C<=head1 NAME>) should consist of a single paragraph +with the script/module name, followed by a dash `-' and a very short +description of what the thing is good for. + +=item * Hyperlinks + +There are some warnings wrt. hyperlinks: +Leading/trailing whitespace, newlines in hyperlinks, +brackets C<()>. + +=back =head1 RETURN VALUE @@ -174,6 +286,117 @@ my %VALID_SEQUENCES = ( 'E' => 1, ); +# stolen from HTML::Entities +my %ENTITIES = ( + # Some normal chars that have special meaning in SGML context + amp => '&', # ampersand +'gt' => '>', # greater than +'lt' => '<', # less than + quot => '"', # double quote + + # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML + AElig => 'Æ', # capital AE diphthong (ligature) + Aacute => 'Á', # capital A, acute accent + Acirc => 'Â', # capital A, circumflex accent + Agrave => 'À', # capital A, grave accent + Aring => 'Å', # capital A, ring + Atilde => 'Ã', # capital A, tilde + Auml => 'Ä', # capital A, dieresis or umlaut mark + Ccedil => 'Ç', # capital C, cedilla + ETH => 'Ð', # capital Eth, Icelandic + Eacute => 'É', # capital E, acute accent + Ecirc => 'Ê', # capital E, circumflex accent + Egrave => 'È', # capital E, grave accent + Euml => 'Ë', # capital E, dieresis or umlaut mark + Iacute => 'Í', # capital I, acute accent + Icirc => 'Î', # capital I, circumflex accent + Igrave => 'Ì', # capital I, grave accent + Iuml => 'Ï', # capital I, dieresis or umlaut mark + Ntilde => 'Ñ', # capital N, tilde + Oacute => 'Ó', # capital O, acute accent + Ocirc => 'Ô', # capital O, circumflex accent + Ograve => 'Ò', # capital O, grave accent + Oslash => 'Ø', # capital O, slash + Otilde => 'Õ', # capital O, tilde + Ouml => 'Ö', # capital O, dieresis or umlaut mark + THORN => 'Þ', # capital THORN, Icelandic + Uacute => 'Ú', # capital U, acute accent + Ucirc => 'Û', # capital U, circumflex accent + Ugrave => 'Ù', # capital U, grave accent + Uuml => 'Ü', # capital U, dieresis or umlaut mark + Yacute => 'Ý', # capital Y, acute accent + aacute => 'á', # small a, acute accent + acirc => 'â', # small a, circumflex accent + aelig => 'æ', # small ae diphthong (ligature) + agrave => 'à', # small a, grave accent + aring => 'å', # small a, ring + atilde => 'ã', # small a, tilde + auml => 'ä', # small a, dieresis or umlaut mark + ccedil => 'ç', # small c, cedilla + eacute => 'é', # small e, acute accent + ecirc => 'ê', # small e, circumflex accent + egrave => 'è', # small e, grave accent + eth => 'ð', # small eth, Icelandic + euml => 'ë', # small e, dieresis or umlaut mark + iacute => 'í', # small i, acute accent + icirc => 'î', # small i, circumflex accent + igrave => 'ì', # small i, grave accent + iuml => 'ï', # small i, dieresis or umlaut mark + ntilde => 'ñ', # small n, tilde + oacute => 'ó', # small o, acute accent + ocirc => 'ô', # small o, circumflex accent + ograve => 'ò', # small o, grave accent + oslash => 'ø', # small o, slash + otilde => 'õ', # small o, tilde + ouml => 'ö', # small o, dieresis or umlaut mark + szlig => 'ß', # small sharp s, German (sz ligature) + thorn => 'þ', # small thorn, Icelandic + uacute => 'ú', # small u, acute accent + ucirc => 'û', # small u, circumflex accent + ugrave => 'ù', # small u, grave accent + uuml => 'ü', # small u, dieresis or umlaut mark + yacute => 'ý', # small y, acute accent + yuml => 'ÿ', # small y, dieresis or umlaut mark + + # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) + copy => '©', # copyright sign + reg => '®', # registered sign + nbsp => "\240", # non breaking space + + # Additional ISO-8859/1 entities listed in rfc1866 (section 14) + iexcl => '¡', + cent => '¢', + pound => '£', + curren => '¤', + yen => '¥', + brvbar => '¦', + sect => '§', + uml => '¨', + ordf => 'ª', + laquo => '«', +'not' => '¬', # not is a keyword in perl + shy => '', + macr => '¯', + deg => '°', + plusmn => '±', + sup1 => '¹', + sup2 => '²', + sup3 => '³', + acute => '´', + micro => 'µ', + para => '¶', + middot => '·', + cedil => '¸', + ordm => 'º', + raquo => '»', + frac14 => '¼', + frac12 => '½', + frac34 => '¾', + iquest => '¿', +'times' => '×', # times is a keyword in perl + divide => '÷', +); + ##--------------------------------------------------------------------------- ##--------------------------------- @@ -219,16 +442,18 @@ sub initialize { ## Initialize number of errors, and setup an error function to ## increment this number and then print to the designated output. $self->{_NUM_ERRORS} = 0; - $self->errorsub('poderror'); + $self->errorsub('poderror'); # set the error handling subroutine $self->{_commands} = 0; # total number of POD commands encountered $self->{_list_stack} = []; # stack for nested lists $self->{_have_begin} = ''; # stores =begin $self->{_links} = []; # stack for internal hyperlinks $self->{_nodes} = []; # stack for =head/=item nodes + # print warnings? $self->{-warnings} = 1 unless(defined $self->{-warnings}); + $self->{_current_head1} = ''; # the current =head1 block } -## Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) +# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) sub poderror { my $self = shift; my %opts = (ref $_[0]) ? %{shift()} : (); @@ -243,13 +468,43 @@ sub poderror { ++($self->{_NUM_ERRORS}) if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); my $out_fh = $self->output_handle(); - print $out_fh ($severity, $msg, $line, $file, "\n"); + print $out_fh ($severity, $msg, $line, $file, "\n") + if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); } +# set/retrieve the number of errors found sub num_errors { return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; } +# set and/or retrieve canonical name of POD +sub name { + return (@_ > 1 && $_[1]) ? + ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; +} + +# set/return nodes of the current POD +sub node { + my ($self,$text) = @_; + if(defined $text) { + $text =~ s/[\s\n]+$//; # strip trailing whitespace + # add node + push(@{$self->{_nodes}}, $text); + return $text; + } + @{$self->{_nodes}}; +} + +# set/return hyperlinks of the current POD +sub hyperlink { + my $self = shift; + if($_[0]) { + push(@{$self->{_links}}, $_[0]); + return $_[0]; + } + @{$self->{_links}}; +} + ## overrides for Pod::Parser sub end_pod { @@ -273,7 +528,6 @@ sub end_pod { # first build the node names from the paragraph text my %nodes; foreach($self->node()) { - #print "Have node: +$_+\n"; $nodes{$_} = 1; if(/^(\S+)\s+/) { # we have more than one word. Use the first as a node, too. @@ -282,7 +536,6 @@ sub end_pod { } } foreach($self->hyperlink()) { - #print "Seek node: +$_+\n"; my $line = ''; s/^(\d+):// && ($line = $1); if($_ && !$nodes{$_}) { @@ -307,6 +560,7 @@ sub end_pod { } } +# check a POD command directive sub command { my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; my ($file, $line) = $pod_para->file_line; @@ -320,32 +574,47 @@ sub command { $self->{_commands}++; # found a valid command ## check syntax of particular command if($cmd eq 'over') { + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line,$file); + my $indent = 4; # default + if($arg && $arg =~ /^\s*(\d+)\s*$/) { + $indent = $1; + } else { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "No numeric argument for =over"}); + } # start a new list - unshift(@{$self->{_list_stack}}, - Pod::List->new( - -indent => $paragraph, + unshift(@{$self->{_list_stack}}, Pod::List->new( + -indent => $indent, -start => $line, -file => $file)); } elsif($cmd eq 'item') { + # are we in a list? unless(@{$self->{_list_stack}}) { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', -msg => "=item without previous =over" }); + # auto-open in case we encounter many more + unshift(@{$self->{_list_stack}}, + Pod::List->new( + -indent => 'auto', + -start => $line, + -file => $file)); } - else { - # check for argument - $arg = $self->_interpolate_and_check($paragraph, $line, $file); - unless($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "No argument for =item" }); - } - # add this item - $self->{_list_stack}[0]->item($arg || ''); - # remember this node - $self->node($arg) if($arg); + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line, $file); + unless($arg && $arg =~ /(\S+)/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "No argument for =item" }); + $arg = ' '; # empty } + # add this item + $self->{_list_stack}[0]->item($arg); + # remember this node + $self->node($arg); } elsif($cmd eq 'back') { # check if we have an open list @@ -356,7 +625,7 @@ sub command { } else { # check for spurious characters - $arg = $self->_interpolate_and_check($paragraph, $line,$file); + $arg = $self->interpolate_and_check($paragraph, $line,$file); if($arg && $arg =~ /\S/) { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', @@ -380,13 +649,19 @@ sub command { while($list = shift(@{$self->{_list_stack}})) { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', - -msg => "unclosed =over (line ". $list->start() . - ") at $cmd" }); + -msg => "=over on line ". $list->start() . + " without closing =back (at $cmd)" }); } } # remember this node - $arg = $self->_interpolate_and_check($paragraph, $line,$file); + $arg = $self->interpolate_and_check($paragraph, $line,$file); $self->node($arg) if($arg); + if($cmd eq 'head1') { + $arg =~ s/[\s\n]+$//; + $self->{_current_head1} = $arg; + } else { + $self->{_current_head1} = ''; + } } elsif($cmd eq 'begin') { if($self->{_have_begin}) { @@ -398,10 +673,10 @@ sub command { } else { # check for argument - $arg = $self->_interpolate_and_check($paragraph, $line,$file); + $arg = $self->interpolate_and_check($paragraph, $line,$file); unless($arg && $arg =~ /(\S+)/) { $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', + -severity => 'ERROR', -msg => "No argument for =begin"}); } # remember the =begin @@ -413,27 +688,37 @@ sub command { # close the existing =begin $self->{_have_begin} = ''; # check for spurious characters - $arg = $self->_interpolate_and_check($paragraph, $line,$file); - if($arg && $arg =~ /\S/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "Spurious character(s) after =end" }); - } + $arg = $self->interpolate_and_check($paragraph, $line,$file); + # the closing argument is optional + #if($arg && $arg =~ /\S/) { + # $self->poderror({ -line => $line, -file => $file, + # -severity => 'WARNING', + # -msg => "Spurious character(s) after =end" }); + #} } else { # don't have a matching =begin $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', + -severity => 'ERROR', -msg => "=end without =begin" }); } } - } + elsif($cmd eq 'for') { + unless($paragraph =~ /\s*(\S+)\s*/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "=for without formatter specification" }); + } + $arg = ''; # do not expand paragraph below + } ## Check the interior sequences in the command-text - $self->_interpolate_and_check($paragraph, $line,$file) + $self->interpolate_and_check($paragraph, $line,$file) unless(defined $arg); + } } -sub _interpolate_and_check { +# process a block of some text +sub interpolate_and_check { my ($self, $paragraph, $line, $file) = @_; ## Check the interior sequences in the command-text # and return the text @@ -452,10 +737,11 @@ sub _check_ptree { my $count; # count the unescaped angle brackets my $i = $_; - if($count = $i =~ s/[<>]/$self->expand_unescaped_bracket($&)/ge) { + if($count = $i =~ tr/<>/<>/) { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', - -msg => "$count unescaped <>" }); + -msg => "$count unescaped <> in paragraph" }) + if($self->{-warnings}); } $text .= $i; next; @@ -488,7 +774,21 @@ sub _check_ptree { -msg => "garbled entity " . $_->raw_text()}); next; } - $text .= $self->expand_entity($$contents[0]); + my $ent = $$contents[0]; + if($ent =~ /^\d+$/) { + # numeric entity + $text .= chr($ent); + } + elsif($ENTITIES{$ent}) { + # known ISO entity + $text .= $ENTITIES{$ent}; + } + else { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "Non-standard entity " . $_->raw_text()}); + $text .= "E<$ent>"; + } } elsif($cmd eq 'L') { # try to parse the hyperlink @@ -496,7 +796,7 @@ sub _check_ptree { unless(defined $link) { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', - -msg => "malformed link L<>: $@"}); + -msg => "malformed link " . $_->raw_text() ." : $@"}); next; } $link->line($line); # remember line @@ -511,13 +811,14 @@ sub _check_ptree { $text .= $self->_check_ptree($self->parse_text($link->text(), $line), $line, $file, "$nestlist$cmd"); my $node = ''; - $node = $self->_check_ptree($self->parse_text($link->node(), - $line), $line, $file, "$nestlist$cmd") - if($link->node()); - # store internal link + # remember internal link # _TODO_ what if there is a link to the page itself by the name, - # e.g. Tk::Pod : L<Tk::Pod/"DESCRIPTION"> - $self->hyperlink("$line:$node") if($node && !$link->page()); + # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION"> + if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { + $node = $self->_check_ptree($self->parse_text($link->node(), + $line), $line, $file, "$nestlist$cmd"); + $self->hyperlink("$line:$node") if($node); + } } elsif($cmd =~ /[BCFIS]/) { # add the guts @@ -531,397 +832,35 @@ sub _check_ptree { $text; } -# default method - just return it -sub expand_unescaped_bracket { - my ($self,$bracket) = @_; - $bracket; -} - -# keep the entities -sub expand_entity { - my ($self,$entity) = @_; - "E<$entity>"; -} - -# _TODO_ overloadable methods for BC..Z<...> expansion +# _TODO_ overloadable methods for BC..Z<...> expansion? +# process a block of verbatim text sub verbatim { ## Nothing to check - ## my ($self, $paragraph, $line_num, $pod_para) = @_; + my ($self, $paragraph, $line_num, $pod_para) = @_; + if($self->{_current_head1} eq 'NAME') { + my ($file, $line) = $pod_para->file_line; + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => 'Verbatim paragraph in NAME section' }); + } } +# process a block of regular text sub textblock { my ($self, $paragraph, $line_num, $pod_para) = @_; my ($file, $line) = $pod_para->file_line; - $self->_interpolate_and_check($paragraph, $line,$file); -} - -# set/return nodes of the current POD -sub node { - my ($self,$text) = @_; - if(defined $text) { - $text =~ s/[\s\n]+$//; # strip trailing whitespace - # add node - push(@{$self->{_nodes}}, $text); - return $text; - } - @{$self->{_nodes}}; -} - -# set/return hyperlinks of the current POD -sub hyperlink { - my $self = shift; - if($_[0]) { - push(@{$self->{_links}}, $_[0]); - return $_[0]; - } - @{$self->{_links}}; -} - -#----------------------------------------------------------------------------- -# Pod::List -# -# class to hold POD list info (=over, =item, =back) -#----------------------------------------------------------------------------- - -package Pod::List; - -use Carp; - -sub new { - my $this = shift; - my $class = ref($this) || $this; - my %params = @_; - my $self = {%params}; - bless $self, $class; - $self->initialize(); - return $self; -} - -sub initialize { - my $self = shift; - $self->{-file} ||= 'unknown'; - $self->{-start} ||= 'unknown'; - $self->{-indent} ||= 4; # perlpod: "should be the default" - $self->{_items} = []; -} - -# The POD file name the list appears in -sub file { - return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; -} - -# The line in the file the node appears -sub start { - return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start}; -} - -# indent level -sub indent { - return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent}; -} - -# The individual =items of this list -sub item { - my ($self,$item) = @_; - if(defined $item) { - push(@{$self->{_items}}, $item); - return $item; - } - else { - return @{$self->{_items}}; - } -} - -#----------------------------------------------------------------------------- -# Pod::Hyperlink -# -# class to hold hyperlinks (L<>) -#----------------------------------------------------------------------------- - -package Pod::Hyperlink; - -=head1 NAME - -Pod::Hyperlink - class for manipulation of POD hyperlinks - -=head1 SYNOPSIS - - my $link = Pod::Hyperlink->new('alternative text|page/"section in page"'); - -=head1 DESCRIPTION - -The B<Pod::Hyperlink> class is mainly designed to parse the contents of the -C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the -different parts of a POD hyperlink. - -=head1 METHODS - -=over 4 - -=item new() - -The B<new()> method can either be passed a set of key/value pairs or a single -scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object -of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a -failure, the error message is stored in C<$@>. - -=item parse() - -This method can be used to (re)parse a (new) hyperlink. The result is stored -in the current object. - -=item markup($on,$off,$pageon,$pageoff) - -The result of this method is a string the represents the textual value of the -link, but with included arbitrary markers that highlight the active portion -of the link. This will mainly be used by POD translators and saves the -effort of determining which words have to be highlighted. Examples: Depending -on the type of link, the following text will be returned, the C<*> represent -the places where the section/item specific on/off markers will be placed -(link to a specific node) and C<+> for the pageon/pageoff markers (link to the -top of the page). - - the +perl+ manpage - the *$|* entry in the +perlvar+ manpage - the section on *OPTIONS* in the +perldoc+ manpage - the section on *DESCRIPTION* elsewhere in this document - -This method is read-only. - -=item text() - -This method returns the textual representation of the hyperlink as above, -but without markers (read only). - -=item warning() - -After parsing, this method returns any warnings ecountered during the -parsing process. - -=item page() - -This method sets or returns the POD page this link points to. - -=item node() - -As above, but the destination node text of the link. - -=item type() - -The node type, either C<section> or C<item>. - -=item alttext() - -Sets or returns an alternative text specified in the link. -=item line(), file() - -Just simple slots for storing information about the line and the file -the link was incountered in. Has to be filled in manually. - -=back - -=head1 AUTHOR - -Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, borrowing -a lot of things from L<pod2man> and L<pod2roff>. - -=cut - -use Carp; - -sub new { - my $this = shift; - my $class = ref($this) || $this; - my $self = +{}; - bless $self, $class; - $self->initialize(); - if(defined $_[0]) { - if(ref($_[0])) { - # called with a list of parameters - %$self = %{$_[0]}; - } - else { - # called with L<> contents - return undef unless($self->parse($_[0])); - } - } - return $self; -} - -sub initialize { - my $self = shift; - $self->{-line} ||= 'undef'; - $self->{-file} ||= 'undef'; - $self->{-page} ||= ''; - $self->{-node} ||= ''; - $self->{-alttext} ||= ''; - $self->{-type} ||= 'undef'; - $self->{_warnings} = []; - $self->_construct_text(); -} - -sub parse { - my $self = shift; - local($_) = $_[0]; - # syntax check the link and extract destination - my ($alttext,$page,$section,$item) = ('','','',''); - - # strip leading/trailing whitespace - if(s/^[\s\n]+//) { - $self->warning("ignoring leading whitespace in link"); - } - if(s/[\s\n]+$//) { - $self->warning("ignoring trailing whitespace in link"); - } - - # collapse newlines with whitespace - s/\s*\n\s*/ /g; - - # extract alternative text - if(s!^([^|/"\n]*)[|]!!) { - $alttext = $1; - } - # extract page - if(s!^([^|/"\s]*)(?=/|$)!!) { - $page = $1; - } - # extract section - if(s!^/?"([^"\n]+)"$!!) { # e.g. L</"blah blah"> - $section = $1; - } - # extact item - if(s!^/(.*)$!!) { - $item = $1; - } - # last chance here - if(s!^([^|"\s\n/][^"\n/]*)$!!) { # e.g. L<lah di dah> - $section = $1; - } - # now there should be nothing left - if(length) { - _invalid_link("garbled entry (spurious characters `$_')"); - return undef; - } - elsif(!(length($page) || length($section) || length($item))) { - _invalid_link("empty link"); - return undef; - } - elsif($alttext =~ /[<>]/) { - _invalid_link("alternative text contains < or >"); - return undef; - } - else { # no errors so far - if($page =~ /[(]\d\w*[)]$/) { - $self->warning("brackets in `$page'"); - $page = $`; # strip that extension - } - if($page =~ /^(\s*)(\S+)(\s*)/ && (length($1) || length($3))) { - $self->warning("whitespace in `$page'"); - $page = $2; # strip that extension + # skip this paragraph if in a =begin block + unless($self->{_have_begin}) { + my $block = $self->interpolate_and_check($paragraph, $line,$file); + if($self->{_current_head1} eq 'NAME') { + if($block =~ /^\s*(\S+?)\s*[,-]/) { + # this is the canonical name + $self->{-name} = $1 unless(defined $self->{-name}); + } } } - $self->page($page); - $self->node($section || $item); # _TODO_ do not distinguish for now - $self->alttext($alttext); - $self->type($item ? 'item' : 'section'); - 1; -} - -sub _construct_text { - my $self = shift; - my $alttext = $self->alttext(); - my $type = $self->type(); - my $section = $self->node(); - my $page = $self->page(); - $self->{_text} = - $alttext ? $alttext : ( - !$section ? '' : - $type eq 'item' ? 'the ' . $section . ' entry' : - 'the section on ' . $section ) . - ($page ? ($section ? ' in ':''). 'the ' . $page . ' manpage' : - 'elsewhere in this document'); - # for being marked up later - $self->{_markup} = - $alttext ? '<SECTON>' . $alttext . '<SECTOFF>' : ( - !$section ? '' : - $type eq 'item' ? 'the <SECTON>' . $section . '<SECTOFF> entry' : - 'the section on <SECTON>' . $section . '<SECTOFF>' ) . - ($page ? ($section ? ' in ':'') . 'the <PAGEON>' . - $page . '<PAGEOFF> manpage' : - ' elsewhere in this document'); -} - -# include markup -sub markup { - my ($self,$on,$off,$pageon,$pageoff) = @_; - $on ||= ''; - $off ||= ''; - $pageon ||= ''; - $pageoff ||= ''; - $_[0]->_construct_text; - my $str = $self->{_markup}; - $str =~ s/<SECTON>/$on/; - $str =~ s/<SECTOFF>/$off/; - $str =~ s/<PAGEON>/$pageon/; - $str =~ s/<PAGEOFF>/$pageoff/; - return $str; -} - -# The complete link's text -sub text { - $_[0]->_construct_text(); - $_[0]->{_text}; -} - -# The POD page the link appears on -sub warning { - my $self = shift; - if(@_) { - push(@{$self->{_warnings}}, @_); - return @_; - } - return @{$self->{_warnings}}; -} - -# The POD file name the link appears in -sub file { - return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; -} - -# The line in the file the link appears -sub line { - return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line}; -} - -# The POD page the link appears on -sub page { - return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page}; -} - -# The link destination -sub node { - return (@_ > 1) ? ($_[0]->{-node} = $_[1]) : $_[0]->{-node}; -} - -# Potential alternative text -sub alttext { - return (@_ > 1) ? ($_[0]->{-alttext} = $_[1]) : $_[0]->{-alttext}; -} - -# The type -sub type { - return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type}; -} - -sub _invalid_link { - my ($msg) = @_; - # this sets @_ - #eval { die "$msg\n" }; - #chomp $@; - $@ = $msg; # this seems to work, too! - undef; } 1; diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm new file mode 100644 index 0000000000..399bbba252 --- /dev/null +++ b/lib/Pod/Find.pm @@ -0,0 +1,259 @@ +############################################################################# +# Pod/Find.pm -- finds files containing POD documentation +# +# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de> +# +# borrowing code from Nick Ing-Simmon's PodToHtml +# This file is part of "PodParser". Pod::Find is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::Find; + +use vars qw($VERSION); +$VERSION = 0.10; ## Current version of this package +require 5.005; ## requires this Perl version or later + +############################################################################# + +=head1 NAME + +Pod::Find - find POD documents in directory trees + +=head1 SYNOPSIS + + use Pod::Find qw(pod_find simplify_name); + my %pods = pod_find({ -verbose => 1, -inc => 1 }); + foreach(keys %pods) { + print "found library POD `$pods{$_}' in $_\n"; + } + + print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n"; + +=head1 DESCRIPTION + +B<Pod::Find> provides a function B<pod_find> that searches for POD +documents in a given set of files and directories. It returns a hash +with the file names as keys and the POD name as value. The POD name +is derived from the file name and its position in the directory tree. + +E.g. when searching in F<$HOME/perl5lib>, the file +F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>, +whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be +I<Myclass::Subclass>. The name information can be used for POD +translators. + +Only text files containing at least one valid POD command are found. + +A warning is printed if more than one POD file with the same POD name +is found, e.g. F<CPAN.pm> in different directories. This usually +indicates duplicate occurences of modules in the I<@INC> search path. + +The function B<simplify_name> is equivalent to B<basename>, but also +strips Perl-like extensions (.pm, .pl, .pod). + +Note that neither B<pod_find> nor B<simplify_name> are exported by +default so be sure to specify them in the B<use> statement if you need them: + + use Pod::Find qw(pod_find simplify_name); + +=head1 OPTIONS + +The first argument for B<pod_find> may be a hash reference with options. +The rest are either directories that are searched recursively or files. +The POD names of files are the plain basenames with any Perl-like extension +(.pm, .pl, .pod) stripped. + +=over 4 + +=item B<-verbose> + +Print progress information while scanning. + +=item B<-perl> + +Apply Perl-specific heuristics to find the correct PODs. This includes +stripping Perl-like extensions, omitting subdirectories that are numeric +but do I<not> match the current Perl interpreter's version id, suppressing +F<site_perl> as a module hierarchy name etc. + +=item B<-script> + +Search for PODs in the current Perl interpreter's installation +B<scriptdir>. This is taken from the local L<Config|Config> module. + +=item B<-inc> + +Search for PODs in the current Perl interpreter's I<@INC> paths. + +=back + +=head1 AUTHOR + +Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, +heavily borrowing code from Nick Ing-Simmons' PodToHtml. + +=head1 SEE ALSO + +L<Pod::Parser>, L<Pod::Checker> + +=cut + +use strict; +#use diagnostics; +use Exporter; +use File::Find; +use Cwd; + +use vars qw(@ISA @EXPORT_OK $VERSION); +@ISA = qw(Exporter); +@EXPORT_OK = qw(&pod_find &simplify_name); + +# package global variables +my $SIMPLIFY_RX; + +# return a hash of the +sub pod_find +{ + my %opts; + if(ref $_[0]) { + %opts = %{shift()}; + } + + $opts{-verbose} ||= 0; + $opts{-perl} ||= 0; + + my (@search) = @_; + + if($opts{-script}) { + require Config; + push(@search, $Config::Config{scriptdir}); + $opts{-perl} = 1; + } + + if($opts{-inc}) { + push(@search, grep($_ ne '.',@INC)); + $opts{-perl} = 1; + } + + if($opts{-perl}) { + require Config; + # this code simplifies the POD name for Perl modules: + # * remove "site_perl" + # * remove e.g. "i586-linux" + # * remove e.g. 5.00503 + # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) + $SIMPLIFY_RX = + qr!^(?i:site_perl/|$Config::Config{archname}/|\d+\.\d+([_.]?\d+)?/|pod/(?=.*?\.pod$))*!o; + } + + my %dirs_visited; + my %pods; + my %names; + my $pwd = cwd(); + + foreach my $try (@search) { + unless($try =~ m:^/:) { + # make path absolute + $try = join('/',$pwd,$try); + } + $try =~ s:/\.?(?=/|$)::; # simplify path + my $name; + if(-f $try) { + if($name = _check_and_extract_name($try, $opts{-verbose})) { + _check_for_duplicates($try, $name, \%names, \%pods); + } + next; + } + my $root_rx = qr!^\Q$try\E/!; + File::Find::find( sub { + my $item = $File::Find::name; + if(-d) { + if($dirs_visited{$item}) { + warn "Directory '$item' already seen, skipping.\n" + if($opts{-verbose}); + $File::Find::prune = 1; + return; + } + else { + $dirs_visited{$item} = 1; + } + if($opts{-perl} && /^(\d+\.[\d_]+)$/ && eval "$1" != $]) { + $File::Find::prune = 1; + warn "Perl $] version mismatch on $_, skipping.\n" + if($opts{-verbose}); + } + return; + } + if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { + _check_for_duplicates($item, $name, \%names, \%pods); + } + }, $try); # end of File::Find::find + } + chdir $pwd; + %pods; +} + +sub _check_for_duplicates { + my ($file, $name, $names_ref, $pods_ref) = @_; + if($$names_ref{$name}) { + warn "Duplicate POD found (shadowing?): $name ($file)\n"; + warn " Already seen in ", + join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; + } + else { + $$names_ref{$name} = 1; + } + $$pods_ref{$file} = $name; +} + +sub _check_and_extract_name { + my ($file, $verbose, $root_rx) = @_; + + # check extension or executable + unless($file =~ /\.(pod|pm|pl)$/i || (-f $file && -x _ && -T _)) { + return undef; + } + + # check for one line of POD + unless(open(POD,"<$file")) { + warn "Error: $file is unreadable: $!\n"; + return undef; + } + local $/ = undef; + my $pod = <POD>; + close(POD); + unless($pod =~ /\n=(head\d|pod|over|item)\b/) { + warn "No POD in $file, skipping.\n" + if($verbose); + return; + } + undef $pod; + + # strip non-significant path components + # _TODO_ what happens on e.g. Win32? + my $name = $file; + if(defined $root_rx) { + $name =~ s!$root_rx!!; + $name =~ s!$SIMPLIFY_RX!!o if(defined $SIMPLIFY_RX); + } + else { + $name =~ s:^.*/::; + } + $name =~ s/\.(pod|pm|pl)$//i; + $name =~ s!/+!::!g; + $name; +} + +# basic simplification of the POD name: +# basename & strip extension +sub simplify_name { + my ($str) = @_; + $str =~ s:^.*/::; + $str =~ s:\.p([lm]|od)$::i; + $str; +} + +1; + diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm new file mode 100644 index 0000000000..a66e8f5e8b --- /dev/null +++ b/lib/Pod/ParseUtils.pm @@ -0,0 +1,792 @@ +############################################################################# +# Pod/ParseUtils.pm -- helpers for POD parsing and conversion +# +# Copyright (C) 1999 by Marek Rouchal. All rights reserved. +# This file is part of "PodParser". PodParser is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::ParseUtils; + +use vars qw($VERSION); +$VERSION = 0.2; ## Current version of this package +require 5.004; ## requires this Perl version or later + +=head1 NAME + +Pod::ParseUtils - helpers for POD parsing and conversion + +=head1 SYNOPSIS + + use Pod::ParseUtils; + + my $list = new Pod::List; + my $link = Pod::Hyperlink->new('Pod::Parser'); + +=head1 DESCRIPTION + +B<Pod::ParseUtils> contains a few object-oriented helper packages for +POD parsing and processing (i.e. in POD formatters and translators). + +=cut + +#----------------------------------------------------------------------------- +# Pod::List +# +# class to hold POD list info (=over, =item, =back) +#----------------------------------------------------------------------------- + +package Pod::List; + +use Carp; + +=head2 Pod::List + +B<Pod::List> can be used to hold information about POD lists +(written as =over ... =item ... =back) for further processing. +The following methods are available: + +=over 4 + +=item new() + +Create a new list object. Properties may be specified through a hash +reference like this: + + my $list = Pod::List->new({ -start => $., -indent => 4 }); + +See the individual methods/properties for details. + +=cut + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my %params = @_; + my $self = {%params}; + bless $self, $class; + $self->initialize(); + return $self; +} + +sub initialize { + my $self = shift; + $self->{-file} ||= 'unknown'; + $self->{-start} ||= 'unknown'; + $self->{-indent} ||= 4; # perlpod: "should be the default" + $self->{_items} = []; + $self->{-type} ||= ''; +} + +=item file() + +Without argument, retrieves the file name the list is in. This must +have been set before by either specifying B<-file> in the B<new()> +method or by calling the B<file()> method with a scalar argument. + +=cut + +# The POD file name the list appears in +sub file { + return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; +} + +=item start() + +Without argument, retrieves the line number where the list started. +This must have been set before by either specifying B<-start> in the +B<new()> method or by calling the B<start()> method with a scalar +argument. + +=cut + +# The line in the file the node appears +sub start { + return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start}; +} + +=item indent() + +Without argument, retrieves the indent level of the list as specified +in C<=over n>. This must have been set before by either specifying +B<-indent> in the B<new()> method or by calling the B<indent()> method +with a scalar argument. + +=cut + +# indent level +sub indent { + return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent}; +} + +=item type() + +Without argument, retrieves the list type, which can be an arbitrary value, +e.g. C<OL>, C<UL>, ... when thinking the HTML way. +This must have been set before by either specifying +B<-type> in the B<new()> method or by calling the B<type()> method +with a scalar argument. + +=cut + +# The type of the list (UL, OL, ...) +sub type { + return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type}; +} + +=item rx() + +Without argument, retrieves a regular expression for simplifying the +individual item strings once the list type has been determined. Usage: +E.g. when converting to HTML, one might strip the leading number in +an ordered list as C<E<lt>OLE<gt>> already prints numbers itself. +This must have been set before by either specifying +B<-rx> in the B<new()> method or by calling the B<rx()> method +with a scalar argument. + +=cut + +# The regular expression to simplify the items +sub rx { + return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx}; +} + +=item item() + +Without argument, retrieves the array of the items in this list. +The items may be represented by any scalar. +If an argument has been given, it is pushed on the list of items. + +=cut + +# The individual =items of this list +sub item { + my ($self,$item) = @_; + if(defined $item) { + push(@{$self->{_items}}, $item); + return $item; + } + else { + return @{$self->{_items}}; + } +} + +=item parent() + +Without argument, retrieves information about the parent holding this +list, which is represented as an arbitrary scalar. +This must have been set before by either specifying +B<-parent> in the B<new()> method or by calling the B<parent()> method +with a scalar argument. + +=cut + +# possibility for parsers/translators to store information about the +# lists's parent object +sub parent { + return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent}; +} + +=item tag() + +Without argument, retrieves information about the list tag, which can be +any scalar. +This must have been set before by either specifying +B<-tag> in the B<new()> method or by calling the B<tag()> method +with a scalar argument. + +=back + +=cut + +# possibility for parsers/translators to store information about the +# list's object +sub tag { + return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag}; +} + +#----------------------------------------------------------------------------- +# Pod::Hyperlink +# +# class to manipulate POD hyperlinks (L<>) +#----------------------------------------------------------------------------- + +package Pod::Hyperlink; + +=head2 Pod::Hyperlink + +B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage: + + my $link = Pod::Hyperlink->new('alternative text|page/"section in page"'); + +The B<Pod::Hyperlink> class is mainly designed to parse the contents of the +C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the +different parts of a POD hyperlink for further processing. It can also be +used to construct hyperlinks. + +=over 4 + +=item new() + +The B<new()> method can either be passed a set of key/value pairs or a single +scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object +of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a +failure, the error message is stored in C<$@>. + +=cut + +use Carp; + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = +{}; + bless $self, $class; + $self->initialize(); + if(defined $_[0]) { + if(ref($_[0])) { + # called with a list of parameters + %$self = %{$_[0]}; + $self->_construct_text(); + } + else { + # called with L<> contents + return undef unless($self->parse($_[0])); + } + } + return $self; +} + +sub initialize { + my $self = shift; + $self->{-line} ||= 'undef'; + $self->{-file} ||= 'undef'; + $self->{-page} ||= ''; + $self->{-node} ||= ''; + $self->{-alttext} ||= ''; + $self->{-type} ||= 'undef'; + $self->{_warnings} = []; +} + +=item parse($string) + +This method can be used to (re)parse a (new) hyperlink, i.e. the contents +of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object. + +=cut + +sub parse { + my $self = shift; + local($_) = $_[0]; + # syntax check the link and extract destination + my ($alttext,$page,$node,$type) = ('','','',''); + + $self->{_warnings} = []; + + # collapse newlines with whitespace + if(s/\s*\n+\s*/ /g) { + $self->warning("collapsing newlines to blanks"); + } + # strip leading/trailing whitespace + if(s/^[\s\n]+//) { + $self->warning("ignoring leading whitespace in link"); + } + if(s/[\s\n]+$//) { + $self->warning("ignoring trailing whitespace in link"); + } + unless(length($_)) { + _invalid_link("empty link"); + return undef; + } + + ## Check for different possibilities. This is tedious and error-prone + # we match all possibilities (alttext, page, section/item) + #warn "DEBUG: link=$_\n"; + + # only page + if(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)$!) { + $page = $1 . $2; + $type = 'page'; + } + # alttext, page and section + elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*"(.+)"$!) { + ($alttext, $page, $node) = ($1, $2 . $3, $4); + $type = 'section'; + } + # page and section + elsif(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*"(.+)"$!) { + ($page, $node) = ($1 . $2, $3); + $type = 'section'; + } + # page and item + elsif(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*(.+)$!) { + ($page, $node) = ($1 . $2, $3); + $type = 'item'; + } + # only section + elsif(m!^(?:/\s*|)"(.+)"$!) { + $node = $1; + $type = 'section'; + } + # only item + elsif(m!^/(.+)$!) { + $node = $1; + $type = 'item'; + } + # non-standard: Hyperlink + elsif(m!^((?:http|ftp|mailto|news):.+)$!i) { + $node = $1; + $type = 'hyperlink'; + } + # alttext, page and item + elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*(.+)$!) { + ($alttext, $page, $node) = ($1, $2 . $3, $4); + $type = 'item'; + } + # alttext and page + elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)$!) { + ($alttext, $page) = ($1, $2 . $3); + $type = 'page'; + } + # alttext and section + elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) { + ($alttext, $node) = ($1,$2); + $type = 'section'; + } + # alttext and item + elsif(m!^(.+?)\s*[|]\s*/(.+)$!) { + ($alttext, $node) = ($1,$2); + } + # nonstandard: alttext and hyperlink + elsif(m!^(.+?)\s*[|]\s*((?:http|ftp|mailto|news):.+)$!) { + ($alttext, $node) = ($1,$2); + $type = 'hyperlink'; + } + # must be an item or a "malformed" section (without "") + else { + $node = $_; + $type = 'item'; + } + + if($page =~ /[(]\w*[)]$/) { + $self->warning("section in `$page' deprecated"); + } + $self->{-page} = $page; + $self->{-node} = $node; + $self->{-alttext} = $alttext; + #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n"; + $self->{-type} = $type; + $self->_construct_text(); + 1; +} + +sub _construct_text { + my $self = shift; + my $alttext = $self->alttext(); + my $type = $self->type(); + my $section = $self->node(); + my $page = $self->page(); + my $page_ext = ''; + $page =~ s/([(]\w*[)])$// && ($page_ext = $1); + if($alttext) { + $self->{_text} = $alttext; + } + elsif($type eq 'hyperlink') { + $self->{_text} = $section; + } + else { + $self->{_text} = (!$section ? '' : + $type eq 'item' ? "the $section entry" : + "the section on $section" ) . + ($page ? ($section ? ' in ':'') . "the $page$page_ext manpage" : + ' elsewhere in this document'); + } + # for being marked up later + # use the non-standard markers P<> and Q<>, so that the resulting + # text can be parsed by the translators. It's their job to put + # the correct hypertext around the linktext + if($alttext) { + $self->{_markup} = "Q<$alttext>"; + } + elsif($type eq 'hyperlink') { + $self->{_markup} = "Q<$section>"; + } + else { + $self->{_markup} = (!$section ? '' : + $type eq 'item' ? "the Q<$section> entry" : + "the section on Q<$section>" ) . + ($page ? ($section ? ' in ':'') . "the P<$page>$page_ext manpage" : + ' elsewhere in this document'); + } +} + +=item markup($string) + +Set/retrieve the textual value of the link. This string contains special +markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the +translator's interior sequence expansion engine to the +formatter-specific code to highlight/activate the hyperlink. The details +have to be implemented in the translator. + +=cut + +#' retrieve/set markuped text +sub markup { + return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup}; +} + +=item text() + +This method returns the textual representation of the hyperlink as above, +but without markers (read only). Depending on the link type this is one of +the following alternatives (the + and * denote the portions of the text +that are marked up): + + the +perl+ manpage + the *$|* entry in the +perlvar+ manpage + the section on *OPTIONS* in the +perldoc+ manpage + the section on *DESCRIPTION* elsewhere in this document + +=cut + +# The complete link's text +sub text { + $_[0]->{_text}; +} + +=item warning() + +After parsing, this method returns any warnings encountered during the +parsing process. + +=cut + +# Set/retrieve warnings +sub warning { + my $self = shift; + if(@_) { + push(@{$self->{_warnings}}, @_); + return @_; + } + return @{$self->{_warnings}}; +} + +=item line(), file() + +Just simple slots for storing information about the line and the file +the link was encountered in. Has to be filled in manually. + +=cut + +# The line in the file the link appears +sub line { + return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line}; +} + +# The POD file name the link appears in +sub file { + return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; +} + +=item page() + +This method sets or returns the POD page this link points to. + +=cut + +# The POD page the link appears on +sub page { + if (@_ > 1) { + $_[0]->{-page} = $_[1]; + $_[0]->_construct_text(); + } + $_[0]->{-page}; +} + +=item node() + +As above, but the destination node text of the link. + +=cut + +# The link destination +sub node { + if (@_ > 1) { + $_[0]->{-node} = $_[1]; + $_[0]->_construct_text(); + } + $_[0]->{-node}; +} + +=item alttext() + +Sets or returns an alternative text specified in the link. + +=cut + +# Potential alternative text +sub alttext { + if (@_ > 1) { + $_[0]->{-alttext} = $_[1]; + $_[0]->_construct_text(); + } + $_[0]->{-alttext}; +} + +=item type() + +The node type, either C<section> or C<item>. As an unofficial type, +there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>> + +=cut + +# The type: item or headn +sub type { + return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type}; +} + +=item link() + +Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>. + +=back + +=cut + +# The link itself +sub link { + my $self = shift; + my $link = $self->page() || ''; + if($self->node()) { + if($self->type() eq 'section') { + $link .= ($link ? '/' : '') . '"' . $self->node() . '"'; + } + elsif($self->type() eq 'hyperlink') { + $link = $self->node(); + } + else { # item + $link .= '/' . $self->node(); + } + } + if($self->alttext()) { + $link = $self->alttext() . '|' . $link; + } + $link; +} + +sub _invalid_link { + my ($msg) = @_; + # this sets @_ + #eval { die "$msg\n" }; + #chomp $@; + $@ = $msg; # this seems to work, too! + undef; +} + +#----------------------------------------------------------------------------- +# Pod::Cache +# +# class to hold POD page details +#----------------------------------------------------------------------------- + +package Pod::Cache; + +=head2 Pod::Cache + +B<Pod::Cache> holds information about a set of POD documents, +especially the nodes for hyperlinks. +The following methods are available: + +=over 4 + +=item new() + +Create a new cache object. This object can hold an arbitrary number of +POD documents of class Pod::Cache::Item. + +=cut + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = []; + bless $self, $class; + return $self; +} + +=item item() + +Add a new item to the cache. Without arguments, this method returns a +list of all cache elements. + +=cut + +sub item { + my ($self,%param) = @_; + if(%param) { + my $item = Pod::Cache::Item->new(%param); + push(@$self, $item); + return $item; + } + else { + return @{$self}; + } +} + +=item find_page($name) + +Look for a POD document named C<$name> in the cache. Returns the +reference to the corresponding Pod::Cache::Item object or undef if +not found. + +=back + +=cut + +sub find_page { + my ($self,$page) = @_; + foreach(@$self) { + if($_->page() eq $page) { + return $_; + } + } + undef; +} + +package Pod::Cache::Item; + +=head2 Pod::Cache::Item + +B<Pod::Cache::Item> holds information about individual POD documents, +that can be grouped in a Pod::Cache object. +It is intended to hold information about the hyperlink nodes of POD +documents. +The following methods are available: + +=over 4 + +=item new() + +Create a new object. + +=cut + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my %params = @_; + my $self = {%params}; + bless $self, $class; + $self->initialize(); + return $self; +} + +sub initialize { + my $self = shift; + $self->{-nodes} = [] unless(defined $self->{-nodes}); +} + +=item page() + +Set/retrieve the POD document name (e.g. "Pod::Parser"). + +=cut + +# The POD page +sub page { + return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page}; +} + +=item description() + +Set/retrieve the POD short description as found in the C<=head1 NAME> +section. + +=cut + +# The POD description, taken out of NAME if present +sub description { + return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description}; +} + +=item path() + +Set/retrieve the POD file storage path. + +=cut + +# The file path +sub path { + return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path}; +} + +=item file() + +Set/retrieve the POD file name. + +=cut + +# The POD file name +sub file { + return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; +} + +=item nodes() + +Add a node (or a list of nodes) to the document's node list. Note that +the order is kept, i.e. start with the first node and end with the last. +If no argument is given, the current list of nodes is returned in the +same order the nodes have been added. +A node can be any scalar, but usually is a pair of node string and +unique id for the C<find_node> method to work correctly. + +=cut + +# The POD nodes +sub nodes { + my ($self,@nodes) = @_; + if(@nodes) { + push(@{$self->{-nodes}}, @nodes); + return @nodes; + } + else { + return @{$self->{-nodes}}; + } +} + +=item find_node($name) + +Look for a node named C<$name> in the object's node list. Returns the +unique id of the node (i.e. the second element of the array stored in +the node arry) or undef if not found. + +=back + +=cut + +sub find_node { + my ($self,$node) = @_; + foreach(@{$self->{-nodes}}) { + if($_->[0] eq $node) { + return $_->[1]; # id + } + } + undef; +} + + +=head1 AUTHOR + +Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, borrowing +a lot of things from L<pod2man> and L<pod2roff> as well as other POD +processing tools by Tom Christiansen, Brad Appleton and Russ Allbery. + +=head1 SEE ALSO + +L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>, +L<pod2html> + +=cut + +1; diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm index ada9d70d74..2a6afc3be9 100644 --- a/lib/Text/ParseWords.pm +++ b/lib/Text/ParseWords.pm @@ -49,7 +49,7 @@ sub nested_quotewords { sub parse_line { # We will be testing undef strings - local($^W) = 0; + no warnings; my($delimiter, $keep, $line) = @_; my($quote, $quoted, $unquoted, $delim, $word, @pieces); diff --git a/lib/perl5db.pl b/lib/perl5db.pl index b463decf20..aff5c687e7 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -607,6 +607,8 @@ EOP $subrange = pop @pieces; $file = join(':', @pieces); if ($file ne $filename) { + print $OUT "Switching to file '$file'.\n" + unless $emacs; *dbline = $main::{'_<' . $file}; $max = $#dbline; $filename = $file; @@ -793,8 +795,8 @@ EOP ($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/); $i += 0; if ($i) { - $filename = $file; - *dbline = $main::{'_<' . $filename}; + local $filename = $file; + local *dbline = $main::{'_<' . $filename}; $had_breakpoints{$filename} = 1; $max = $#dbline; ++$i while $dbline[$i] == 0 && $i < $max; @@ -884,6 +886,10 @@ EOP $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do { end_report(), next CMD if $finished and $level <= 1; $subname = $i = $1; + # Probably not needed, since we finish an interactive + # sub-session anyway... + # local $filename = $filename; + # local *dbline = *dbline; # XXX Would this work?! if ($i =~ /\D/) { # subroutine name $subname = $package."::".$subname unless $subname =~ /::/; @@ -1811,7 +1817,13 @@ B<l> List next window of lines. B<-> List previous window of lines. B<w> [I<line>] List window around I<line>. B<.> Return to the executed line. -B<f> I<filename> Switch to viewing I<filename>. Must be loaded. +B<f> I<filename> Switch to viewing I<filename>. File must be already loaded. + I<filename> may be either the full name of the file, or a regular + expression matching the full file name: + B<f> I</home/me/foo.pl> and B<f> I<oo\\.> may access the same file. + Evals (with saved bodies) are considered to be filenames: + B<f> I<(eval 7)> and B<f> I<eval 7\\b> access the body of the 7th eval + (in the order of execution). B</>I<pattern>B</> Search forwards for I<pattern>; final B</> is optional. B<?>I<pattern>B<?> Search backwards for I<pattern>; final B<?> is optional. B<L> List all breakpoints and actions. diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index 0f588237eb..8649e9e07e 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -38,7 +38,7 @@ sub SWASHNEW { if ($list) { my @tmp = split(/^/m, $list); my %seen; - local $^W = 0; + no warnings; $extras = join '', grep /^[^0-9a-fA-F]/, @tmp; $list = join '', sort { hex $a <=> hex $b } @@ -58,7 +58,7 @@ EXT void *PL_force_link_funcs[] = { #undef PERLVARA #undef PERLVARI #undef PERLVARIC -#define PERLVAR(v,t) Perl_##v##_ptr, +#define PERLVAR(v,t) (void*)Perl_##v##_ptr, #define PERLVARA(v,n,t) PERLVAR(v,t) #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v,t) diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 56997322d6..65a07e21fa 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -174,6 +174,12 @@ Switch to viewing a different file or eval statement. If C<filename> is not a full filename as found in values of %INC, it is considered as a regexp. +C<eval>ed strings (when accessible) are considered to be filenames: +C<f (eval 7)> and C<f eval 7\b> access the body of the 7th C<eval>ed string +(in the order of execution). The bodies of currently executed C<eval> +and of C<eval>ed strings which define subroutines are saved, thus are +accessible by this mechanism. + =item /pattern/ Search forwards for pattern; final / is optional. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 2b5e4e7233..50721c3e52 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -440,7 +440,7 @@ WARNING: This is an experimental feature. change#4081 [TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>, -Tuomas Lukka <lukka@fas.harvard.edu>)] +Tuomas Lukka <lukka@iki.fi>)] =head2 "our" declarations @@ -481,9 +481,28 @@ C<require> and C<use> also support such literals: WARNING: This is an experimental feature. -change#3385, also need perlguts documentation +In previous versions of Perl, you couldn't cache objects so as +to allow them to be deleted if the last reference from outside +the cache is deleted. The reference in the cache would hold a +reference count on the object and the objects would never be +destroyed. + +Another familiar problem is with circular references. When an +object references itself, its reference count would never go +down to zero, and it would not get destroyed until the program +is about to exit. -[TODO - Tuomas Lukka <lukka@fas.harvard.edu>] +Weak references solve this by allowing you to "weaken" any +reference, that is, make it not count towards the reference count. +When the last non-weak reference to an object is deleted, the object +is destroyed and all the weak references to the object are +automatically undef-ed. + +To use this feature, you need the WeakRef package from CPAN, which +contains additional documentation. + +change#3385, also need perlguts documentation +[TODO - Tuomas Lukka <lukka@iki.fi>] =head2 File globbing implemented internally @@ -1516,9 +1535,93 @@ act as mutators (accessor $z->Re(), mutator $z->Re(3)). A little bit of radial trigonometry (cylindrical and spherical), radial coordinate conversions, and the great circle distance were added. -=item Pod::Parser +=item Pod::Parser, Pod::InputObjects, Pod::ParseUtils, and Pod::Select + +Pod::Parser is a new module that provides a base class for parsing and +selecting sections of POD documentation from an input stream. This +module takes care of identifying POD paragraphs and commands in the +input and hands off the parsed paragraphs and commands to user-defined +methods which are free to interpret or translate them as they see fit. + +Pod::InputObjects defines some input objects needed by Pod::Parser, and +for advanced users of Pod::Parser that need more about a command besides +its name and text. Pod::ParseUtils provides several object-oriented +helpers for POD parsing and processing. Probably the most important is +Pod::Hyperlink for parsing and expanding POD hyperlinks. Pod::Select is +a subclass of Pod::Parser which provides a function named "podselect()" +to filter out user-specified sections of raw pod documentation from an +input stream. + +As of release 5.6 of Perl, Pod::Parser is now the officially sanctioned +"base parser code" recommended for use by all pod2xxx translators. +Pod::Text (pod2text) and Pod::Man (pod2man) have already been converted +to use Pod::Parser and efforts to convert Pod::Html (pod2html) are +already underway. For any questions or comments about POD parsing and +translating issues and utilities, please use the pod-people@perl.org +mailing list. + +For further information, please see L<Pod::Parser>, L<Pod::InputObjects>, +L<Pod::ParseUtils> and L<Pod::Select>. + +=item Pod::Usage + +Pod::Usage provides the function "pod2usage()" to print usage messages for +a Perl script based on its embedded pod documentation. The pod2usage() +function is generally useful to all script authors since it lets them +write and maintain a single source (the PODs) for documentation, thus +removing the need to create and maintain redundant usage message text +consisting of information already in the PODs. + +Script authors are encouraged to use Pod::Usage with their favorite Perl +option-parser to provide both terse and verbose formatted usage messages +for their users. Here is a simple example using Getopt::Long that prints +only a synopsis for syntax errors, a synopsis and description of arguments +when C<-help> is used, and the full manual page when C<-man> is used. + + use Getopt::Long; + use Pod::Usage; + my $man = 0; + my $help = 0; + GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); + pod2usage(1) if $help; + pod2usage(-exitstatus => 0, -verbose => 2) if $man; + + __END__ + + =head1 NAME + + sample - Using GetOpt::Long and Pod::Usage + + =head1 SYNOPSIS + + sample [options] [file ...] + + Options: + -help brief help message + -man full documentation + + =head1 OPTIONS + + =over 8 + + =item B<-help> + + Print a brief help message and exits. + + =item B<-man> + + Prints the manual page and exits. + + =back + + =head1 DESCRIPTION + + B<This program> will read the given input file(s) and do something + useful with the contents thereof. + + =cut -[TODO - Brad Appleton <bradapp@enteract.com>] +For details, please see L<Pod::Usage>. =item Pod::Text and Pod::Man diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index e40b31bec1..fa8504ed38 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1559,11 +1559,11 @@ in the way of your getting your job done.) OPERATION is one of LOCK_SH, LOCK_EX, or LOCK_UN, possibly combined with LOCK_NB. These constants are traditionally valued 1, 2, 8 and 4, but -you can use the symbolic names if import them from the Fcntl module, +you can use the symbolic names if you import them from the Fcntl module, either individually, or as a group using the ':flock' tag. LOCK_SH requests a shared lock, LOCK_EX requests an exclusive lock, and LOCK_UN -releases a previously requested lock. If LOCK_NB is added to LOCK_SH or -LOCK_EX then C<flock> will return immediately rather than blocking +releases a previously requested lock. If LOCK_NB is bitwise-or'ed with +LOCK_SH or LOCK_EX then C<flock> will return immediately rather than blocking waiting for the lock (check the return status to see if you got it). To avoid the possibility of miscoordination, Perl now flushes FILEHANDLE @@ -5166,8 +5166,7 @@ features back into the current package. The module can implement its C<import> method any way it likes, though most modules just choose to derive their C<import> method via inheritance from the C<Exporter> class that is defined in the C<Exporter> module. See L<Exporter>. If no C<import> -method can be found then the error is currently silently ignored. This -may change to a fatal error in a future version. +method can be found then the call is skipped. If you don't want your namespace altered, explicitly supply an empty list: @@ -1041,6 +1041,7 @@ yup: /* Confirmed by INTUIT */ rx->startp[0] = s - truebase; rx->endp[0] = s - truebase + rx->minlen; } + rx->nparens = rx->lastparen = 0; /* used by @- and @+ */ LEAVE_SCOPE(oldsave); RETPUSHYES; @@ -77,7 +77,7 @@ extern "C" int syscall(unsigned long,...); compiling multithreaded and singlethreaded ($ccflags et al). HOST_NOT_FOUND is typically defined in <netdb.h>. */ -#if defined(HOST_NOT_FOUND) && !defined(h_errno) +#if defined(HOST_NOT_FOUND) && !defined(h_errno) && !defined(__CYGWIN__) extern int h_errno; #endif diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t index 9f7f6bd341..e27130ce39 100755 --- a/t/pod/poderrs.t +++ b/t/pod/poderrs.t @@ -82,12 +82,12 @@ L</"begin or begin"> L<"end with begin"> L</OoPs> -=head2 Garbled (almost) links +=head2 Some links with problems -L<s s / s s / ss> -L<".".":"> -L<"h"/"hh"> -L<a|b|c> +L<abc +def> +L<> +L<"Warnings"> this one is ok =head2 Warnings diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr index 70408cd2f4..157d1306ba 100644 --- a/t/pod/poderrs.xr +++ b/t/pod/poderrs.xr @@ -1,6 +1,4 @@ *** ERROR: Unknown command "unknown1" at line 21 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence "N" at line 21 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence "D" at line 22 in file pod/poderrs.t *** ERROR: Unknown interior-sequence "Q" at line 25 in file pod/poderrs.t *** ERROR: Unknown interior-sequence "A" at line 26 in file pod/poderrs.t *** ERROR: Unknown interior-sequence "Y" at line 27 in file pod/poderrs.t @@ -9,27 +7,26 @@ ** Unterminated I<...> at pod/poderrs.t line 30 ** Unterminated C<...> at pod/poderrs.t line 33 *** ERROR: =item without previous =over at line 43 in file pod/poderrs.t +*** ERROR: =over on line 43 without closing =back (at head2) at line 45 in file pod/poderrs.t *** ERROR: =back without previous =over at line 47 in file pod/poderrs.t -*** ERROR: unclosed =over (line 51) at head2 at line 55 in file pod/poderrs.t -*** WARNING: =end without =begin at line 57 in file pod/poderrs.t +*** ERROR: =over on line 51 without closing =back (at head2) at line 55 in file pod/poderrs.t +*** ERROR: =end without =begin at line 57 in file pod/poderrs.t *** ERROR: Nested =begin's (first at line 61:html) at line 63 in file pod/poderrs.t -*** WARNING: =end without =begin at line 67 in file pod/poderrs.t +*** ERROR: =end without =begin at line 67 in file pod/poderrs.t *** ERROR: nested commands C<...C<...>...> at line 71 in file pod/poderrs.t *** ERROR: garbled entity E<alea iacta est> at line 75 in file pod/poderrs.t *** ERROR: garbled entity E<C<auml>> at line 76 in file pod/poderrs.t *** ERROR: garbled entity E<abcI<bla>> at line 77 in file pod/poderrs.t -*** ERROR: malformed link L<>: garbled entry (spurious characters `s s / s s / ss') at line 87 in file pod/poderrs.t -*** ERROR: malformed link L<>: garbled entry (spurious characters `".".":"') at line 88 in file pod/poderrs.t -*** ERROR: malformed link L<>: garbled entry (spurious characters `"h"/"hh"') at line 89 in file pod/poderrs.t -*** WARNING: brackets in `passwd(5)' at line 94 in file pod/poderrs.t +*** WARNING: collapsing newlines to blanks at line 87 in file pod/poderrs.t +*** ERROR: malformed link L<> : empty link at line 89 in file pod/poderrs.t +*** WARNING: section in `passwd(5)' deprecated at line 94 in file pod/poderrs.t *** WARNING: ignoring leading whitespace in link at line 95 in file pod/poderrs.t *** WARNING: ignoring trailing whitespace in link at line 95 in file pod/poderrs.t *** WARNING: Spurious character(s) after =back at line 101 in file pod/poderrs.t -*** WARNING: Spurious character(s) after =end at line 107 in file pod/poderrs.t *** WARNING: No items in =over (at line 109) / =back list at line 111 in file pod/poderrs.t -*** WARNING: 2 unescaped <> at line 113 in file pod/poderrs.t +*** WARNING: 2 unescaped <> in paragraph at line 113 in file pod/poderrs.t *** ERROR: unresolved internal link `begin or begin' at line 81 in file pod/poderrs.t *** ERROR: unresolved internal link `end with begin' at line 82 in file pod/poderrs.t *** ERROR: unresolved internal link `OoPs' at line 83 in file pod/poderrs.t -*** ERROR: unresolved internal link `b|c' at line 90 in file pod/poderrs.t -pod/poderrs.t has 25 pod syntax errors. +*** ERROR: unresolved internal link `abc def' at line 87 in file pod/poderrs.t +pod/poderrs.t has 24 pod syntax errors. diff --git a/win32/win32.h b/win32/win32.h index 4fed26a911..f8e8dc7d79 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -163,6 +163,7 @@ struct utsname { #define _access access #define _chdir chdir #define _getpid getpid +#define wcsicmp _wcsicmp #include <sys/types.h> #ifndef DllMain |