diff options
332 files changed, 25169 insertions, 7298 deletions
@@ -54,6 +54,7 @@ pueschel Norbert Pueschel pueschel@imsdd.meb.uni-bonn.de pvhp Peter Prymmer pvhp@forte.com raphael Raphael Manfredi Raphael_Manfredi@pobox.com rdieter Rex Dieter rdieter@math.unl.edu +rra Russ Allbery rra@stanford.edu rsanders Robert Sanders Robert.Sanders@linux.org roberto Ollivier Robert roberto@keltia.freenix.fr roderick Roderick Schertler roderick@argon.org @@ -62,6 +63,7 @@ tsanders Tony Sanders sanders@bsdi.com schinder Paul Schinder schinder@pobox.com scotth Scott Henry scotth@sgi.com seibert Greg Seibert seibert@Lynx.COM +simon Simon Cozens simon@brecon.co.uk spider Spider Boardman spider@Orb.Nashua.NH.US smccam Stephen McCamant smccam@uclink4.berkeley.edu sugalskd Dan Sugalski sugalskd@osshe.edu @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Fri Apr 28 23:33:15 EET DST 2000 [metaconfig 3.0 PL70] +# Generated on Wed Aug 2 03:07:08 EET DST 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -288,7 +288,6 @@ bincompat5005='' d_bincompat5005='' byteorder='' cc='' -gccversion='' ccflags='' cppflags='' ldflags='' @@ -343,7 +342,6 @@ d_endnent='' d_endpent='' d_endpwent='' d_endsent='' -d_endspent='' d_fchmod='' d_fchown='' d_fcntl='' @@ -365,6 +363,7 @@ d_ftime='' d_gettimeod='' d_Gconvert='' d_getcwd='' +d_getespwnam='' d_getfsstat='' d_getgrent='' d_getgrps='' @@ -393,10 +392,10 @@ d_getprior='' d_getpbyname='' d_getpbynumber='' d_getprotoprotos='' +d_getprpwnam='' d_getpwent='' d_getsent='' d_getservprotos='' -d_getspent='' d_getspnam='' d_getsbyname='' d_getsbyport='' @@ -491,6 +490,7 @@ d_setpgrp2='' d_bsdsetpgrp='' d_setpgrp='' d_setprior='' +d_setproctitle='' d_setpwent='' d_setregid='' d_setresgid='' @@ -500,7 +500,6 @@ d_setrgid='' d_setruid='' d_setsent='' d_setsid='' -d_setspent='' d_setvbuf='' d_sfio='' usesfio='' @@ -598,6 +597,8 @@ fflushNULL='' fflushall='' fpossize='' fpostype='' +gccosandvers='' +gccversion='' gidformat='' gidsign='' gidsize='' @@ -624,6 +625,7 @@ i_grp='' i_iconv='' i_ieeefp='' i_inttypes='' +i_libutil='' i_limits='' i_locale='' i_machcthr='' @@ -638,6 +640,7 @@ i_netinettcp='' i_niin='' i_sysin='' i_poll='' +i_prot='' i_pthread='' d_pwage='' d_pwchange='' @@ -796,6 +799,7 @@ perl5='' perladmin='' perlpath='' d_nv_preserves_uv='' +d_nv_preserves_uv_bits='' i16size='' i16type='' i32size='' @@ -1001,7 +1005,7 @@ defvoidused=15 libswanted='sfio socket bind inet nsl nm ndbm gdbm dbm db malloc dl' libswanted="$libswanted dld ld sun m c cposix posix" libswanted="$libswanted ndir dir crypt sec" -libswanted="$libswanted ucb bsd BSD PW x iconv" +libswanted="$libswanted ucb bsd BSD PW x iconv util" : We probably want to search /usr/shlib before most other libraries. : This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist. glibpth=`echo " $glibpth " | sed -e 's! /usr/shlib ! !'` @@ -2031,6 +2035,62 @@ FOO ;; esac +cat <<EOS >checkcc +$startsh +EOS +cat <<'EOSC' >>checkcc +case "$cc" in +'') ;; +*) $rm -f try try.* + $cat >try.c <<EOM +int main(int argc, char *argv[]) { + return 0; +} +EOM + if $cc -o try try.c; then + : + else + echo "Uh-oh, the C compiler '$cc' doesn't seem to be working." >&4 + despair=yes + trygcc=yes + case "$cc" in + *gcc*) trygcc=no ;; + esac + case "`$cc -v -c try.c 2>&1`" in + *gcc*) trygcc=no ;; + esac + if $test X"$trygcc" = Xyes; then + if gcc -o try -c try.c; then + echo " " + echo "You seem to have a working gcc, though." >&4 + rp="Would you like to use it?" + dflt=y + if $test -f myread; then + . ./myread + else + if $test -f UU/myread; then + . ./UU/myread + else + echo "Cannot find myread, sorry. Aborting." >&2 + exit 1 + fi + fi + case "$ans" in + [yY]*) cc=gcc; ccflags=''; despair=no ;; + esac + fi + fi + if $test X"$despair" = Xyes; then + echo "You need to find a working C compiler." >&4 + echo "I cannot continue any further, aborting." >&4 + exit 1 + fi + fi + $rm -f try try.* + ;; +esac +EOSC + : determine whether symbolic links are supported echo " " $touch blurfl @@ -2163,6 +2223,7 @@ if test -f config.sh; then ;; esac fi +. ./UU/checkcc if test ! -f config.sh; then $cat <<EOM @@ -2347,7 +2408,11 @@ EOM osf1|mls+) case "$5" in alpha) osname=dec_osf - osvers=`echo "$3" | sed 's/^[xvt]//'` + osvers=`sizer -v | awk '{print $3}' | tr '[A-Z]' '[a-z]' | sed 's/^[xvt]//'` + case "$osvers" in + [1-9].[0-9]*) ;; + *) osvers=`echo "$3" | sed 's/^[xvt]//'` ;; + esac ;; hp*) osname=hp_osf1 ;; mips) osname=mips_osf1 ;; @@ -2797,7 +2862,11 @@ int main() { #endif } EOP - ( cc -o pdp11 pdp11.c ) >/dev/null 2>&1 + case "$cc" in + '') modelcc="$cc" ;; + *) modelcc="cc" ;; + esac + ( $modelcc -o pdp11 pdp11.c ) >/dev/null 2>&1 if $test -f pdp11 && ./pdp11 2>/dev/null; then dflt='unsplit split' else @@ -3074,6 +3143,8 @@ fi if $test -f cc.cbu; then . ./cc.cbu fi +. ./checkcc + echo " " echo "Checking for GNU cc in disguise and/or its version number..." >&4 $cat >gccvers.c <<EOM @@ -3111,6 +3182,186 @@ $rm -f gccvers* case "$gccversion" in 1*) cpp=`./loc gcc-cpp $cpp $pth` ;; esac +case "$gccversion" in +'') gccosandvers='' ;; +*) gccosandvers=`$cc -v 2>&1|grep '/specs$'|sed 's!.*/[^-]*-[^-]*-\([^/]*\)/'$gccversion'/specs$!\1!'` + case "$gccosandvers" in + $osname) gccosandvers='' ;; # linux gccs seem to have no linux osvers, grr + $osname$osvers) ;; # looking good + $osname*) cat <<EOM >&4 + +*** WHOA THERE!!! *** + + Your gcc has not been compiled for the exact release of + your operating system ($gccosandvers versus $osname$osvers). + + In general it is a good idea to keep gcc synchronized with + the operating system because otherwise serious problems + may ensue when trying to compile software, like Perl. + + I'm trying to be optimistic here, though, and will continue. + If later during the configuration and build icky compilation + problems appear (headerfile conflicts being the most common + manifestation), I suggest reinstalling the gcc to match + your operating system release. + +EOM + ;; + *) gccosandvers='' ;; # failed to parse, better be silent + esac + ;; +esac + + + + +: see how we invoke the C preprocessor +echo " " +echo "Now, how can we feed standard input to your C preprocessor..." >&4 +cat <<'EOT' >testcpp.c +#define ABC abc +#define XYZ xyz +ABC.XYZ +EOT +cd .. +if test ! -f cppstdin; then + if test "X$osname" = "Xaix" -a "X$gccversion" = X; then + # AIX cc -E doesn't show the absolute headerfile + # locations but we'll cheat by using the -M flag. + echo 'cat >.$$.c; rm -f .$$.u; '"$cc"' ${1+"$@"} -M -c .$$.c 2>/dev/null; test -s .$$.u && awk '"'"'$2 ~ /\.h$/ { print "# 0 \""$2"\"" }'"'"' .$$.u; rm -f .$$.o .$$.u; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' > cppstdin + else + echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin + fi +else + echo "Keeping your $hint cppstdin wrapper." +fi +chmod 755 cppstdin +wrapper=`pwd`/cppstdin +ok='false' +cd UU + +if $test "X$cppstdin" != "X" && \ + $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 +then + echo "You used to use $cppstdin $cppminus so we'll use that again." + case "$cpprun" in + '') echo "But let's see if we can live without a wrapper..." ;; + *) + if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 + then + echo "(And we'll use $cpprun $cpplast to preprocess directly.)" + ok='true' + else + echo "(However, $cpprun $cpplast does not work, let's see...)" + fi + ;; + esac +else + case "$cppstdin" in + '') ;; + *) + echo "Good old $cppstdin $cppminus does not seem to be of any help..." + ;; + esac +fi + +if $ok; then + : nothing +elif echo 'Maybe "'"$cc"' -E" will work...'; \ + $cc -E <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yup, it does." + x_cpp="$cc -E" + x_minus=''; +elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \ + $cc -E - <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yup, it does." + x_cpp="$cc -E" + x_minus='-'; +elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \ + $cc -P <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yipee, that works!" + x_cpp="$cc -P" + x_minus=''; +elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \ + $cc -P - <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "At long last!" + x_cpp="$cc -P" + x_minus='-'; +elif echo 'No such luck, maybe "'$cpp'" will work...'; \ + $cpp <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "It works!" + x_cpp="$cpp" + x_minus=''; +elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \ + $cpp - <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Hooray, it works! I was beginning to wonder." + x_cpp="$cpp" + x_minus='-'; +elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \ + $wrapper <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + x_cpp="$wrapper" + x_minus='' + echo "Eureka!" +else + dflt='' + rp="No dice. I can't find a C preprocessor. Name one:" + . ./myread + x_cpp="$ans" + x_minus='' + $x_cpp <testcpp.c >testcpp.out 2>&1 + if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "OK, that will do." >&4 + else +echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 + exit 1 + fi +fi + +case "$ok" in +false) + cppstdin="$x_cpp" + cppminus="$x_minus" + cpprun="$x_cpp" + cpplast="$x_minus" + set X $x_cpp + shift + case "$1" in + "$cpp") + echo "Perhaps can we force $cc -E using a wrapper..." + if $wrapper <testcpp.c >testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 + then + echo "Yup, we can." + cppstdin="$wrapper" + cppminus=''; + else + echo "Nope, we'll have to live without it..." + fi + ;; + esac + case "$cpprun" in + "$wrapper") + cpprun='' + cpplast='' + ;; + esac + ;; +esac + +case "$cppstdin" in +"$wrapper"|'cppstdin') ;; +*) $rm -f $wrapper;; +esac +$rm -f testcpp.c testcpp.out : decide how portable to be. Allow command line overrides. case "$d_portable" in @@ -3277,6 +3528,7 @@ while test "$type"; do true) case "$ansexp" in /*) value="$ansexp" ;; + [a-zA-Z]:/*) value="$ansexp" ;; *) redo=true case "$already" in @@ -3404,7 +3656,7 @@ if $test -f /bin/mips && /bin/mips; then /bsd43 #endif EOCP - if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then + if cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then dflt='/bsd43/usr/include' incpath='/bsd43' mips_type='BSD 4.3' @@ -3437,154 +3689,6 @@ y) fn=d/ ;; esac -: see how we invoke the C preprocessor -echo " " -echo "Now, how can we feed standard input to your C preprocessor..." >&4 -cat <<'EOT' >testcpp.c -#define ABC abc -#define XYZ xyz -ABC.XYZ -EOT -cd .. -if test ! -f cppstdin; then - if test "X$osname" = "Xaix" -a "X$gccversion" = X; then - # AIX cc -E doesn't show the absolute headerfile - # locations but we'll cheat by using the -M flag. - echo 'cat >.$$.c; rm -f .$$.u; '"$cc"' ${1+"$@"} -M -c .$$.c 2>/dev/null; test -s .$$.u && awk '"'"'$2 ~ /\.h$/ { print "# 0 \""$2"\"" }'"'"' .$$.u; rm -f .$$.o .$$.u; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' > cppstdin - else - echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin - fi -else - echo "Keeping your $hint cppstdin wrapper." -fi -chmod 755 cppstdin -wrapper=`pwd`/cppstdin -ok='false' -cd UU - -if $test "X$cppstdin" != "X" && \ - $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 -then - echo "You used to use $cppstdin $cppminus so we'll use that again." - case "$cpprun" in - '') echo "But let's see if we can live without a wrapper..." ;; - *) - if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 - then - echo "(And we'll use $cpprun $cpplast to preprocess directly.)" - ok='true' - else - echo "(However, $cpprun $cpplast does not work, let's see...)" - fi - ;; - esac -else - case "$cppstdin" in - '') ;; - *) - echo "Good old $cppstdin $cppminus does not seem to be of any help..." - ;; - esac -fi - -if $ok; then - : nothing -elif echo 'Maybe "'"$cc"' -E" will work...'; \ - $cc -E <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yup, it does." - x_cpp="$cc -E" - x_minus=''; -elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \ - $cc -E - <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yup, it does." - x_cpp="$cc -E" - x_minus='-'; -elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \ - $cc -P <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yipee, that works!" - x_cpp="$cc -P" - x_minus=''; -elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \ - $cc -P - <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "At long last!" - x_cpp="$cc -P" - x_minus='-'; -elif echo 'No such luck, maybe "'$cpp'" will work...'; \ - $cpp <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "It works!" - x_cpp="$cpp" - x_minus=''; -elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \ - $cpp - <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Hooray, it works! I was beginning to wonder." - x_cpp="$cpp" - x_minus='-'; -elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \ - $wrapper <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - x_cpp="$wrapper" - x_minus='' - echo "Eureka!" -else - dflt='' - rp="No dice. I can't find a C preprocessor. Name one:" - . ./myread - x_cpp="$ans" - x_minus='' - $x_cpp <testcpp.c >testcpp.out 2>&1 - if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "OK, that will do." >&4 - else -echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 - exit 1 - fi -fi - -case "$ok" in -false) - cppstdin="$x_cpp" - cppminus="$x_minus" - cpprun="$x_cpp" - cpplast="$x_minus" - set X $x_cpp - shift - case "$1" in - "$cpp") - echo "Perhaps can we force $cc -E using a wrapper..." - if $wrapper <testcpp.c >testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 - then - echo "Yup, we can." - cppstdin="$wrapper" - cppminus=''; - else - echo "Nope, we'll have to live without it..." - fi - ;; - esac - case "$cpprun" in - "$wrapper") - cpprun='' - cpplast='' - ;; - esac - ;; -esac - -case "$cppstdin" in -"$wrapper"|'cppstdin') ;; -*) $rm -f $wrapper;; -esac -$rm -f testcpp.c testcpp.out - : Set private lib path case "$plibpth" in '') if ./mips; then @@ -8524,10 +8628,6 @@ eval $inlibc set endservent d_endsent eval $inlibc -: see if endspent exists -set endspent d_endspent -eval $inlibc - : Locate the flags for 'open()' echo " " $cat >open3.c <<'EOCP' @@ -9188,6 +9288,10 @@ esac set getcwd d_getcwd eval $inlibc +: see if getespwnam exists +set getespwnam d_getespwnam +eval $inlibc + : see if getfsstat exists set getfsstat d_getfsstat @@ -9366,6 +9470,10 @@ echo " " set d_getprotoprotos getprotoent $i_netdb netdb.h eval $hasproto +: see if getprpwnam exists +set getprpwnam d_getprpwnam +eval $inlibc + : see if getpwent exists set getpwent d_getpwent eval $inlibc @@ -9388,10 +9496,6 @@ echo " " set d_getservprotos getservent $i_netdb netdb.h eval $hasproto -: see if getspent exists -set getspent d_getspent -eval $inlibc - : see if getspnam exists set getspnam d_getspnam eval $inlibc @@ -9691,7 +9795,7 @@ echo 'int main() { long long x = 7; return 0; }' > try.c set try if eval $compile; then val="$define" - echo "You have have long long." + echo "You have long long." else val="$undef" echo "You do not have long long." @@ -10201,6 +10305,39 @@ esac $rm -f try.* try +case "$d_nv_preserves_uv" in +"$define") d_nv_preserves_uv_bits=`expr $uvsize \* 8` ;; +*) $echo "Checking how many bits of your UVs your NVs can preserve..." >&4 + $cat <<EOP >try.c +#include <stdio.h> +int main() { + $uvtype u = 0; + int n = 8 * $uvsize; + int i; + for (i = 0; i < n; i++) { + u = u << 1 | ($uvtype)1; + if (($uvtype)($nvtype)u != u) + break; + } + printf("%d\n", i); + exit(0); +} +EOP + set try + if eval $compile; then + d_nv_preserves_uv_bits="`./try$exe_ext`" + fi + case "$d_nv_preserves_uv_bits" in + [1-9]*) $echo "Your NVs can preserve $d_nv_preserves_uv_bits bits of your UVs." 2>&1 ;; + *) $echo "Can't figure out how many bits your NVs preserve." 2>&1 + d_nv_preserves_uv_bits="$undef" + ;; + esac + $rm -f try.* try + ;; +esac + + : check for off64_t echo " " @@ -10995,6 +11132,10 @@ eval $inlibc set setpriority d_setprior eval $inlibc +: see if setproctitle exists +set setproctitle d_setproctitle +eval $inlibc + : see if setpwent exists set setpwent d_setpwent eval $inlibc @@ -11027,10 +11168,6 @@ eval $inlibc set setsid d_setsid eval $inlibc -: see if setspent exists -set setspent d_setspent -eval $inlibc - : see if setvbuf exists set setvbuf d_setvbuf eval $inlibc @@ -14236,6 +14373,10 @@ eval $inhdr set ieeefp.h i_ieeefp eval $inhdr +: see if this is a libutil.h system +set libutil.h i_libutil +eval $inhdr + : see if locale.h is available set locale.h i_locale eval $inhdr @@ -14315,6 +14456,10 @@ eval $inhdr set poll.h i_poll eval $inhdr +: see if this is a prot.h system +set prot.h i_prot +eval $inhdr + echo " " $echo "Guessing which symbols your C compiler and preprocessor define..." >&4 $cat <<'EOSH' > Cppsym.know @@ -14886,6 +15031,12 @@ for xxx in $known_extensions ; do true|$define|y) avail_ext="$avail_ext $xxx" ;; esac ;; + Sys/Syslog|sys/syslog) + : XXX syslog requires socket + case "$d_socket" in + true|$define|y) avail_ext="$avail_ext $xxx" ;; + esac + ;; Thread|thread) case "$usethreads" in true|$define|y) avail_ext="$avail_ext $xxx" ;; @@ -15223,7 +15374,6 @@ d_endnent='$d_endnent' d_endpent='$d_endpent' d_endpwent='$d_endpwent' d_endsent='$d_endsent' -d_endspent='$d_endspent' d_eofnblk='$d_eofnblk' d_eunice='$d_eunice' d_fchmod='$d_fchmod' @@ -15247,6 +15397,7 @@ d_fstatvfs='$d_fstatvfs' d_ftello='$d_ftello' d_ftime='$d_ftime' d_getcwd='$d_getcwd' +d_getespwnam='$d_getespwnam' d_getfsstat='$d_getfsstat' d_getgrent='$d_getgrent' d_getgrps='$d_getgrps' @@ -15271,12 +15422,12 @@ d_getpgrp='$d_getpgrp' d_getppid='$d_getppid' d_getprior='$d_getprior' d_getprotoprotos='$d_getprotoprotos' +d_getprpwnam='$d_getprpwnam' d_getpwent='$d_getpwent' d_getsbyname='$d_getsbyname' d_getsbyport='$d_getsbyport' d_getsent='$d_getsent' d_getservprotos='$d_getservprotos' -d_getspent='$d_getspent' d_getspnam='$d_getspnam' d_gettimeod='$d_gettimeod' d_gnulibc='$d_gnulibc' @@ -15333,6 +15484,7 @@ d_munmap='$d_munmap' d_mymalloc='$d_mymalloc' d_nice='$d_nice' d_nv_preserves_uv='$d_nv_preserves_uv' +d_nv_preserves_uv_bits='$d_nv_preserves_uv_bits' d_off64_t='$d_off64_t' d_old_pthread_create_joinable='$d_old_pthread_create_joinable' d_oldpthreads='$d_oldpthreads' @@ -15387,6 +15539,7 @@ d_setpgid='$d_setpgid' d_setpgrp2='$d_setpgrp2' d_setpgrp='$d_setpgrp' d_setprior='$d_setprior' +d_setproctitle='$d_setproctitle' d_setpwent='$d_setpwent' d_setregid='$d_setregid' d_setresgid='$d_setresgid' @@ -15396,7 +15549,6 @@ d_setrgid='$d_setrgid' d_setruid='$d_setruid' d_setsent='$d_setsent' d_setsid='$d_setsid' -d_setspent='$d_setspent' d_setvbuf='$d_setvbuf' d_sfio='$d_sfio' d_shm='$d_shm' @@ -15496,6 +15648,7 @@ freetype='$freetype' full_ar='$full_ar' full_csh='$full_csh' full_sed='$full_sed' +gccosandvers='$gccosandvers' gccversion='$gccversion' gidformat='$gidformat' gidsign='$gidsign' @@ -15533,6 +15686,7 @@ i_grp='$i_grp' i_iconv='$i_iconv' i_ieeefp='$i_ieeefp' i_inttypes='$i_inttypes' +i_libutil='$i_libutil' i_limits='$i_limits' i_locale='$i_locale' i_machcthr='$i_machcthr' @@ -15546,6 +15700,7 @@ i_neterrno='$i_neterrno' i_netinettcp='$i_netinettcp' i_niin='$i_niin' i_poll='$i_poll' +i_prot='$i_prot' i_pthread='$i_pthread' i_pwd='$i_pwd' i_rpcsvcdbm='$i_rpcsvcdbm' @@ -31,6 +31,7 @@ INSTALL INTERN.h MANIFEST Makefile.SH +Makefile.micro simon objXSUB.h Policy_sh.SH Porting/* cfg @@ -56,6 +57,7 @@ README.dos dos README.hpux hpux README.lexwarn lexwarn README.machten machten +README.micro simon README.mpeix mpeix README.os2 os2 README.os390 mvs @@ -69,6 +71,7 @@ README.vos vos README.win32 win32 Todo Todo-5.005 +Todo.micro simon XSlock.h XSUB.h av.c @@ -434,10 +437,13 @@ lib/Pod/Checker.pm bradapp lib/Pod/Functions.pm lib/Pod/Html.pm tchrist lib/Pod/InputObjects.pm bradapp +lib/Pod/LaTeX.pm tjenness +lib/Pod/Man.pm rra lib/Pod/Parser.pm bradapp lib/Pod/PlainText.pm bradapp lib/Pod/Select.pm bradapp -lib/Pod/Text.pm tchrist +lib/Pod/Text.pm rra +lib/Pod/Text/* rra lib/Pod/Usage.pm bradapp lib/Search/Dict.pm lib/SelectSaver.pm @@ -588,7 +594,9 @@ pod/perllocale.pod locale pod/perllol.pod tchrist pod/perlmod.pod pod/perlmodinstall.pod jon -pod/perlmodlib.pod +pod/perlmodlib.pod simon +pod/perlmodlib.PL simon +pod/perlnewmod.pod simon pod/perlobj.pod pod/perlop.pod pod/perlpod.pod lwall @@ -843,6 +851,8 @@ taint.c thrdvar.h thread.h toke.c +uconfig.h simon +uconfig.sh simon universal.c unixish.h utf* lwall @@ -16,6 +16,7 @@ INTERN.h Included before domestic .h files MAINTAIN Who maintains which files MANIFEST This list of files Makefile.SH A script that generates Makefile +Makefile.micro microperl Makefile Policy_sh.SH Hold site-wide preferences between Configure runs. Porting/Contract Social contract for contributed modules in Perl core Porting/Glossary Glossary of config.sh variables @@ -42,6 +43,7 @@ README.epoc Notes about EPOC port README.hpux Notes about HP-UX port README.hurd Notes about GNU/Hurd port README.machten Notes about Power MachTen port +README.micro Notes about microperl README.mint Notes about Atari MiNT port README.mpeix Notes about MPE/iX port README.os2 Notes about OS/2 port @@ -56,6 +58,7 @@ README.vos Notes about Stratus VOS port README.win32 Notes about Win32 port Todo The Wishlist Todo-5.6 What needs doing before/during the 5.6.x release cycle +Todo.micro The Wishlist for microperl XSUB.h Include file for extension subroutines apollo/netinet/in.h Apollo DomainOS port: C header file frontend av.c Array value code @@ -239,6 +242,7 @@ ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_dyld.xs NeXT/Apple dyld implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation +ext/DynaLoader/dl_mac.xs MacOS implementation ext/DynaLoader/dl_mpeix.xs MPE/iX implementation ext/DynaLoader/dl_next.xs NeXT implementation ext/DynaLoader/dl_none.xs Stub implementation @@ -247,6 +251,7 @@ ext/DynaLoader/dl_vms.xs VMS implementation ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files ext/DynaLoader/hints/aix.pl Hint for DynaLoader for named architecture ext/DynaLoader/hints/linux.pl Hint for DynaLoader for named architecture +ext/DynaLoader/hints/netbsd.pl Hint for DynaLoader for named architecture ext/DynaLoader/hints/openbsd.pl Hint for DynaLoader for named architecture ext/Errno/ChangeLog Errno perl module change log ext/Errno/Errno_pm.PL Errno perl module create script @@ -409,6 +414,7 @@ ext/re/re.xs re extension external subroutines ext/util/make_ext Used by Makefile to execute extension Makefiles ext/util/mkbootstrap Turns ext/*/*_BS into bootstrap info fakethr.h Fake threads header +fix_pl Fix up patchlevel.h for repository perls form.h Public declarations for the above global.sym Symbols that need hiding when embedded globals.c File to declare global symbols (for shared library) @@ -642,6 +648,7 @@ 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/LaTeX.pm Convert POD data to LaTeX 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 @@ -715,7 +722,7 @@ lib/hostname.pl Old hostname code lib/importenv.pl Perl routine to get environment into variables lib/integer.pm For "use integer" lib/less.pm For "use less" -lib/lib.pm For "use lib" +lib/lib_pm.PL For "use lib", produces lib/lib.pm lib/locale.pm For "use locale" lib/look.pl A "look" equivalent lib/newgetopt.pl A perl library supporting long option parsing @@ -836,26 +843,37 @@ lib/unicode/Index.txt Unicode character database lib/unicode/Is/ASCII.pl Unicode character database lib/unicode/Is/Alnum.pl Unicode character database lib/unicode/Is/Alpha.pl Unicode character database +lib/unicode/Is/BidiAL.pl Unicode character database lib/unicode/Is/BidiAN.pl Unicode character database lib/unicode/Is/BidiB.pl Unicode character database +lib/unicode/Is/BidiBN.pl Unicode character database lib/unicode/Is/BidiCS.pl Unicode character database lib/unicode/Is/BidiEN.pl Unicode character database lib/unicode/Is/BidiES.pl Unicode character database lib/unicode/Is/BidiET.pl Unicode character database lib/unicode/Is/BidiL.pl Unicode character database +lib/unicode/Is/BidiLRE.pl Unicode character database +lib/unicode/Is/BidiLRO.pl Unicode character database +lib/unicode/Is/BidiNSM.pl Unicode character database lib/unicode/Is/BidiON.pl Unicode character database +lib/unicode/Is/BidiPDF.pl Unicode character database lib/unicode/Is/BidiR.pl Unicode character database +lib/unicode/Is/BidiRLE.pl Unicode character database +lib/unicode/Is/BidiRLO.pl Unicode character database lib/unicode/Is/BidiS.pl Unicode character database lib/unicode/Is/BidiWS.pl Unicode character database lib/unicode/Is/C.pl Unicode character database lib/unicode/Is/Cc.pl Unicode character database +lib/unicode/Is/Cf.pl Unicode character database lib/unicode/Is/Cn.pl Unicode character database lib/unicode/Is/Cntrl.pl Unicode character database lib/unicode/Is/Co.pl Unicode character database +lib/unicode/Is/Cs.pl Unicode character database lib/unicode/Is/DCcircle.pl Unicode character database lib/unicode/Is/DCcompat.pl Unicode character database lib/unicode/Is/DCfinal.pl Unicode character database lib/unicode/Is/DCfont.pl Unicode character database +lib/unicode/Is/DCfraction.pl Unicode character database lib/unicode/Is/DCinital.pl Unicode character database lib/unicode/Is/DCinitial.pl Unicode character database lib/unicode/Is/DCisolated.pl Unicode character database @@ -909,34 +927,53 @@ lib/unicode/Is/Lt.pl Unicode character database lib/unicode/Is/Lu.pl Unicode character database lib/unicode/Is/M.pl Unicode character database lib/unicode/Is/Mc.pl Unicode character database +lib/unicode/Is/Me.pl Unicode character database lib/unicode/Is/Mirrored.pl Unicode character database lib/unicode/Is/Mn.pl Unicode character database lib/unicode/Is/N.pl Unicode character database lib/unicode/Is/Nd.pl Unicode character database +lib/unicode/Is/Nl.pl Unicode character database lib/unicode/Is/No.pl Unicode character database lib/unicode/Is/P.pl Unicode character database +lib/unicode/Is/Pc.pl Unicode character database lib/unicode/Is/Pd.pl Unicode character database lib/unicode/Is/Pe.pl Unicode character database +lib/unicode/Is/Pf.pl Unicode character database +lib/unicode/Is/Pi.pl Unicode character database lib/unicode/Is/Po.pl Unicode character database lib/unicode/Is/Print.pl Unicode character database lib/unicode/Is/Ps.pl Unicode character database lib/unicode/Is/Punct.pl Unicode character database lib/unicode/Is/S.pl Unicode character database lib/unicode/Is/Sc.pl Unicode character database +lib/unicode/Is/Sk.pl Unicode character database lib/unicode/Is/Sm.pl Unicode character database lib/unicode/Is/So.pl Unicode character database lib/unicode/Is/Space.pl Unicode character database lib/unicode/Is/SylA.pl Unicode character database +lib/unicode/Is/SylAA.pl Unicode character database +lib/unicode/Is/SylAAI.pl Unicode character database +lib/unicode/Is/SylAI.pl Unicode character database lib/unicode/Is/SylC.pl Unicode character database lib/unicode/Is/SylE.pl Unicode character database +lib/unicode/Is/SylEE.pl Unicode character database lib/unicode/Is/SylI.pl Unicode character database +lib/unicode/Is/SylII.pl Unicode character database +lib/unicode/Is/SylN.pl Unicode character database lib/unicode/Is/SylO.pl Unicode character database +lib/unicode/Is/SylOO.pl Unicode character database lib/unicode/Is/SylU.pl Unicode character database lib/unicode/Is/SylV.pl Unicode character database lib/unicode/Is/SylWA.pl Unicode character database +lib/unicode/Is/SylWAA.pl Unicode character database lib/unicode/Is/SylWC.pl Unicode character database lib/unicode/Is/SylWE.pl Unicode character database +lib/unicode/Is/SylWEE.pl Unicode character database lib/unicode/Is/SylWI.pl Unicode character database +lib/unicode/Is/SylWII.pl Unicode character database +lib/unicode/Is/SylWO.pl Unicode character database +lib/unicode/Is/SylWOO.pl Unicode character database +lib/unicode/Is/SylWU.pl Unicode character database lib/unicode/Is/SylWV.pl Unicode character database lib/unicode/Is/Syllable.pl Unicode character database lib/unicode/Is/Upper.pl Unicode character database @@ -973,6 +1010,7 @@ lib/validate.pl Perl library supporting wholesale file mode validation lib/vars.pm Declare pseudo-imported global variables lib/warnings.pm For "use warnings" lib/warnings/register.pm For "use warnings::register" +lib/Win32.pod Documentation for Win32 extras makeaperl.SH perl script that produces a new perl binary makedef.pl Create symbol export lists for linking makedepend.SH Precursor to makedepend @@ -1082,17 +1120,16 @@ plan9/plan9.c Plan9 port: Plan9-specific C routines plan9/plan9ish.h Plan9 port: Plan9-specific C header file plan9/setup.rc Plan9 port: script for easy build+install plan9/versnum Plan9 port: script to print version number -pod/Makefile Make pods into something else -pod/Win32.pod Documentation for Win32 extras -pod/buildtoc generate perltoc.pod +pod/Makefile.SH generate Makefile whichs makes pods into something else +pod/buildtoc.PL generate buildtoc which generates perltoc.pod pod/checkpods.PL Tool to check for common errors in pods -pod/perl.pod Top level perl man page +pod/perl.pod Top level perl documentation pod/perl5004delta.pod Changes from 5.003 to 5.004 pod/perl5005delta.pod Changes from 5.004 to 5.005 pod/perl56delta.pod Changes from 5.005 to 5.6 pod/perlapi.pod Perl API documentation (autogenerated) pod/perlapio.pod IO API info -pod/perlbook.pod Book info +pod/perlbook.pod Perl book information pod/perlboot.pod Beginner's Object-oriented Tutorial pod/perlbot.pod Object-oriented Bag o' Tricks pod/perlcall.pod Callback info @@ -1130,7 +1167,9 @@ pod/perllol.pod How to use lists of lists pod/perlmod.pod Module mechanism info pod/perlmodinstall.pod Installing CPAN Modules pod/perlmodlib.pod Module policy info +pod/perlmodlib.PL Generate pod/perlmodlib.pod pod/perlnumber.pod Semantics of numbers and numeric operations +pod/perlnewmod.pod Preparing a new module for distribution pod/perlobj.pod Object info pod/perlop.pod Operator info pod/perlopentut.pod open() tutorial @@ -1154,6 +1193,7 @@ pod/perltoot.pod Tom's object-oriented tutorial pod/perltootc.pod Tom's object-oriented tutorial (more on class data) pod/perltrap.pod Trap info pod/perlunicode.pod Unicode support info +pod/perlutil.pod Accompanying utilities explained pod/perlvar.pod Variable info pod/perlxs.pod XS api info pod/perlxstut.pod XS tutorial @@ -1333,6 +1373,7 @@ t/lib/safe2.t See if Safe works t/lib/sdbm.t See if SDBM_File works t/lib/searchdict.t See if Search::Dict works t/lib/selectsaver.t See if SelectSaver works +t/lib/selfloader.t See if SelfLoader works t/lib/socket.t See if Socket works t/lib/soundex.t See if Soundex works t/lib/symbol.t See if Symbol works @@ -1400,6 +1441,7 @@ t/op/method.t See if method calls work t/op/misc.t See if miscellaneous bugs have been fixed t/op/mkdir.t See if mkdir works t/op/my.t See if lexical scoping works +t/op/my_stash.t See if my Package works t/op/nothr5005.t local @_ test which does not work under use5005threads t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work @@ -1528,6 +1570,8 @@ taint.c Tainting code thrdvar.h Per-thread variables thread.h Threading header toke.c The tokener +uconfig.h Configuration header for microperl +uconfig.sh Configuration script for microperl universal.c The default UNIVERSAL package methods unixish.h Defines that are assumed on Unix utf8.c Unicode routines diff --git a/Makefile.SH b/Makefile.SH index 285269de44..caa647b7dc 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -222,21 +222,24 @@ private = preplibrary lib/ExtUtils/Miniperl.pm lib/Config.pm # Files to be built with variable substitution before miniperl # is available. sh = Makefile.SH cflags.SH config_h.SH makeaperl.SH makedepend.SH \ - makedir.SH myconfig.SH writemain.SH + makedir.SH myconfig.SH writemain.SH pod/Makefile.SH shextract = Makefile cflags config.h makeaperl makedepend \ - makedir myconfig writemain + makedir myconfig writemain pod/Makefile # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). pl = pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL \ - pod/pod2usage.PL pod/podchecker.PL pod/podselect.PL + pod/pod2usage.PL pod/podchecker.PL pod/podselect.PL \ + pod/buildtoc.PL +# lib/lib.pm is not listed here because it has a rule of its own. plextract = pod/pod2html pod/pod2latex pod/pod2man pod/pod2text \ - pod/pod2usage pod/podchecker pod/podselect + pod/pod2usage pod/podchecker pod/podselect \ + pod/buildtoc -addedbyconf = UU $(shextract) $(plextract) pstruct +addedbyconf = UU $(shextract) $(plextract) lib/lib.pm pstruct h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h @@ -286,7 +289,7 @@ compile: all translators: miniperl lib/Config.pm FORCE @echo " "; echo " Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all -utilities: miniperl lib/Config.pm $(plextract) FORCE +utilities: miniperl lib/Config.pm $(plextract) lib/lib.pm FORCE @echo " "; echo " Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all @@ -304,7 +307,7 @@ opmini$(OBJ_EXT): op.c $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB opmini.c $(RMS) opmini.c -miniperlmain$(OBJ_EXT): miniperlmain.c +miniperlmain$(OBJ_EXT): miniperlmain.c patchlevel.h $(CCCMD) $(PLDLFLAGS) $*.c perlmain.c: miniperlmain.c config.sh $(FIRSTMAKEFILE) @@ -322,6 +325,15 @@ ext.libs: $(static_ext) !NO!SUBS! +# if test -f .patch ; then $spitshell >>Makefile <<'!NO!SUBS!' +# patchlevel.h: .patch +# perl fix_pl || (make -f Makefile.micro && ./microperl fix_pl) +# $(SHELL) Makefile.SH + +!NO!SUBS! + +fi + # How to build libperl. This is still rather convoluted. # Load up custom Makefile.SH fragment for shared loading and executables: case "$osname" in @@ -526,6 +538,9 @@ lib/re.pm: ext/re/re.pm $(plextract): miniperl lib/Config.pm $(LDLIBPTH) ./miniperl -Ilib $@.PL +lib/lib.pm: miniperl lib/Config.pm + $(LDLIBPTH) ./miniperl -Ilib lib/lib_pm.PL + extra.pods: miniperl -@test -f extra.pods && rm -f `cat extra.pods` -@rm -f extra.pods @@ -635,6 +650,9 @@ regen_headers: FORCE -perl regcomp.pl -perl warnings.pl +regen_pods: FORCE + -cd pod; $(LDLIBPTH) make regen_pods + # Extensions: # Names added to $(dynamic_ext) or $(static_ext) or $(nonxs_ext) will # automatically get built. There should ordinarily be no need to change @@ -675,7 +693,7 @@ _mopup: -rm -f perl.exp ext.libs extra.pods -rm -f perl.export perl.dll perl.libexp perl.map perl.def -rm -f perl.loadmap miniperl.loadmap perl.prelmap miniperl.prelmap - rm -f perl suidperl miniperl $(LIBPERL) + rm -f perl suidperl miniperl $(LIBPERL) libperl.* microperl # Do not 'make _tidy' directly. _tidy: @@ -696,7 +714,7 @@ _cleaner: -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \ $(LDLIBPTH) sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \ done - rm -f *.orig */*.orig *~ */*~ core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/tmp* t/c t/perl .?*.c so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) + rm -f core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/forktmp* t/tmp* t/c t/perl .?*.c so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) rm -rf $(addedbyconf) rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old rm -f $(private) diff --git a/Makefile.micro b/Makefile.micro new file mode 100644 index 0000000000..1ac87b4ed7 --- /dev/null +++ b/Makefile.micro @@ -0,0 +1,125 @@ +CC = cc +LD = $(CC) +DEFINES = -DPERL_CORE -DPERL_MICRO +CFLAGS = $(DEFINES) +LIBS = -lm +_O = .o + +all: microperl + +O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \ + uglobals$(_O) ugv$(_O) uhv$(_O) \ + umg$(_O) uperlmain$(_O) uop$(_O) \ + uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \ + upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) \ + uregcomp$(_O) uregexec$(_O) urun$(_O) \ + uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \ + uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) + +microperl: $(O) + $(LD) -o $@ $(O) $(LIBS) + +H = av.h uconfig.h cop.h cv.h embed.h embedvar.h form.h gv.h handy.h \ + hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h patchlevel.h \ + perl.h perlsdio.h perlvars.h perly.h pp.h pp_proto.h proto.h \ + regexp.h scope.h sv.h thrdvar.h thread.h unixish.h utf8.h util.h \ + warnings.h + +HE = $(H) EXTERN.h + +clean: + -rm -f $(O) microperl + +distclean: clean + -rm -f uconfig.h + +uconfig.h: uconfig.sh config_h.SH + CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH + +uav$(_O): $(HE) av.c + $(CC) -c -o $@ $(CFLAGS) av.c + +udeb$(_O): $(HE) deb.c + $(CC) -c -o $@ $(CFLAGS) deb.c + +udoio$(_O): $(HE) doio.c + $(CC) -c -o $@ $(CFLAGS) doio.c + +udoop$(_O): $(HE) doop.c + $(CC) -c -o $@ $(CFLAGS) doop.c + +udump$(_O): $(HE) dump.c regcomp.h regnodes.h + $(CC) -c -o $@ $(CFLAGS) dump.c + +uglobals$(_O): $(H) globals.c INTERN.h perlapi.h + $(CC) -c -o $@ $(CFLAGS) globals.c + +ugv$(_O): $(HE) gv.c + $(CC) -c -o $@ $(CFLAGS) gv.c + +uhv$(_O): $(HE) hv.c + $(CC) -c -o $@ $(CFLAGS) hv.c + +umg$(_O): $(HE) mg.c + $(CC) -c -o $@ $(CFLAGS) mg.c + +uperlmain$(_O): $(HE) miniperlmain.c + $(CC) -c -o $@ $(CFLAGS) miniperlmain.c + +uop$(_O): $(HE) op.c keywords.h + $(CC) -c -o $@ $(CFLAGS) op.c + +uperl$(_O): $(HE) perl.c + $(CC) -c -o $@ $(CFLAGS) perl.c + +uperlio$(_O): $(HE) perlio.c + $(CC) -c -o $@ $(CFLAGS) perlio.c + +uperly$(_O): $(HE) perly.c + $(CC) -c -o $@ $(CFLAGS) perly.c + +upp$(_O): $(HE) pp.c + $(CC) -c -o $@ $(CFLAGS) pp.c + +upp_ctl$(_O): $(HE) pp_ctl.c + $(CC) -c -o $@ $(CFLAGS) pp_ctl.c + +upp_hot$(_O): $(HE) pp_hot.c + $(CC) -c -o $@ $(CFLAGS) pp_hot.c + +upp_sys$(_O): $(HE) pp_sys.c + $(CC) -c -o $@ $(CFLAGS) pp_sys.c + +uregcomp$(_O): $(HE) regcomp.c regcomp.h regnodes.h INTERN.h + $(CC) -c -o $@ $(CFLAGS) regcomp.c + +uregexec$(_O): $(HE) regexec.c regcomp.h regnodes.h + $(CC) -c -o $@ $(CFLAGS) regexec.c + +urun$(_O): $(HE) run.c + $(CC) -c -o $@ $(CFLAGS) run.c + +uscope$(_O): $(HE) scope.c + $(CC) -c -o $@ $(CFLAGS) scope.c + +usv$(_O): $(HE) sv.c + $(CC) -c -o $@ $(CFLAGS) sv.c + +utaint$(_O): $(HE) taint.c + $(CC) -c -o $@ $(CFLAGS) taint.c + +utoke$(_O): $(HE) toke.c keywords.h + $(CC) -c -o $@ $(CFLAGS) toke.c + +uuniversal$(_O): $(HE) universal.c objXSUB.h XSUB.h + $(CC) -c -o $@ $(CFLAGS) universal.c + +uutf8$(_O): $(HE) utf8.c + $(CC) -c -o $@ $(CFLAGS) utf8.c + +uutil$(_O): $(HE) util.c + $(CC) -c -o $@ $(CFLAGS) util.c + +uperlapi$(_O): $(HE) perlapi.c perlapi.h + $(CC) -c -o $@ $(CFLAGS) perlapi.c + diff --git a/Porting/Glossary b/Porting/Glossary index f5ac6da3fb..f1e7b8e593 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -506,10 +506,6 @@ d_endsent (d_endsent.U): This variable conditionally defines HAS_ENDSERVENT if endservent() is available to close whatever was being used for service queries. -d_endspent (d_endspent.U): - This variable conditionally defines HAS_ENDSPENT if endspent() is - available to finalize the scan of SysV shadow password entries. - d_eofnblk (nblock_io.U): This variable conditionally defines EOF_NONBLOCK if EOF can be seen when reading from a non-blocking I/O source. @@ -620,6 +616,10 @@ d_getcwd (d_getcwd.U): indicates to the C program that the getcwd() routine is available to get the current working directory. +d_getespwnam (d_getespwnam.U): + This variable conditionally defines HAS_GETESPWNAM if getespwnam() is + available to retrieve enchanced (shadow) password entries by name. + d_getfsstat (d_getfsstat.U): This variable conditionally defines the HAS_GETFSSTAT symbol, which indicates to the C program that the getfsstat() routine is available. @@ -739,6 +739,10 @@ d_getprotoprotos (d_getprotoprotos.U): prototypes for the various getproto*() functions. See also netdbtype.U for probing for various netdb types. +d_getprpwnam (d_getprpwnam.U): + This variable conditionally defines HAS_GETPRPWNAM if getprpwnam() is + available to retrieve protected (shadow) password entries by name. + d_getpwent (d_getpwent.U): This variable conditionally defines the HAS_GETPWENT symbol, which indicates to the C program that the getpwent() routine is available @@ -766,10 +770,6 @@ d_getservprotos (d_getservprotos.U): prototypes for the various getserv*() functions. See also netdbtype.U for probing for various netdb types. -d_getspent (d_getspent.U): - This variable conditionally defines HAS_GETSPENT if getspent() is - available to retrieve SysV shadow password entries sequentially. - d_getspnam (d_getspnam.U): This variable conditionally defines HAS_GETSPNAM if getspnam() is available to retrieve SysV shadow password entries by name. @@ -1019,6 +1019,10 @@ d_nv_preserves_uv (perlxv.U): This variable indicates whether a variable of type nvtype can preserve all the bits a variable of type uvtype. +d_nv_preserves_uv_bits (perlxv.U): + This variable indicates how many of bits type uvtype + a variable nvtype can preserve. + d_off64_t (d_off64_t.U): This symbol will be defined if the C compiler supports off64_t. @@ -1351,10 +1355,6 @@ d_setsid (d_setsid.U): This variable conditionally defines HAS_SETSID if setsid() is available to set the process group ID. -d_setspent (d_setspent.U): - This variable conditionally defines HAS_SETSPENT if setspent() is - available to initialize the scan of SysV shadow password entries. - d_setvbuf (d_setvbuf.U): This variable conditionally defines the HAS_SETVBUF symbol, which indicates to the C program that the setvbuf() routine is available @@ -2018,6 +2018,10 @@ i_poll (i_poll.U): This variable conditionally defines the I_POLL symbol, and indicates whether a C program should include <poll.h>. +i_prot (i_prot.U): + This variable conditionally defines the I_PROT symbol, and indicates + whether a C program should include <prot.h>. + i_pthread (i_pthread.U): This variable conditionally defines the I_PTHREAD symbol, and indicates whether a C program should include <pthread.h>. diff --git a/Porting/config.sh b/Porting/config.sh index ec7b1311da..c9e9f711c2 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Fri Apr 28 23:34:47 EET DST 2000 +# Configuration time: Wed May 31 01:48:08 EET DST 2000 # Configured by : jhi # Target system : osf1 alpha.hut.fi v4.0 878 alpha @@ -59,7 +59,7 @@ ccflags='-pthread -std -DLANGUAGE_C' ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_BSD=1 SYSTYPE_BSD=1 unix=1' cf_by='jhi' cf_email='yourname@yourhost.yourplace.com' -cf_time='Fri Apr 28 23:34:47 EET DST 2000' +cf_time='Wed May 31 01:48:08 EET DST 2000' charsize='1' chgrp='' chmod='' @@ -136,7 +136,6 @@ d_endnent='define' d_endpent='define' d_endpwent='define' d_endsent='define' -d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='define' @@ -160,6 +159,7 @@ d_fstatvfs='define' d_ftello='undef' d_ftime='undef' d_getcwd='define' +d_getespwnam='undef' d_getfsstat='define' d_getgrent='define' d_getgrps='define' @@ -184,12 +184,12 @@ d_getpgrp='define' d_getppid='define' d_getprior='define' d_getprotoprotos='define' +d_getprpwnam='undef' d_getpwent='define' d_getsbyname='define' d_getsbyport='define' d_getsent='define' d_getservprotos='define' -d_getspent='undef' d_getspnam='undef' d_gettimeod='define' d_gnulibc='undef' @@ -246,6 +246,7 @@ d_munmap='define' d_mymalloc='undef' d_nice='define' d_nv_preserves_uv='undef' +d_nv_preserves_uv_bits='53' d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' @@ -309,7 +310,6 @@ d_setrgid='define' d_setruid='define' d_setsent='define' d_setsid='define' -d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='define' @@ -459,6 +459,7 @@ i_neterrno='undef' i_netinettcp='define' i_niin='define' i_poll='define' +i_prot='define' i_pthread='define' i_pwd='define' i_rpcsvcdbm='undef' diff --git a/Porting/config_H b/Porting/config_H index 46184ef042..a2c196df82 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Fri Apr 28 23:34:47 EET DST 2000 + * Configuration time: Wed May 31 01:48:08 EET DST 2000 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -1328,12 +1328,6 @@ */ #define HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT / **/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1405,6 +1399,12 @@ */ #define HAS_GETCWD /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM / **/ + /* HAS_GETFSSTAT: * This symbol, if defined, indicates that the getfsstat routine is * available to stat filesystems in bulk. @@ -1535,6 +1535,12 @@ */ #define HAS_GETPROTO_PROTOS /**/ +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM / **/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1556,12 +1562,6 @@ */ #define HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT / **/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. @@ -1743,6 +1743,13 @@ #define HAS_MMAP /**/ #define Mmap_t void * /**/ +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +#define HAS_MODFL /**/ + /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is * available to modify the access protection of a memory mapped file. @@ -1867,12 +1874,6 @@ */ #define HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT / **/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2341,6 +2342,12 @@ */ #define I_POLL /**/ +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +#define I_PROT /**/ + /* I_PTHREAD: * This symbol, if defined, indicates to the C program that it should * include <pthread.h>. @@ -2670,7 +2677,11 @@ */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bits of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE long /**/ #define UVTYPE unsigned long /**/ @@ -2699,6 +2710,7 @@ #endif #define NVSIZE 8 /**/ #undef NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 53 /* IVdf: * This symbol defines the format string used for printing a Perl IV @@ -3118,11 +3130,4 @@ #define PERL_XS_APIVERSION "5.6.0" #define PERL_PM_APIVERSION "5.005" -/* HAS_MODFL: - * This symbol, if defined, indicates that the modfl routine is - * available to split a long double x into a fractional part f and - * an integer part i such that |f| < 1.0 and (f + i) = x. - */ -#define HAS_MODFL /**/ - #endif diff --git a/Porting/p4desc b/Porting/p4desc index 0bf79da2e0..2d1c9d8219 100755 --- a/Porting/p4desc +++ b/Porting/p4desc @@ -6,7 +6,8 @@ # Gurusamy Sarathy <gsar@activestate.com> # -use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles); +use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles + $branches $skip); BEGIN { $0 =~ s|^.*/||; @@ -18,6 +19,9 @@ BEGIN { elsif (/^-p(.*)$/) { $p4port = $1 || ' '; } + elsif (/^-b(.*)$/) { + $branches = $1; + } elsif (/^-v$/) { $v++; } @@ -30,20 +34,28 @@ BEGIN { } unless (@files) { @files = '-'; undef $^I; } @ARGV = @files; + $branches = '//depot/perl/' unless defined $branches; if ($h) { print STDERR <<USAGE; Usage: $0 [-p \$P4PORT] [-v] [-h] [files] - -p host:port p4 port (e.g. myhost:1666) + -phost:port p4 port (e.g. myhost:1666) -h print this help -v output progress messages + -bbranch(es) which branches to include (regex) + (default: //depot/perl/) + -h show this help A smart 'cat'. When fed the spew from "p4 describe ..." on STDIN, spits it right out on STDOUT, followed by patches for any new files detected in the spew. Can also be used to edit insitu a bunch of files containing said spew. -WARNING: Currently only emits unified diffs. +WARNING 1: Currently only emits unified diffs (diff -u). + +WARNING 2: By default only the changes in the //depot/perl branch +are shown. To include all the branches, supply "-b." arguments +to $0. Examples: p4 describe -du 123 | $0 > change-123.desc @@ -65,14 +77,28 @@ my $cur = m|^Affected files| ... m|^Differences|; # while we are within range if ($cur) { - if (m{^\.\.\. (//depot/.+?#\d+) (add|branch)$}) { - my $newfile = $1; - push @addfiles, $newfile; - warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/; + if (m|^\.\.\. |) { + if (m|$branches|) { + if (m{^\.\.\. (//depot/.+?\#\d+) (add|branch)$}) { + my $newfile = $1; + push @addfiles, $newfile; + warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/; + } + } else { + push @skipped, "# $_"; + $_ = ''; + } } warn "file [$file] line [$cur] file# [$fnum]\n" if $v; } +if (m|^==== //depot/|) { + $skip = !m|$branches|; + print "# Skipped because not under branches: $branches\n" if $skip; +} + +$_ = "# $_" if $skip; + if (/^Change (\d+) by/) { $_ = "\n\n" . $_ if $change; # start of a new change list $change = $1; @@ -84,6 +110,9 @@ if (/^Change (\d+) by/) { if (eof) { $_ .= newfiles(); + $_ .= join('', "\n", + "# Skipped because not under branches: $branches\n", + @skipped, "\n") if @skipped; } sub newfiles { @@ -22,8 +22,10 @@ Kit, in the file named "Artistic". If not, I'll be glad to provide one. You should also have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software Foundation, - Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + along with this program in the file named "Copying". If not, write to the + Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA + 02111-1307, USA or visit their web page on the internet at + http://www.gnu.org/copyleft/gpl.html. For those of you that choose to use the GNU General Public License, my interpretation of the GNU General Public License is that no Perl diff --git a/README.cygwin b/README.cygwin index eb6c289881..2a95ab97c3 100644 --- a/README.cygwin +++ b/README.cygwin @@ -31,7 +31,7 @@ about this project can be found at: A recent net or commercial release of Cygwin is required. -At the time this document was written, Cygwin 1.1.1 was current. +At the time this document was last updated, Cygwin 1.1.2 was current. B<NOTE:> At this point, minimal effort has been made to provide compatibility with old (beta) Cygwin releases. The focus has been to @@ -138,6 +138,11 @@ The MD5 port was done by Andy Piper: ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/libcrypt.tgz +There is also a Linux compatible 56 bit DES crypt port by Corinna +Vinschen: + + ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Vinschen_Corinna/V1.1.1/crypt-1.0.tar.gz + =item * C<-lgdbm> (C<use GDBM_File>) GDBM is available for Cygwin. GDBM's ndbm/dbm compatibility feature @@ -353,7 +358,10 @@ these options, these tests will fail: =head2 Hard Links FAT partitions do not support hard links (whereas NTFS does), in which -case Cygwin implements link() by copying the file. These tests will fail: +case Cygwin implements link() by copying the file. On remote (network) +drives Cygwin's stat() always sets C<st_nlink> to 1, so the link count +for remote directories and files is not available. In both cases, +these tests will fail: Failed Test List of failed ------------------------------------ @@ -431,7 +439,9 @@ printable characters except these: : * ? " < > | -File names are case insensitive, but case preserving. +File names are case insensitive, but case preserving. A pathname +that contains a backslash is a Win32 pathname (and not subject to the +translations applied to POSIX style pathnames). =item * Text/Binary @@ -450,13 +460,13 @@ The text/binary issue is covered at length in the Cygwin documentation. =item * F<.exe> -The Cygwin stat() makes the F<.exe> extension transparent by looking for -F<foo.exe> when you ask for F<foo> (unless a F<foo> also exists). Cygwin -does not require a F<.exe> extension, but I<gcc> adds it automatically -when building a program. However, when accessing an executable as a -normal file (e.g., I<cp> in a makefile) the F<.exe> is not transparent. -The I<install> included with Cygwin automatically appends a F<.exe> -when necessary. +The Cygwin stat(), lstat() and readlink() functions make the F<.exe> +extension transparent by looking for F<foo.exe> when you ask for F<foo> +(unless a F<foo> also exists). Cygwin does not require a F<.exe> +extension, but I<gcc> adds it automatically when building a program. +However, when accessing an executable as a normal file (e.g., I<cp> +in a makefile) the F<.exe> is not transparent. The I<install> included +with Cygwin automatically appends a F<.exe> when necessary. =item * chown() @@ -558,6 +568,7 @@ be kept as clean as possible. - require MM_Cygwin.pm lib/ExtUtils/MM_Cygwin.pm - canonpath, cflags, manifypods, perl_archive + lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1 lib/File/Spec/Unix.pm - preserve //unc lib/perl5db.pl - use stdin not /dev/tty utils/perlcc.PL - DynaLoader.a in compile, -DUSEIMPORTLIB @@ -586,4 +597,4 @@ Teun Burgers <burgers@ecn.nl>. =head1 HISTORY -Last updated: 5 May 2000 +Last updated: 20 June 2000 diff --git a/README.epoc b/README.epoc index b4bcca60e4..2163c465d7 100644 --- a/README.epoc +++ b/README.epoc @@ -4,7 +4,7 @@ Perl 5 README file for the EPOC operating system. Olaf Flebbe <o.flebbe@gmx.de> http://www.linuxstart.com/~oflebbe/perl/perl5.html -2000-02-20 +2000-05-15 ===================================================================== Introduction @@ -13,9 +13,8 @@ Introduction EPOC is a OS for palmtops and mobile phones. For more informations look at: http://www.symbian.com/ -This is a port of Perl version 5.5.650 to EPOC. It runs on the Perl -Series 5, Series 5mx and the Psion Revo. I have no reports for other -EPOC devices. +This is a port of Perl version 5.6.0 to EPOC. It runs on the Perl +Series 5, Series 5mx and the Psion Revo and on the Ericson M128. Features are left out, because of restrictions of the POSIX support. @@ -157,4 +156,4 @@ Support Status I'm offering this port "as is". You can ask me questions, but I can't guarantee I'll be able to answer them; I don't know much about Perl -internals myself; +internals myself. diff --git a/README.hpux b/README.hpux index 06b39b99d1..47d1afc5cc 100644 --- a/README.hpux +++ b/README.hpux @@ -1,6 +1,6 @@ -If you read this file _as_is_, just ignore the funny characters you -see. It is written in the POD format (see pod/perlpod.pod) which is -specially designed to be readable as is. +If you read this file _as_is_, just ignore the funny characters you see. +It is written in the POD format (see pod/perlpod.pod) which is specially +designed to be readable as is. =head1 NAME @@ -8,33 +8,35 @@ README.hpux - Perl version 5 on Hewlett-Packard Unix (HP-UX) systems =head1 DESCRIPTION -This document describes various features of HP's Unix operating system (HP-UX) -that will affect how Perl version 5 (hereafter just Perl) is compiled and/or -runs. +This document describes various features of HP's Unix operating system +(HP-UX) that will affect how Perl version 5 (hereafter just Perl) is +compiled and/or runs. =head2 Compiling Perl 5 on HP-UX -An ANSI C compiler is required to build Perl. The C compiler that ships -with all HP-UX systems is a K&R compiler that can only be used to build -new kernels. +When compiling Perl, you must use an ANSI C compiler. The C compiler +that ships with all HP-UX systems is a K&R compiler that should only be +used to build new kernels. Perl can be compiled with either HP's ANSI C compiler or with gcc. The -former is recommended, as not only can it compile Perl with no difficulty, -but also can take advantage of features listed later that require the use -of HP compiler-specific command-line flags. +former is recommended, as not only can it compile Perl with no +difficulty, but also can take advantage of features listed later that +require the use of HP compiler-specific command-line flags. -If you decide to use gcc, make sure your installation is recent and complete, -and be sure to read the Perl README file for more gcc-specific details. +If you decide to use gcc, make sure your installation is recent and +complete, and be sure to read the Perl README file for more gcc-specific +details. =head2 PA-RISC -HP's current Unix systems run on its own Precision Architecture (PA-RISC) chip. -HP-UX used to run on the Motorola MC68000 family of chips, but any machine with -this chip in it is quite obsolete and this document will not attempt to address -issues for compiling Perl on the Motorola chipset. +HP's current Unix systems run on its own Precision Architecture +(PA-RISC) chip. HP-UX used to run on the Motorola MC68000 family of +chips, but any machine with this chip in it is quite obsolete and this +document will not attempt to address issues for compiling Perl on the +Motorola chipset. -The most recent version of PA-RISC at the time of this document's last update -is 2.0. +The most recent version of PA-RISC at the time of this document's last +update is 2.0. =head2 PA-RISC 1.0 @@ -42,8 +44,8 @@ The original version of PA-RISC, HP no longer sells any system with this chip. The following systems contain PA-RISC 1.0 chips: - 600, 635, 645, 800, 808, 815, 822, 825, 832, 834, 835, 840, - 842, 845, 850, 852, 855, 860, 865, 870, 890 + 600, 635, 645, 808, 815, 822, 825, 832, 834, 835, 840, 842, 845, 850, 852, + 855, 860, 865, 870, 890 =head2 PA-RISC 1.1 @@ -52,52 +54,58 @@ system. The following systems contain with PA-RISC 1.1 chips: - 705, 710, 712, 715, 720, 722, 725, 728, 730, 735, 743, 745, 747, 750, - 755, 770, 807S, 817S, 827S, 837S, 847S, 857S, 867S, 877S, 887S, 897S, - D200, D210, D220, D230, D250, D260, D310, D320, D330, D350, D360, D400, - E25, E35, E45, E55, F10, F20, F30, G30, G40, G50, G60, G70, H30, H40, - H50, H60, H70, I30, I40, I50, I60, I70, K100, K200, K210, K220, K400, - K410, K420, T500, T520 - + 705, 710, 712, 715, 720, 722, 725, 728, 730, 735, 742, 743, 745, 747, 750, + 755, 770, 777, 778, 779, 800, 801, 803, 806, 807, 809, 811, 813, 816, 817, + 819, 821, 826, 827, 829, 831, 837, 839, 841, 847, 849, 851, 856, 857, 859, + 867, 869, 877, 887, 891, 892, 897, A180, A180C, B115, B120, B132L, B132L+, + B160L, B180L, C100, C110, C115, C120, C160L, D200, D210, D220, D230, D250, + D260, D310, D320, D330, D350, D360, D410, DX0, DX5, DZO, E25, E35, E45, + E55, F10, F20, F30, G30, G40, G50, G60, G70, H20, H30, H40, H50, H60, H70, + I30, I40, I50, I60, I70, J200, J210, J210XC, K100, K200, K210, K220, K230, + K400, K410, K420, S700i, S715, S724, S760, T500, T520 =head2 PA-RISC 2.0 -The most recent upgrade to the PA-RISC design, it added support for 64-bit -integer data. +The most recent upgrade to the PA-RISC design, it added support for +64-bit integer data. -The following systems contain PA-RISC 2.0 chips (this is very likely to be -out of date): +As of the date of this document's last update, the following systems +contain PA-RISC 2.0 chips (this is very likely to be out of date): - D270, D280, D370, D380, K250, K260, K370, K380, K450, K460, K570, K580, - T600, V2200, N-class + 700, 780, 781, 782, 783, 785, 802, 804, 810, 820, 861, 871, 879, 889, 893, + 895, 896, 898, 899, B1000, C130, C140, C160, C180, C180+, C180-XP, C200+, + C400+, C3000, C360, CB260, D270, D280, D370, D380, D390, D650, J220, J2240, + J280, J282, J400, J410, J5000, J7000, K250, K260, K260-EG, K270, K360, + K370, K380, K450, K460, K460-EG, K460-XP, K470, K570, K580, L1000, L2000, + N4000, R380, R390, T540, T600, V2000, V2200, V2250, V2500 A complete list of models at the time the OS was built is in the file -/opt/langtools/lib/sched.models. -The first column corresponds to the output of the "uname -m" command -(without the leading "9000/"). -The second column is the PA-RISC version -and the third column is the exact chip type used. +/opt/langtools/lib/sched.models. The first column corresponds to the +output of the "uname -m" command (without the leading "9000/"). The +second column is the PA-RISC version and the third column is the exact +chip type used. =head2 Portability Between PA-RISC Versions An executable compiled on a PA-RISC 2.0 platform will not execute on a -PA-RISC 1.1 platform, even if they are running the same version of HP-UX. -If you are building Perl on a PA-RISC 2.0 platform and want that Perl to -to also run on a PA-RISC 1.1, the compiler flags +DAportable and +DS32 -should be used. +PA-RISC 1.1 platform, even if they are running the same version of +HP-UX. If you are building Perl on a PA-RISC 2.0 platform and want that +Perl to to also run on a PA-RISC 1.1, the compiler flags +DAportable and ++DS32 should be used. -It is no longer possible to compile PA-RISC 1.0 executables on either the -PA-RISC 1.1 or 2.0 platforms. +It is no longer possible to compile PA-RISC 1.0 executables on either +the PA-RISC 1.1 or 2.0 platforms. =head2 Building Dynamic Extensions on HP-UX HP-UX supports dynamically loadable libraries (shared libraries). Shared libraries end with the suffix .sl. -Shared libraries created on a platform using a particular PA-RISC version -are not usable on platforms using an earlier PA-RISC version by default. -However, this backwards compatibility may be enabled using the same -+DAportable compiler flag (with the same PA-RISC 1.0 caveat mentioned above). +Shared libraries created on a platform using a particular PA-RISC +version are not usable on platforms using an earlier PA-RISC version by +default. However, this backwards compatibility may be enabled using the +same +DAportable compiler flag (with the same PA-RISC 1.0 caveat +mentioned above). To create a shared library, the following steps must be performed: @@ -116,49 +124,46 @@ If these dependent libraries are not listed at shared library creation time, you will get fatal "Unresolved symbol" errors at run time when the library is loaded. -You may create a shared library that refers to another library, which -may be either an archive library or a shared library. If it is a -shared library, this is called a "dependent library". -The dependent library's name is recorded in the main shared library, -but it is not linked into the shared library. -Instead, it is loaded when the main shared library is loaded. +You may create a shared library that referers to another library, which +may be either an archive library or a shared library. If this second +library is a shared library, this is called a "dependent library". The +dependent library's name is recorded in the main shared library, but it +is not linked into the shared library. Instead, it is loaded when the +main shared library is loaded. This can cause problems if you build an +extension on one system and move it to another system where the +libraries may not be located in the same place as on the first system. If the referred library is an archive library, then it is treated as a simple collection of .o modules (all of which must contain PIC). These modules are then linked into the shared library. -Note that it is okay to create a library which contains a dependent library -that is already linked into perl. +Note that it is okay to create a library which contains a dependent +library that is already linked into perl. It is no longer possible to link PA-RISC 1.0 shared libraries. =head2 The HP ANSI C Compiler -When using this compiler to build Perl, you should make sure that -the flag -Aa is added to the cpprun and cppstdin variables in the -config.sh file. +When using this compiler to build Perl, you should make sure that the +flag -Aa is added to the cpprun and cppstdin variables in the config.sh +file (though see the section on 64-bit perl below). =head2 Using Large Files with Perl -Beginning with HP-UX version 10.20, files larger than 2GB (2^31) may be -created and manipulated. -Three separate methods of doing this are available. -Of these methods, -the best method for Perl is to compile using the -Duselargefiles -flag to Configure. -This will cause the -D_FILE_OFFSET_BITS=64 compiler flag to be used -when building Perl. -This causes Perl to be compiled using structures and functions in which -these are 64 bits wide, rather than 32 bits wide. -(Note that this will only work with HP's ANSI C compiler. -If you want to compile Perl using gcc, you will have to get a version -of the compiler that support 64-bit operations.) - -The one drawback to this approach is that -any extension which calls any file-manipulating C function -will need to be recompiled +Beginning with HP-UX version 10.20, files larger than 2GB (2^31 bytes) +may be created and manipulated. Three separate methods of doing this +are available. Of these methods, the best method for Perl is to compile +using the -Duselargefiles flag to Configure. This causes Perl to be +compiled using structures and functions in which these are 64 bits wide, +rather than 32 bits wide. (Note that this will only work with HP's ANSI +C compiler. If you want to compile Perl using gcc, you will have to get +a version of the compiler that support 64-bit operations.) + +There are some drawbacks to this approach. One is that any extension +which calls any file-manipulating C function will need to be recompiled (just follow the usual "perl Makefile.PL; make; make test; make install" procedure). + The list of functions that will need to recompiled is: creat, fgetpos, fopen, freopen, fsetpos, fstat, @@ -169,65 +174,91 @@ open, prealloc, stat, statvfs, statvfsdev, tmpfile, truncate, getrlimit, setrlimit +Another drawback is only valid for Perl versions before 5.6.0. This +drawback is that the seek and tell functions (both the builtin version +and POSIX module version) will not perform correctly. + +It is strongly recommended that you use this flag when you run +Configure. If you do not do this, but later answer the question about +large files when Configure asks you, you may get a configuration that +cannot be compiled, or that does not function as expected. + =head2 Threaded Perl It is impossible to compile a version of threaded Perl on any version of HP-UX before 10.30, and it is strongly suggested that you be running on HP-UX 11.00 at least. -To compile Perl with thread, add -Dusethreads to the arguments of Configure. -Ensure that the -D_POSIX_C_SOURCE=199506L compiler flag is automatically -added to the list of flags. Also make sure that -lpthread is listed before --lc in the list of libraries to link Perl with. +To compile Perl with threads, add -Dusethreads to the arguments of +Configure. Verify that the -D_POSIX_C_SOURCE=199506L compiler flag is +automatically added to the list of flags. Also make sure that -lpthread +is listed before -lc in the list of libraries to link Perl with. -As of the date of this document, -Perl threads are not fully supported on HP-UX. +As of the date of this document, Perl threads are not fully supported on +HP-UX. =head2 64-bit Perl -Beginning with HP-UX 11.00, programs compiled under HP-UX can take advantage -of the LP64 programming environment (LP64 means Longs and Pointers are 64 bits -wide). +Beginning with HP-UX 11.00, programs compiled under HP-UX can take +advantage of the LP64 programming environment (LP64 means Longs and +Pointers are 64 bits wide). -Work is being performed on Perl to make it 64-bit compliant on all versions -of Unix. Once this is complete, scalar variables will be able to hold -numbers larger than 2^32 with complete precision. +Work is being performed on Perl to make it 64-bit compliant on all +versions of Unix. Once this is complete, scalar variables will be able +to hold numbers larger than 2^32 with complete precision. As of the date of this document, Perl is not 64-bit compliant on HP-UX. -Should a user wish to experiment with compiling Perl in the LP64 environment, -use the -Duse64bitall flag to Configure. -This will force Perl to be compiled in a pure LP64 environment (via the -+DD64 flag). +Should a user wish to experiment with compiling Perl in the LP64 +environment, use the -Duse64bitall flag to Configure. This will force +Perl to be compiled in a pure LP64 environment (via the +DD64 flag). -You can also use the -Duse64bitint flag to Configure. -Although there are some minor differences between compiling Perl with -this flag versus the -Duse64bitall flag, -they should not be noticeable from a Perl user's perspective. +You can also use the -Duse64bitint flag to Configure. Although there +are some minor differences between compiling Perl with this flag versus +the -Duse64bitall flag, they should not be noticeable from a Perl user's +perspective. -In both cases, it is strongly recommended that you use these flags -when you run Configure. -If you do not use them, but answer the questions about 64-bit numbers -when Configure asks you, -you may get a configuration that cannot be compiled, or that does -not function as expected. +In both cases, it is strongly recommended that you use these flags when +you run Configure. If you do not use do this, but later answer the +questions about 64-bit numbers when Configure asks you, you may get a +configuration that cannot be compiled, or that does not function as +expected. -(Note that these Configure flags will only work with HP's ANSI C compiler. -If you want to compile Perl using gcc, you will have to get a version -of the compiler that support 64-bit operations.) +(Note that these Configure flags will only work with HP's ANSI C +compiler. If you want to compile Perl using gcc, you will have to get a +version of the compiler that support 64-bit operations.) =head2 GDBM and Threads -If you attempt to compile Perl with threads on an 11.X system and also link -in the GDBM library, then Perl will immediately core dump when it starts up. -The only workaround at this point is to relink the GDBM library under 11.X, -then relink it into Perl. +If you attempt to compile Perl with threads on an 11.X system and also +link in the GDBM library, then Perl will immediately core dump when it +starts up. The only workaround at this point is to relink the GDBM +library under 11.X, then relink it into Perl. =head2 NFS filesystems and utime(2) If you are compiling Perl on a remotely-mounted NFS filesystem, the test -io/fs.t may fail on test #18. -This appears to be a bug in HP-UX and no fix is currently available. +io/fs.t may fail on test #18. This appears to be a bug in HP-UX and no +fix is currently available. + +=head2 perl -P and // + +In HP-UX perl is compiled with flags that will cause problems if the +-P flag of Perl (preprocess Perl code with the C preprocessor before +perl sees it) is used. The problem is that C<//>, being a C++-style +until-end-of-line comment, will disappear along with the remainder +of the line. This means that common Perl constructs like + + s/foo//; + +will turn into illegal code + + s/foo + +The workaround is to use some other quoting characters than /, +like for example ! + + s!foo!!; =head1 AUTHOR @@ -237,6 +268,6 @@ With much assistance regarding shared libraries from Marc Sabatella. =head1 DATE -Version 0.3: 2000/03/31 +Version 0.6.1: 2000/06/20 =cut diff --git a/README.micro b/README.micro new file mode 100644 index 0000000000..da84453bf6 --- /dev/null +++ b/README.micro @@ -0,0 +1,9 @@ +microperl is supposed to be able a really minimal perl, even more +minimal than miniperl. No Configure is needed to build microperl, +on the other hand this means that interfaces between Perl and your +operating system are left very -- minimal. + +All this is experimental. If you don't know what to do with microperl +you probably shouldn't. + + diff --git a/README.posix-bc b/README.posix-bc index 1105f671b6..3dd8ea205a 100644 --- a/README.posix-bc +++ b/README.posix-bc @@ -1,28 +1,43 @@ -This is a first ported perl for the POSIX subsystem in BS2000 VERSION -'V121', OSD V3.1, POSIX Shell V03.1A55. It may work on other -versions, but that's the one we've tested it on. +This document is written in pod format hence there are punctuation +characters in in odd places. Do not worry, you've apparently got the +ASCII->EBCDIC translation worked out correctly. You can read more +about pod in pod/perlpod.pod or the short summary in the INSTALL file. + +=head1 NAME + +README.posix-bc - building and installing Perl for BS2000 POSIX. + +=head1 SYNOPSIS + +This document will help you Configure, build, test and install Perl +on BS2000 in the POSIX subsystem. + +=head1 DESCRIPTION + +This is a ported perl for the POSIX subsystem in BS2000 VERSION OSD +V3.1A. It may work on other versions, but that's the one we've tested +it on. You may need the following GNU programs in order to install perl: -gzip: +=head2 gzip We used version 1.2.4, which could be installed out of the box with one failure during 'make check'. -bison: +=head2 bison The yacc coming with BS2000 POSIX didn't work for us. So we had to use bison. We had to make a few changes to perl in order to use the pure (reentrant) parser of bison. We used version 1.25, but we had to add a few changes due to EBCDIC. - -UNPACKING: -========== +=head2 Unpacking To extract an ASCII tar archive on BS2000 POSIX you need an ASCII filesystem (we used the mountpoint /usr/local/ascii for this). Now -you extract the archive in the ASCII filesystem without I/O-conversion: +you extract the archive in the ASCII filesystem without +I/O-conversion: cd /usr/local/ascii export IO_CONVERSION=NO @@ -30,24 +45,20 @@ gunzip < /usr/local/src/perl.tar.gz | pax -r You may ignore the error message for the first element of the archive (this doesn't look like a tar archive / skipping to next file...), -it's only the directory which will be made anyway. +it's only the directory which will be created automatically anyway. After extracting the archive you copy the whole directory tree to your -EBCDIC filesystem. This time you use I/O-conversion: +EBCDIC filesystem. B<This time you use I/O-conversion>: cd /usr/local/src IO_CONVERSION=YES cp -r /usr/local/ascii/perl5.005_02 ./ - -COMPILING: -========== +=head2 Compiling There is a "hints" file for posix-bc that specifies the correct values for most things. The major problem is (of course) the EBCDIC character -set. - -Configure did everything except the perl parser. +set. We have german EBCDIC version. Because of our problems with the native yacc we used GNU bison to generate a pure (=reentrant) parser for perly.y. So our yacc is @@ -85,16 +96,15 @@ We still use the normal yacc for a2p.y though!!! We made a softlink called byacc to distinguish between the two versions: ln -s /usr/bin/yacc /usr/local/bin/byacc - -We build perl using both GNU make and the native make. +We build perl using GNU make. We tried the native make once and it +worked too. -TESTING: -======== +=head2 Testing -We still got a few errors during 'make test'. Some of them are the -result of using bison. Bison prints 'parser error' instead of 'syntax -error', so we may ignore them. The following list shows +We still got a few errors during C<make test>. Some of them are the +result of using bison. Bison prints I<parser error> instead of I<syntax +error>, so we may ignore them. The following list shows our errors, your results may differ: op/numconvert.......FAILED tests 1409-1440 @@ -108,20 +118,45 @@ lib/complex.........FAILED tests 267, 487 lib/dumper..........FAILED tests 43, 45 Failed 11/231 test scripts, 95.24% okay. 57/10595 subtests failed, 99.46% okay. -INSTALLING: -=========== +=head2 Install We have no nroff on BS2000 POSIX (yet), so we ignored any errors while installing the documentation. -USING PERL: -=========== +=head2 Using Perl BS2000 POSIX doesn't support the shebang notation -('#!/usr/local/bin/perl'), so you have to use the following lines +(C<#!/usr/local/bin/perl>), so you have to use the following lines instead: : # use perl eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; + +=head1 AUTHORS + +Thomas Dorner + +=head1 SEE ALSO + +L<INSTALL>, L<perlport>. + +=head2 Mailing list + +The Perl Institute (http://www.perl.org/) maintains a perl-mvs mailing +list of interest to all folks building and/or using perl on EBCDIC +platforms. To subscibe, send a message of: + + subscribe perl-mvs + +to majordomo@perl.org. + +=head1 HISTORY + +This document was originally written by Thomas Dorner for the 5.005 +release of Perl. + +This document was podified for the 5.6 release of perl 11 July 2000. + +=cut @@ -12,7 +12,11 @@ Unicode support eliminate need for "use utf8;" autoload byte.pm when byte:: is seen by the parser check uv_to_utf8() calls for buffer overflow - (see also "Locales", "Regexen", and "Miscellaneous") + make \uXXXX (and \u{XXXX}?) where XXXX are hex digits + to work similarly to Unicode tech reports and Java + notation \uXXXX (and already existing \x{XXXX))? + more than four hexdigits? make also \U+XXXX work? + See also "Locales", "Regexen", and "Miscellaneous". Multi-threading support "use Thread;" under useithreads @@ -39,17 +43,18 @@ Namespace cleanup API-space: complete the list of things that constitute public api Configure - fix the vicious cyclic multidependency of cc <-> libpth <-> loclibpth - libswanted <-> usethreads <-> use64bitint <-> use64bitall <-> - uselargefiles <-> ... make configuring+building away from source directory work (VPATH et al) this is related to: cross-compilation configuring (see Todo) _r support (see Todo for mode detailed description) POSIX 1003.1 1996 Edition support--realtime stuff: POSIX semaphores, message queues, shared memory, realtime clocks, timers, signals (the metaconfig units mostly already exist for these) + PREFERABLY AS AN EXTENSION UNIX98 support: reader-writer locks, realtime/asynchronous IO + PREFERABLY AS AN EXTENSION IPv6 support: see RFC2292, RFC2553 + PREFERABLY AS AN EXTENSION + there already is Socket6 in CPAN Long doubles figure out where the PV->NV->PV conversion gets it wrong at least @@ -60,6 +65,7 @@ Long doubles 64-bit support Configure probe for quad_t, uquad_t, and (argh) u_quad_t, they might be in some systems the only thing working as quadtype and uquadtype. + more pain: long_long, u_long_long. Locales deprecate traditional/legacy locales? @@ -67,15 +73,16 @@ Locales figure out how to support Unicode locales suggestion: integrate the IBM Classes for Unicode (ICU) http://oss.software.ibm.com/developerworks/opensource/icu/project/ - and check out also the Locale Converter: + ICU is "portable, open-source Unicode library with: + charset-independent locales (with multiple locales + simultaneously supported in same thread; character + conversions; formatting/parsing for numbers, currencies, + date/time and messages; message catalogs (resources); + transliteration, collation, normalization, and text + boundaries (grapheme, word, line-break))". + Check out also the Locale Converter: http://alphaworks.ibm.com/tech/localeconverter - ICU is "portable, open-source Unicode library with: - charset-independent locales (with multiple locales simultaneously - supported in same thread; character conversions; formatting/parsing - for numbers, currencies, date/time and messages; message catalogs - (resources) ; transliteration, collation, normalization, and text - boundaries (grapheme, word, line-break))". - There is also 'iconv', either from XPG4 or GNU (glibc). + There is also the iconv interface, either from XPG4 or GNU (glibc). iconv is about character set conversions. Either ICU or iconv would be valuable to get integrated into Perl, Configure already probes for libiconv and <iconv.h>. @@ -101,6 +108,9 @@ Regexen this is also a part of the Unicode 3.0: http://www.unicode.org/unicode/uni2book/u2.html executive summary: there are several different levels of 'equivalence' + trie optimization: factor out common suffixes (and prefixes?) + from |-alternating groups (both for exact strings and character + classes, use lookaheads?) approximate matching Security @@ -132,6 +142,7 @@ Miscellaneous (no metaconfig units yet for these). Don't forget finitel(), fp_classl(), fp_class_l(), (yes, both do, unfortunately, exist), and unorderedl(). + PREFERABLY AS AN EXTENSION. As of 5.6.1 there is cpp macro Perl_isnan(). fix the basic arithmetics (+ - * / %) to preserve IVness/UVness if both arguments are IVs/UVs @@ -156,3 +167,5 @@ Documentation spot-check all new modules for completeness better docs for pack()/unpack() reorg tutorials vs. reference sections + make roffitall to be dynamical about its pods and libs + diff --git a/Todo.micro b/Todo.micro new file mode 100644 index 0000000000..76759b1951 --- /dev/null +++ b/Todo.micro @@ -0,0 +1,9 @@ +- make creating uconfig.sh automatic (by pumpkin) + +- make creating Makefile.micro automatic (by pumpkin) + +- do away with fork/exec/wait? (system, popen should be enough?) + +- some of the uconfig.sh really needs to be probed (using cc) in buildtime: + (uConfigure? :-) native datatype widths and endianness come to mind + @@ -661,6 +661,14 @@ Perl_av_len(pTHX_ register AV *av) return AvFILL(av); } +/* +=for apidoc av_fill + +Ensure than an array has a given number of elements, equivalent to +Perl's C<$#array = $fill;>. + +=cut +*/ void Perl_av_fill(pTHX_ register AV *av, I32 fill) { @@ -708,6 +716,14 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) (void)av_store(av,fill,&PL_sv_undef); } +/* +=for apidoc av_delete + +Deletes the element indexed by C<key> from the array. Returns the +deleted element. C<flags> is currently ignored. + +=cut +*/ SV * Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) { @@ -758,10 +774,15 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) } /* - * This relies on the fact that uninitialized array elements - * are set to &PL_sv_undef. - */ +=for apidoc av_exists + +Returns true if the element indexed by C<key> has been initialized. +This relies on the fact that uninitialized array elements are set to +C<&PL_sv_undef>. + +=cut +*/ bool Perl_av_exists(pTHX_ AV *av, I32 key) { @@ -32,8 +32,8 @@ struct xpvav { * real if the array needs to be modified in some way. Functions that * modify fake AVs check both flags to call av_reify() as appropriate. * - * Note that the Perl stack has neither flag set. (Thus, items that go - * on the stack are never refcounted.) + * Note that the Perl stack and @DB::args have neither flag set. (Thus, + * items that go on the stack are never refcounted.) * * These internal details are subject to change any time. AV * manipulations external to perl should not care about any of this. diff --git a/config_h.SH b/config_h.SH index 5bb7dddf20..e66e0c5ed0 100644 --- a/config_h.SH +++ b/config_h.SH @@ -1,29 +1,35 @@ +case "$CONFIG_SH" in +'') CONFIG_SH=config.sh ;; +esac +case "$CONFIG_H" in +'') CONFIG_H=config.h ;; +esac case $CONFIG in '') - if test -f config.sh; then TOP=.; - elif test -f ../config.sh; then TOP=..; - elif test -f ../../config.sh; then TOP=../..; - elif test -f ../../../config.sh; then TOP=../../..; - elif test -f ../../../../config.sh; then TOP=../../../..; + if test -f $CONFIG_SH; then TOP=.; + elif test -f ../$CONFIG_SH; then TOP=..; + elif test -f ../../$CONFIG_SH; then TOP=../..; + elif test -f ../../../$CONFIG_SH; then TOP=../../..; + elif test -f ../../../../$CONFIG_SH; then TOP=../../../..; else - echo "Can't find config.sh."; exit 1 + echo "Can't find $CONFIG_SH."; exit 1 fi - . $TOP/config.sh + . $TOP/$CONFIG_SH ;; esac case "$0" in */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac -echo "Extracting config.h (with variable substitutions)" -sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-def!#undef!' +echo "Extracting $CONFIG_H (with variable substitutions)" +sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-def!#undef!' /* * This file was produced by running the config_h.SH script, which - * gets its values from config.sh, which is generally produced by + * gets its values from $CONFIG_SH, which is generally produced by * running Configure. * * Feel free to modify any of this as the need arises. Note, however, * that running config_h.SH again will wipe out any changes you've made. - * For a more permanent change edit config.sh and rerun config_h.SH. + * For a more permanent change edit $CONFIG_SH and rerun config_h.SH. * * \$Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ */ @@ -1198,18 +1204,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This macro surrounds its token with double quotes. */ #if $cpp_stuff == 1 -# define CAT2(a,b) a/**/b -# define STRINGIFY(a) "a" +#define CAT2(a,b) a/**/b +#define STRINGIFY(a) "a" /* If you can get stringification with catify, tell me how! */ #endif #if $cpp_stuff == 42 -# define PeRl_CaTiFy(a, b) a ## b -# define PeRl_StGiFy(a) #a +#define PeRl_CaTiFy(a, b) a ## b +#define PeRl_StGiFy(a) #a /* the additional level of indirection enables these macros to be * used as arguments to other macros. See K&R 2nd ed., page 231. */ -# define CAT2(a,b) PeRl_CaTiFy(a,b) -# define StGiFy(a) PeRl_StGiFy(a) -# define STRINGIFY(a) PeRl_StGiFy(a) +#define CAT2(a,b) PeRl_CaTiFy(a,b) +#define StGiFy(a) PeRl_StGiFy(a) +#define STRINGIFY(a) PeRl_StGiFy(a) #endif #if $cpp_stuff != 1 && $cpp_stuff != 42 # include "Bletch: How does this C preprocessor catenate tokens?" @@ -1342,12 +1348,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_endsent HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -#$d_endspent HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1419,6 +1419,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getcwd HAS_GETCWD /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +#$d_getespwnam HAS_GETESPWNAM /**/ + /* HAS_GETFSSTAT: * This symbol, if defined, indicates that the getfsstat routine is * available to stat filesystems in bulk. @@ -1549,6 +1555,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +#$d_getprpwnam HAS_GETPRPWNAM /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1570,12 +1582,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getservprotos HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -#$d_getspent HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. @@ -1757,6 +1763,13 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_mmap HAS_MMAP /**/ #define Mmap_t $mmaptype /**/ +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +#$d_modfl HAS_MODFL /**/ + /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is * available to modify the access protection of a memory mapped file. @@ -1869,6 +1882,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setpent HAS_SETPROTOENT /**/ +/* HAS_SETPROCTITLE: + * This symbol, if defined, indicates that the setproctitle routine is + * available to set process title. + */ +#$d_setproctitle HAS_SETPROCTITLE /**/ + /* HAS_SETPWENT: * This symbol, if defined, indicates that the setpwent routine is * available for initializing sequential access of the passwd database. @@ -1881,12 +1900,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setsent HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -#$d_setspent HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2355,6 +2368,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_poll I_POLL /**/ +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +#$i_prot I_PROT /**/ + /* I_PTHREAD: * This symbol, if defined, indicates to the C program that it should * include <pthread.h>. @@ -2684,7 +2703,11 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bits of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE $ivtype /**/ #define UVTYPE $uvtype /**/ @@ -2713,6 +2736,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #endif #define NVSIZE $nvsize /**/ #$d_nv_preserves_uv NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS $d_nv_preserves_uv_bits /* IVdf: * This symbol defines the format string used for printing a Perl IV @@ -3132,12 +3156,11 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PERL_XS_APIVERSION "$xs_apiversion" #define PERL_PM_APIVERSION "$pm_apiversion" -/* HAS_MODFL: - * This symbol, if defined, indicates that the modfl routine is - * available to split a long double x into a fractional part f and - * an integer part i such that |f| < 1.0 and (f + i) = x. +/* I_LIBUTIL: + * This symbol, if defined, indicates that <libutil.h> exists and + * should be included. */ -#$d_modfl HAS_MODFL /**/ +#$i_libutil I_LIBUTIL /**/ #endif !GROK!THIS! @@ -29,32 +29,33 @@ struct cop { # define CopFILE(c) ((c)->cop_file) # define CopFILEGV(c) (CopFILE(c) \ ? gv_fetchfile(CopFILE(c)) : Nullgv) -# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) /* XXX */ +# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) # define CopFILESV(c) (CopFILE(c) \ ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) # define CopFILEAV(c) (CopFILE(c) \ ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) # define CopSTASHPV(c) ((c)->cop_stashpv) -# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) /* XXX */ +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) # define CopSTASH(c) (CopSTASHPV(c) \ ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) # define CopSTASH_set(c,hv) CopSTASHPV_set(c, HvNAME(hv)) -# define CopSTASH_eq(c,hv) (hv \ +# define CopSTASH_eq(c,hv) ((hv) \ && (CopSTASHPV(c) == HvNAME(hv) \ || (CopSTASHPV(c) && HvNAME(hv) \ && strEQ(CopSTASHPV(c), HvNAME(hv))))) #else # define CopFILEGV(c) ((c)->cop_filegv) -# define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv) -# define CopFILE_set(c,pv) ((c)->cop_filegv = gv_fetchfile(pv)) +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) # define CopSTASH(c) ((c)->cop_stash) -# define CopSTASH_set(c,hv) ((c)->cop_stash = hv) +# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) -# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD)) -# define CopSTASH_eq(c,hv) (CopSTASH(c) == hv) + /* cop_stash is not refcounted */ +# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) #endif /* USE_ITHREADS */ #define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) @@ -79,6 +80,7 @@ struct block_sub { U16 olddepth; U8 hasargs; U8 lval; /* XXX merge lval and hasargs? */ + SV ** oldcurpad; }; #define PUSHSUB(cx) \ @@ -105,13 +107,14 @@ struct block_sub { } STMT_END #endif /* USE_THREADS */ -#ifdef USE_ITHREADS - /* junk in @_ spells trouble when cloning CVs, so don't leave any */ -# define CLEAR_ARGARRAY() av_clear(cx->blk_sub.argarray) -#else -# define CLEAR_ARGARRAY() NOOP -#endif /* USE_ITHREADS */ - +/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't + * leave any (a fast av_clear(ary), basically) */ +#define CLEAR_ARGARRAY(ary) \ + STMT_START { \ + AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \ + SvPVX(ary) = (char*)AvALLOC(ary); \ + AvFILLp(ary) = -1; \ + } STMT_END #define POPSUB(cx,sv) \ STMT_START { \ @@ -124,10 +127,10 @@ struct block_sub { cx->blk_sub.argarray = newAV(); \ av_extend(cx->blk_sub.argarray, fill); \ AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \ - PL_curpad[0] = (SV*)cx->blk_sub.argarray; \ + cx->blk_sub.oldcurpad[0] = (SV*)cx->blk_sub.argarray; \ } \ else { \ - CLEAR_ARGARRAY(); \ + CLEAR_ARGARRAY(cx->blk_sub.argarray); \ } \ } \ sv = (SV*)cx->blk_sub.cv; \ @@ -423,6 +426,7 @@ L<perlcall>. #define G_NOARGS 8 /* Don't construct a @_ array. */ #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ #define G_NODEBUG 32 /* Disable debugging at toplevel. */ +#define G_METHOD 64 /* Calling method. */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ diff --git a/cygwin/Makefile.SHs b/cygwin/Makefile.SHs index ca083d43cd..120e8eee1f 100644 --- a/cygwin/Makefile.SHs +++ b/cygwin/Makefile.SHs @@ -157,10 +157,15 @@ esac # libperl.a is _the_ library both in dll and static cases # $(LIBPERL)$(LIB_EXT) expands to this name dependless of build model # +# NOTE: The "-Wl,-Bstatic $(LLIBPERL) -Wl,-Bdynamic" is required to give +# the import library linking priority over the dynamic library, since both +# the .dll and .a are in the same directory. When the new standard for +# naming import/dynamic/static libraries emerges this should be updated. +# $spitshell >>Makefile <<'!NO!SUBS!' perl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs - $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) -Wl,-Bstatic $(LLIBPERL) -Wl,-Bdynamic `cat ext.libs` $(libs) pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs $(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) @@ -476,11 +476,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, SV *sv; PerlLIO_dup2(PerlIO_fileno(fp), fd); + LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); (void)SvUPGRADE(sv, SVt_IV); pid = SvIVX(sv); SvIVX(sv) = 0; sv = *av_fetch(PL_fdpid,fd,TRUE); + UNLOCK_FDPID_MUTEX; (void)SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; if (!was_fdopen) @@ -810,7 +812,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) dTHR; if (ckWARN(WARN_UNOPENED)) Perl_warner(aTHX_ WARN_UNOPENED, - "Close on unopened file <%s>",GvENAME(gv)); + "Close on unopened file %s",GvENAME(gv)); SETERRNO(EBADF,SS$_IVCHAN); } return FALSE; @@ -877,7 +879,7 @@ Perl_do_eof(pTHX_ GV *gv) || IoIFP(io) == PerlIO_stderr())) { SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", SvPV_nolen(sv)); } @@ -1194,7 +1196,7 @@ Perl_my_stat(pTHX) if (tmpgv == PL_defgv) return PL_laststatval; if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "Stat on unopened file <%s>", + Perl_warner(aTHX_ WARN_UNOPENED, "Stat on unopened file %s", GvENAME(tmpgv)); PL_statgv = Nullgv; sv_setpv(PL_statname,""); @@ -1915,6 +1917,9 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) id = SvIVx(*++mark); mstr = *++mark; + /* suppress warning when reading into undef var --jhi */ + if (! SvOK(mstr)) + sv_setpvn(mstr, "", 0); msize = SvIVx(*++mark); mtype = (long)SvIVx(*++mark); flags = SvIVx(*++mark); @@ -15,17 +15,34 @@ #define PERL_IN_DOOP_C #include "perl.h" +#ifndef PERL_MICRO #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> #endif +#endif + +#define HALF_UTF8_UPGRADE(start,end) \ + STMT_START { \ + if ((start)<(end)) { \ + U8* NeWsTr; \ + STRLEN LeN = (end) - (start); \ + NeWsTr = bytes_to_utf8(start, &LeN); \ + Safefree(start); \ + (start) = NeWsTr; \ + (end) = (start) + LeN; \ + } \ + } STMT_END STATIC I32 -S_do_trans_CC_simple(pTHX_ SV *sv) +S_do_trans_simple(pTHX_ SV *sv) { dTHR; U8 *s; + U8 *d; U8 *send; + U8 *dstart; I32 matches = 0; + I32 sutf = SvUTF8(sv); STRLEN len; short *tbl; I32 ch; @@ -37,25 +54,59 @@ S_do_trans_CC_simple(pTHX_ SV *sv) s = (U8*)SvPV(sv, len); send = s + len; - while (s < send) { - if ((ch = tbl[*s]) >= 0) { - matches++; - *s = ch; + /* First, take care of non-UTF8 input strings, because they're easy */ + if (!sutf) { + while (s < send) { + if ((ch = tbl[*s]) >= 0) { + matches++; + *s++ = ch; + } + else + s++; } - s++; + SvSETMAGIC(sv); + return matches; } - SvSETMAGIC(sv); + /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */ + Newz(0, d, len*2+1, U8); + dstart = d; + while (s < send) { + I32 ulen; + short c; + + ulen = 1; + /* Need to check this, otherwise 128..255 won't match */ + c = utf8_to_uv(s, &ulen); + if (c < 0x100 && (ch = tbl[(short)c]) >= 0) { + matches++; + if (ch < 0x80) + *d++ = ch; + else + d = uv_to_utf8(d,ch); + s += ulen; + } + else { /* No match -> copy */ + while (ulen--) + *d++ = *s++; + } + } + *d = '\0'; + sv_setpvn(sv, (const char*)dstart, d - dstart); + SvUTF8_on(sv); + SvLEN_set(sv, 2*len+1); + SvSETMAGIC(sv); return matches; } STATIC I32 -S_do_trans_CC_count(pTHX_ SV *sv) +S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; U8 *send; I32 matches = 0; + I32 hasutf = SvUTF8(sv); STRLEN len; short *tbl; @@ -67,21 +118,33 @@ S_do_trans_CC_count(pTHX_ SV *sv) send = s + len; while (s < send) { - if (tbl[*s] >= 0) - matches++; - s++; + if (hasutf && *s & 0x80) + s += UTF8SKIP(s); + else { + UV c; + I32 ulen; + ulen = 1; + if (hasutf) + c = utf8_to_uv(s,&ulen); + else + c = *s; + if (c < 0x100 && tbl[c] >= 0) + matches++; + s += ulen; + } } return matches; } STATIC I32 -S_do_trans_CC_complex(pTHX_ SV *sv) +S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ { dTHR; U8 *s; U8 *send; U8 *d; + I32 hasutf = SvUTF8(sv); I32 matches = 0; STRLEN len; short *tbl; @@ -99,32 +162,40 @@ S_do_trans_CC_complex(pTHX_ SV *sv) U8* p = send; while (s < send) { - if ((ch = tbl[*s]) >= 0) { - *d = ch; - matches++; - if (p == d - 1 && *p == *d) - matches--; - else - p = d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; + if (hasutf && *s & 0x80) + s += UTF8SKIP(s); + else { + if ((ch = tbl[*s]) >= 0) { + *d = ch; + matches++; + if (p == d - 1 && *p == *d) + matches--; + else + p = d++; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; /* -2 is delete character */ + s++; + } } } else { while (s < send) { - if ((ch = tbl[*s]) >= 0) { - *d = ch; - matches++; - d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; + if (hasutf && *s & 0x80) + s += UTF8SKIP(s); + else { + if ((ch = tbl[*s]) >= 0) { + *d = ch; + matches++; + d++; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; /* -2 is delete character */ + s++; + } } } - matches += send - d; /* account for disappeared chars */ + matches += send - d; /* account for disappeared chars */ *d = '\0'; SvCUR_set(sv, d - (U8*)SvPVX(sv)); SvSETMAGIC(sv); @@ -133,12 +204,14 @@ S_do_trans_CC_complex(pTHX_ SV *sv) } STATIC I32 -S_do_trans_UU_simple(pTHX_ SV *sv) +S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; U8 *send; U8 *d; + U8 *start; + U8 *dstart; I32 matches = 0; STRLEN len; @@ -149,43 +222,60 @@ S_do_trans_UU_simple(pTHX_ SV *sv) UV extra = none + 1; UV final; UV uv; + I32 isutf; + I32 howmany; + isutf = SvUTF8(sv); s = (U8*)SvPV(sv, len); send = s + len; + start = s; svp = hv_fetch(hv, "FINAL", 5, FALSE); if (svp) final = SvUV(*svp); - d = s; + /* d needs to be bigger than s, in case e.g. upgrading is required */ + Newz(0, d, len*2+1, U8); + dstart = d; while (s < send) { if ((uv = swash_fetch(rv, s)) < none) { s += UTF8SKIP(s); matches++; + if ((uv & 0x80) && !isutf++) + HALF_UTF8_UPGRADE(dstart,d); d = uv_to_utf8(d, uv); } else if (uv == none) { int i; - for (i = UTF8SKIP(s); i; i--) + i = UTF8SKIP(s); + if (i > 1 && !isutf++) + HALF_UTF8_UPGRADE(dstart,d); + while(i--) *d++ = *s++; } else if (uv == extra) { - s += UTF8SKIP(s); + int i; + i = UTF8SKIP(s); + s += i; matches++; + if (i > 1 && !isutf++) + HALF_UTF8_UPGRADE(dstart,d); d = uv_to_utf8(d, final); } else s += UTF8SKIP(s); } *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); + sv_setpvn(sv, (const char*)dstart, d - dstart); SvSETMAGIC(sv); + if (isutf) + SvUTF8_on(sv); return matches; } STATIC I32 -S_do_trans_UU_count(pTHX_ SV *sv) +S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; @@ -200,6 +290,8 @@ S_do_trans_UU_count(pTHX_ SV *sv) UV uv; s = (U8*)SvPV(sv, len); + if (!SvUTF8(sv)) + s = bytes_to_utf8(s, &len); send = s + len; while (s < send) { @@ -212,189 +304,7 @@ S_do_trans_UU_count(pTHX_ SV *sv) } STATIC I32 -S_do_trans_UC_simple(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - I32 matches = 0; - STRLEN len; - - SV* rv = (SV*)cSVOP->op_sv; - HV* hv = (HV*)SvRV(rv); - SV** svp = hv_fetch(hv, "NONE", 4, FALSE); - UV none = svp ? SvUV(*svp) : 0x7fffffff; - UV extra = none + 1; - UV final; - UV uv; - - s = (U8*)SvPV(sv, len); - send = s + len; - - svp = hv_fetch(hv, "FINAL", 5, FALSE); - if (svp) - final = SvUV(*svp); - - d = s; - while (s < send) { - if ((uv = swash_fetch(rv, s)) < none) { - s += UTF8SKIP(s); - matches++; - *d++ = (U8)uv; - } - else if (uv == none) { - I32 ulen; - uv = utf8_to_uv(s, &ulen); - s += ulen; - *d++ = (U8)uv; - } - else if (uv == extra) { - s += UTF8SKIP(s); - matches++; - *d++ = (U8)final; - } - else - s += UTF8SKIP(s); - } - *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); - SvSETMAGIC(sv); - - return matches; -} - -STATIC I32 -S_do_trans_CU_simple(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - U8 *dst; - I32 matches = 0; - STRLEN len; - - SV* rv = (SV*)cSVOP->op_sv; - HV* hv = (HV*)SvRV(rv); - SV** svp = hv_fetch(hv, "NONE", 4, FALSE); - UV none = svp ? SvUV(*svp) : 0x7fffffff; - UV extra = none + 1; - UV final; - UV uv; - U8 tmpbuf[UTF8_MAXLEN]; - I32 bits = 16; - - s = (U8*)SvPV(sv, len); - send = s + len; - - svp = hv_fetch(hv, "BITS", 4, FALSE); - if (svp) - bits = (I32)SvIV(*svp); - - svp = hv_fetch(hv, "FINAL", 5, FALSE); - if (svp) - final = SvUV(*svp); - - Newz(801, d, len * (bits >> 3) + 1, U8); - dst = d; - - while (s < send) { - uv = *s++; - if (uv < 0x80) - tmpbuf[0] = uv; - else { - tmpbuf[0] = (( uv >> 6) | 0xc0); - tmpbuf[1] = (( uv & 0x3f) | 0x80); - } - - if ((uv = swash_fetch(rv, tmpbuf)) < none) { - matches++; - d = uv_to_utf8(d, uv); - } - else if (uv == none) - d = uv_to_utf8(d, s[-1]); - else if (uv == extra) { - matches++; - d = uv_to_utf8(d, final); - } - } - *d = '\0'; - sv_usepvn_mg(sv, (char*)dst, d - dst); - - return matches; -} - -/* utf-8 to latin-1 */ - -STATIC I32 -S_do_trans_UC_trivial(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - STRLEN len; - - s = (U8*)SvPV(sv, len); - send = s + len; - - d = s; - while (s < send) { - if (*s < 0x80) - *d++ = *s++; - else { - I32 ulen; - UV uv = utf8_to_uv(s, &ulen); - s += ulen; - *d++ = (U8)uv; - } - } - *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); - SvSETMAGIC(sv); - - return SvCUR(sv); -} - -/* latin-1 to utf-8 */ - -STATIC I32 -S_do_trans_CU_trivial(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - U8 *dst; - I32 matches; - STRLEN len; - - s = (U8*)SvPV(sv, len); - send = s + len; - - Newz(801, d, len * 2 + 1, U8); - dst = d; - - matches = send - s; - - while (s < send) { - if (*s < 0x80) - *d++ = *s++; - else { - UV uv = *s++; - *d++ = (( uv >> 6) | 0xc0); - *d++ = (( uv & 0x3f) | 0x80); - } - } - *d = '\0'; - sv_usepvn_mg(sv, (char*)dst, d - dst); - - return matches; -} - -STATIC I32 -S_do_trans_UU_complex(pTHX_ SV *sv) +S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ { dTHR; U8 *s; @@ -402,8 +312,6 @@ S_do_trans_UU_complex(pTHX_ SV *sv) U8 *d; I32 matches = 0; I32 squash = PL_op->op_private & OPpTRANS_SQUASH; - I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF; - I32 to_utf = PL_op->op_private & OPpTRANS_TO_UTF; I32 del = PL_op->op_private & OPpTRANS_DELETE; SV* rv = (SV*)cSVOP->op_sv; HV* hv = (HV*)SvRV(rv); @@ -414,6 +322,7 @@ S_do_trans_UU_complex(pTHX_ SV *sv) UV uv; STRLEN len; U8 *dst; + I32 isutf = SvUTF8(sv); s = (U8*)SvPV(sv, len); send = s + len; @@ -422,27 +331,14 @@ S_do_trans_UU_complex(pTHX_ SV *sv) if (svp) final = SvUV(*svp); - if (PL_op->op_private & OPpTRANS_GROWS) { - I32 bits = 16; - - svp = hv_fetch(hv, "BITS", 4, FALSE); - if (svp) - bits = (I32)SvIV(*svp); - - Newz(801, d, len * (bits >> 3) + 1, U8); + Newz(0, d, len*2+1, U8); dst = d; - } - else { - d = s; - dst = 0; - } if (squash) { UV puv = 0xfeedface; while (s < send) { - if (from_utf) { + if (SvUTF8(sv)) uv = swash_fetch(rv, s); - } else { U8 tmpbuf[2]; uv = *s++; @@ -454,63 +350,42 @@ S_do_trans_UU_complex(pTHX_ SV *sv) } uv = swash_fetch(rv, tmpbuf); } + if (uv < none) { matches++; if (uv != puv) { - if (uv >= 0x80 && to_utf) - d = uv_to_utf8(d, uv); - else - *d++ = (U8)uv; + if ((uv & 0x80) && !isutf++) + HALF_UTF8_UPGRADE(dst,d); + d = uv_to_utf8(d, uv); puv = uv; } - if (from_utf) - s += UTF8SKIP(s); + s += UTF8SKIP(s); continue; } else if (uv == none) { /* "none" is unmapped character */ - if (from_utf) { - if (*s < 0x80) - *d++ = *s++; - else if (to_utf) { - int i; - for (i = UTF8SKIP(s); i; --i) - *d++ = *s++; - } - else { - I32 ulen; - *d++ = (U8)utf8_to_uv(s, &ulen); - s += ulen; - } - } - else { /* must be to_utf only */ - d = uv_to_utf8(d, s[-1]); - } + I32 ulen; + *d++ = (U8)utf8_to_uv(s, &ulen); + s += ulen; puv = 0xfeedface; continue; } else if (uv == extra && !del) { matches++; if (uv != puv) { - if (final >= 0x80 && to_utf) - d = uv_to_utf8(d, final); - else - *d++ = (U8)final; + d = uv_to_utf8(d, final); puv = final; } - if (from_utf) - s += UTF8SKIP(s); + s += UTF8SKIP(s); continue; } - matches++; /* "none+1" is delete character */ - if (from_utf) - s += UTF8SKIP(s); + matches++; /* "none+1" is delete character */ + s += UTF8SKIP(s); } } else { while (s < send) { - if (from_utf) { + if (SvUTF8(sv)) uv = swash_fetch(rv, s); - } else { U8 tmpbuf[2]; uv = *s++; @@ -524,47 +399,24 @@ S_do_trans_UU_complex(pTHX_ SV *sv) } if (uv < none) { matches++; - if (uv >= 0x80 && to_utf) - d = uv_to_utf8(d, uv); - else - *d++ = (U8)uv; - if (from_utf) - s += UTF8SKIP(s); + d = uv_to_utf8(d, uv); + s += UTF8SKIP(s); continue; } else if (uv == none) { /* "none" is unmapped character */ - if (from_utf) { - if (*s < 0x80) - *d++ = *s++; - else if (to_utf) { - int i; - for (i = UTF8SKIP(s); i; --i) - *d++ = *s++; - } - else { - I32 ulen; - *d++ = (U8)utf8_to_uv(s, &ulen); - s += ulen; - } - } - else { /* must be to_utf only */ - d = uv_to_utf8(d, s[-1]); - } + I32 ulen; + *d++ = (U8)utf8_to_uv(s, &ulen); + s += ulen; continue; } else if (uv == extra && !del) { matches++; - if (final >= 0x80 && to_utf) - d = uv_to_utf8(d, final); - else - *d++ = (U8)final; - if (from_utf) - s += UTF8SKIP(s); + d = uv_to_utf8(d, final); + s += UTF8SKIP(s); continue; } - matches++; /* "none+1" is delete character */ - if (from_utf) - s += UTF8SKIP(s); + matches++; /* "none+1" is delete character */ + s += UTF8SKIP(s); } } if (dst) @@ -583,6 +435,8 @@ Perl_do_trans(pTHX_ SV *sv) { dTHR; STRLEN len; + I32 hasutf = (PL_op->op_private & + (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) Perl_croak(aTHX_ PL_no_modify); @@ -592,40 +446,29 @@ Perl_do_trans(pTHX_ SV *sv) return 0; if (!SvPOKp(sv)) (void)SvPV_force(sv, len); - (void)SvPOK_only(sv); + if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) + (void)SvPOK_only_UTF8(sv); DEBUG_t( Perl_deb(aTHX_ "2.TBL\n")); - switch (PL_op->op_private & 63) { + switch (PL_op->op_private & ~hasutf & 63) { case 0: - return do_trans_CC_simple(sv); - - case OPpTRANS_FROM_UTF: - return do_trans_UC_simple(sv); - - case OPpTRANS_TO_UTF: - return do_trans_CU_simple(sv); - - case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF: - return do_trans_UU_simple(sv); + if (hasutf) + return do_trans_simple_utf8(sv); + else + return do_trans_simple(sv); case OPpTRANS_IDENTICAL: - return do_trans_CC_count(sv); - - case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL: - return do_trans_UC_trivial(sv); - - case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL: - return do_trans_CU_trivial(sv); - - case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL: - return do_trans_UU_count(sv); + if (hasutf) + return do_trans_count_utf8(sv); + else + return do_trans_count(sv); default: - if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) - return do_trans_UU_complex(sv); /* could be UC or CU too */ + if (hasutf) + return do_trans_complex_utf8(sv); else - return do_trans_CC_complex(sv); + return do_trans_complex(sv); } } @@ -694,6 +537,7 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) SvTAINTED_on(sv); } +/* XXX SvUTF8 support missing! */ UV Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) { @@ -826,6 +670,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) return retnum; } +/* XXX SvUTF8 support missing! */ void Perl_do_vecset(pTHX_ SV *sv) { @@ -841,6 +686,7 @@ Perl_do_vecset(pTHX_ SV *sv) if (!targ) return; s = (unsigned char*)SvPV_force(targ, targlen); + (void)SvPOK_only(targ); lval = SvUV(sv); offset = LvTARGOFF(sv); size = LvTARGLEN(sv); @@ -851,7 +697,7 @@ Perl_do_vecset(pTHX_ SV *sv) len = (offset + size + 7) / 8; /* required number of bytes */ if (len > targlen) { s = (unsigned char*)SvGROW(targ, len + 1); - (void)memzero(s + targlen, len - targlen + 1); + (void)memzero((char *)(s + targlen), len - targlen + 1); SvCUR_set(targ, len); } @@ -1059,6 +905,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) char *rsave; bool left_utf = DO_UTF8(left); bool right_utf = DO_UTF8(right); + I32 needlen; if (left_utf && !right_utf) sv_utf8_upgrade(right); @@ -1071,17 +918,23 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) rsave = rc = SvPV(right, rightlen); len = leftlen < rightlen ? leftlen : rightlen; lensave = len; - if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { + if ((left_utf || right_utf) && (sv == left || sv == right)) { + needlen = optype == OP_BIT_AND ? len : leftlen + rightlen; + Newz(801, dc, needlen + 1, char); + } + else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { STRLEN n_a; dc = SvPV_force(sv, n_a); if (SvCUR(sv) < len) { dc = SvGROW(sv, len + 1); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); } + if (optype != OP_BIT_AND && (left_utf || right_utf)) + dc = SvGROW(sv, leftlen + rightlen + 1); } else { - I32 needlen = ((optype == OP_BIT_AND) - ? len : (leftlen > rightlen ? leftlen : rightlen)); + needlen = ((optype == OP_BIT_AND) + ? len : (leftlen > rightlen ? leftlen : rightlen)); Newz(801, dc, needlen + 1, char); (void)sv_usepvn(sv, dc, needlen); dc = SvPVX(sv); /* sv_usepvn() calls Renew() */ @@ -1090,14 +943,11 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) (void)SvPOK_only(sv); if (left_utf || right_utf) { UV duc, luc, ruc; + char *dcsave = dc; STRLEN lulen = leftlen; STRLEN rulen = rightlen; - STRLEN dulen = 0; I32 ulen; - if (optype != OP_BIT_AND) - dc = SvGROW(sv, leftlen+rightlen+1); - switch (optype) { case OP_BIT_AND: while (lulen && rulen) { @@ -1110,8 +960,9 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) duc = luc & ruc; dc = (char*)uv_to_utf8((U8*)dc, duc); } - dulen = dc - SvPVX(sv); - SvCUR_set(sv, dulen); + if (sv == left || sv == right) + (void)sv_usepvn(sv, dcsave, needlen); + SvCUR_set(sv, dc - dcsave); break; case OP_BIT_XOR: while (lulen && rulen) { @@ -1137,8 +988,9 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) dc = (char*)uv_to_utf8((U8*)dc, duc); } mop_up_utf: - dulen = dc - SvPVX(sv); - SvCUR_set(sv, dulen); + if (sv == left || sv == right) + (void)sv_usepvn(sv, dcsave, needlen); + SvCUR_set(sv, dc - dcsave); if (rulen) sv_catpvn(sv, rc, rulen); else if (lulen) diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el index f7d7a53be7..c6fa46c496 100644 --- a/emacs/cperl-mode.el +++ b/emacs/cperl-mode.el @@ -2,7 +2,7 @@ ;;;; The following message is relative to GNU version of the module: -;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 1997 +;; Copyright (C) 1985, 86, 87, 1991--2000 ;; Free Software Foundation, Inc. ;; Author: Ilya Zakharevich and Bob Olson @@ -46,9 +46,10 @@ ;;; Commentary: -;; $Id: cperl-mode.el,v 4.19 1998/12/10 03:31:23 ilya Exp ilya $ +;; $Id: cperl-mode.el,v 4.32 2000/05/31 05:13:15 ilya Exp ilya $ -;;; Before RMS Emacs 20.3: To use this mode put the following into +;;; If your Emacs does not default to `cperl-mode' on Perl files: +;;; To use this mode put the following into ;;; your .emacs file: ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t) @@ -788,7 +789,7 @@ ;;; (`cperl-array-face'): One of definitions was garbled. ;;;; After 4.4: -;;; (`cperl-not-bad-regexp'): Updated. +;;; (`cperl-not-bad-style-regexp'): Updated. ;;; (`cperl-make-regexp-x'): Misprint in a message. ;;; (`cperl-find-pods-heres'): $a-1 ? foo : bar; was a regexp. ;;; `<< (' was considered a start of POD. @@ -908,6 +909,142 @@ ;;; (`cperl-calculate-indent'): Correct for labels when calculating ;;; indentation of continuations. ;;; Docstring updated. + +;;;; After 4.19: +;;; Minor (mostly spelling) corrections from 20.3.3 merged. + +;;;; After 4.20: +;;; (`cperl-tips'): Another workaround added. Sent to RMS for 20.4. + +;;;; After 4.21: +;;; (`cperl-praise'): Mention linear-time indent. +;;; (`cperl-find-pods-heres'): @if ? a : b was considered a REx. + +;;;; After 4.22: +;;; (`cperl-after-expr-p'): Make true after __END__. +;;; (`cperl-electric-pod'): "SYNOPSIS" was misspelled. + +;;;; After 4.23: +;;; (`cperl-beautify-regexp-piece'): Was not allowing for *? after a class. +;;; Allow for POSIX char-classes. +;;; Remove trailing whitespace when +;;; adding new linebreak. +;;; Add a level counter to stop shallow. +;;; Indents unprocessed groups rigidly. +;;; (`cperl-beautify-regexp'): Add an optional count argument to go that +;;; many levels deep. +;;; (`cperl-beautify-level'): Likewise +;;; Menu: Add new entries to Regexp menu to do one level +;;; (`cperl-contract-level'): Was entering an infinite loop +;;; (`cperl-find-pods-heres'): Typo (double quoting). +;;; Was detecting < $file > as FH instead of glob. +;;; Support for comments in RExen (except +;;; for m#\#comment#x), governed by +;;; `cperl-regexp-scan'. +;;; (`cperl-regexp-scan'): New customization variable. +;;; (`cperl-forward-re'): Improve logic of resetting syntax table. + +;;;; After 4.23 and: After 4.24: +;;; (`cperl-contract-levels'): Restore position. +;;; (`cperl-beautify-level'): Likewise. +;;; (`cperl-beautify-regexp'): Likewise. +;;; (`cperl-commentify'): Rudimental support for length=1 runs +;;; (`cperl-find-pods-heres'): Process 1-char long REx comments too /a#/x +;;; Processes REx-comments in #-delimited RExen. +;;; MAJOR BUG CORRECTED: after a misparse +;;; a body of a subroutine could be corrupted!!! +;;; One might need to reeval the function body +;;; to fix things. (A similar bug was +;;; present in `cperl-indent-region' eons ago.) +;;; To reproduce: +;; (defun foo () (let ((a '(t))) (insert (format "%s" a)) (setcar a 'BUG) t)) +;; (foo) +;; (foo) +;;; C-x C-e the above three lines (at end-of-line). First evaluation +;;; of `foo' inserts (t), second one inserts (BUG) ?! +;;; +;;; In CPerl it was triggered by inserting then deleting `/' at start of +;;; / a (?# asdf {[(}asdf )ef,/; + +;;;; After 4.25: +;;; (`cperl-commentify'): Was recognizing length=2 "strings" as length=1. +;;; (`imenu-example--create-perl-index'): +;;; Was not enforcing syntaxification-to-the-end. +;;; (`cperl-invert-if-unless'): Allow `for', `foreach'. +;;; (`cperl-find-pods-heres'): Quote `cperl-nonoverridable-face'. +;;; Mark qw(), m()x as indentable. +;;; (`cperl-init-faces'): Highlight `sysopen' too. +;;; Highlight $var in `for my $var' too. +;;; (`cperl-invert-if-unless'): Was leaving whitespace at end. +;;; (`cperl-linefeed'): Was splitting $var{$foo} if point after `{'. +;;; (`cperl-calculate-indent'): Remove old commented out code. +;;; Support (primitive) indentation of qw(), m()x. + + +;;;; After 4.26: +;;; (`cperl-problems'): Mention `fill-paragraph' on comment. \"" and +;;; q [] with intervening newlines. +;;; (`cperl-autoindent-on-semi'): New customization variable. +;;; (`cperl-electric-semi'): Use `cperl-autoindent-on-semi'. +;;; (`cperl-tips'): Mention how to make CPerl the default mode. +;;; (`cperl-mode'): Support `outline-minor-mode' +;;; (Thanks to Mark A. Hershberger). +;;; (`cperl-outline-level'): New function. +;;; (`cperl-highlight-variables-indiscriminately'): New customization var. +;;; (`cperl-init-faces'): Use `cperl-highlight-variables-indiscriminately'. +;;; (Thanks to Sean Kamath <kamath@pogo.wv.tek.com>). +;;; (`cperl-after-block-p'): Support CHECK and INIT. +;;; (`cperl-init-faces'): Likewise and "our". +;;; (Thanks to Doug MacEachern <dougm@covalent.net>). +;;; (`cperl-short-docs'): Likewise and "our". + + +;;;; After 4.27: +;;; (`cperl-find-pods-heres'): Recognize \"" as a string. +;;; Mark whitespace and comments between q and [] +;;; as `syntax-type' => `prestring'. +;;; Allow whitespace between << and "FOO". +;;; (`cperl-problems'): Remove \"" and q [] with intervening newlines. +;;; Mention multiple <<EOF as unsupported. +;;; (`cperl-highlight-variables-indiscriminately'): Doc misprint fixed. +;;; (`cperl-indent-parens-as-block'): New configuration variable. +;;; (`cperl-calculate-indent'): Merge cases of indenting non-BLOCK groups. +;;; Use `cperl-indent-parens-as-block'. +;;; (`cperl-find-pods-heres'): Test for =cut without empty line instead of +;;; complaining about no =cut. +;;; (`cperl-electric-pod'): Change the REx for POD from "\n\n=" to "^\n=". +;;; (`cperl-find-pods-heres'): Likewise. +;;; (`cperl-electric-pod'): Change `forward-sexp' to `forward-word': +;;; POD could've been marked as comment already. +;;; (`cperl-unwind-to-safe'): Unwind before start of POD too. + +;;;; After 4.28: +;;; (`cperl-forward-re'): Throw an error at proper moment REx unfinished. + +;;;; After 4.29: +;;; (`x-color-defined-p'): Make an extra case to peacify the warning. +;;; Toplevel: `defvar' to peacify the warnings. +;;; (`cperl-find-pods-heres'): Could access `font-lock-comment-face' in -nw. +;;;; No -nw-compile time warnings now. +;;; (`cperl-find-tags'): TAGS file had too short substring-to-search. +;;; Be less verbose in non-interactive mode +;;; (`imenu-example--create-perl-index'): Set index-marker after name +;;; (`cperl-outline-regexp'): New variable. +;;; (`cperl-outline-level'): Made compatible with `cperl-outline-regexp'. +;;; (`cperl-mode'): Made use `cperl-outline-regexp'. + +;;;; After 4.30: +;;; (`cperl-find-pods-heres'): =cut the last thing, no blank line, was error. +;;; (`cperl-outline-level'): Make start-of-file same level as `package'. + +;;;; After 4.31: +;;; (`cperl-electric-pod'): `head1' and `over' electric only if empty. +;;; (`cperl-unreadable-ok'): New variable. +;;; (`cperl-find-tags'): Use `cperl-unreadable-ok', do not fail +;;; on an unreadable file +;;; (`cperl-write-tags'): Use `cperl-unreadable-ok', do not fail +;;; on an unreadable directory + ;;; Code: @@ -934,12 +1071,8 @@ ;; XEmacs >= 19.12 ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) ;; XEmacs 19.11 - (t (` (x-valid-color-name-p (, col))))))) - (if (fboundp 'ps-extend-face-list) - (defmacro cperl-ps-extend-face-list (arg) - (` (ps-extend-face-list (, arg)))) - (defmacro cperl-ps-extend-face-list (arg) - (` (error "This version of Emacs has no `ps-extend-face-list'.")))) + ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col)))) + (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) (` (find-face (, arg)))) @@ -1108,6 +1241,12 @@ Insertion after colons requires both this variable and :type 'boolean :group 'cperl-autoinsert-details) +(defcustom cperl-autoindent-on-semi nil + "*Non-nil means automatically indent after insertion of (semi)colon. +Active if `cperl-auto-newline' is false." + :type 'boolean + :group 'cperl-autoinsert-details) + (defcustom cperl-auto-newline-after-colon nil "*Non-nil means automatically newline even after colons. Subject to `cperl-auto-newline' setting." @@ -1217,7 +1356,7 @@ Can be overwritten by `cperl-hairy' if nil." (defcustom cperl-lazy-help-time nil "*Not-nil (and non-null) means to show lazy help after given idle time. Can be overwritten by `cperl-hairy' to be 5 sec if nil." - :type '(choice (const null) integer) + :type '(choice (const null) (const nil) integer) :group 'cperl-affected-by-hairy) (defcustom cperl-pod-face 'font-lock-comment-face @@ -1251,12 +1390,27 @@ Font for POD headers." :type 'boolean :group 'cperl-faces) +(defcustom cperl-highlight-variables-indiscriminately nil + "*Not-nil means perform additional hightlighting on variables. +Currently only changes how scalar variables are hightlighted. +Note that that variable is only read at initialization time for +the variable perl-font-lock-keywords-2, so changing it after you've +entered cperl-mode the first time will have no effect." + :type 'boolean + :group 'cperl) + (defcustom cperl-pod-here-scan t "*Not-nil means look for pod and here-docs sections during startup. You can always make lookup from menu or using \\[cperl-find-pods-heres]." :type 'boolean :group 'cperl-speed) +(defcustom cperl-regexp-scan t + "*Not-nil means make marking of regular expression more thorough. +Effective only with `cperl-pod-here-scan'. Not implemented yet." + :type 'boolean + :group 'cperl-speed) + (defcustom cperl-imenu-addback nil "*Not-nil means add backreferences to generated `imenu's. May require patched `imenu' and `imenu-go'. Obsolete." @@ -1354,11 +1508,17 @@ may be merged to be on the same line when indenting a region." :type 'boolean :group 'cperl-indentation-details) +(defcustom cperl-indent-parens-as-block nil + "*Non-nil means that non-block ()-, {}- and []-groups are indented as blocks, +but for trailing \",\" inside the group, which won't increase indentation. +One should tune up `cperl-close-paren-offset' as well." + :type 'boolean + :group 'cperl-indentation-details) + (defcustom cperl-syntaxify-by-font-lock (and window-system (boundp 'parse-sexp-lookup-properties)) - "*Non-nil means that CPerl uses `font-lock's routines for syntaxification. -Having it TRUE may be not completely debugged yet." + "*Non-nil means that CPerl uses `font-lock's routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) @@ -1462,6 +1622,11 @@ later you should use choose-color.el *instead* of font-lock-extra.el Note that to enable Compile choices in the menu you need to install mode-compile.el. +If your Emacs does not default to `cperl-mode' on Perl files, and you +want it to: put the following into your .emacs file: + +(autoload 'perl-mode \"cperl-mode\" \"alternate mode for editing Perl programs\" t) + Get perl5-info from $CPAN/doc/manual/info/perl-info.tar.gz older version was on @@ -1485,6 +1650,11 @@ parsing of Perl even when editing, sometimes it may be lost. Fix this by M-x norm RET +In cases of more severe confusion sometimes it is helpful to do + + M-x load-l RET cperl-mode RET + M-x norm RET + Before reporting (non-)problems look in the problem section of online micro-docs on what I know about CPerl problems.") @@ -1493,16 +1663,21 @@ micro-docs on what I know about CPerl problems.") install choose-color.el, available from ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/ +`fill-paragraph' on a comment may leave the point behind the +paragraph. Parsing of lines with several <<EOF is not implemented +yet. + Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs 20.1. Most problems below are corrected starting from this version of -Emacs, and all of them should go with RMS's version 20.3. -(Or apply patches to Emacs 19.33/34 - see tips.) +Emacs, and all of them should go with RMS's version 20.3. (Or apply +patches to Emacs 19.33/34 - see tips.) XEmacs is very backward in +this respect. -Note that even with newer Emacsen interaction of `font-lock' and -syntaxification is not cleaned up. You may get slightly different -colors basing on the order of fontification and syntaxification. This -might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but -the corresponding code may still contain some bugs. +Note that even with newer Emacsen in some very rare cases the details +of interaction of `font-lock' and syntaxification may be not cleaned +up yet. You may get slightly different colors basing on the order of +fontification and syntaxification. Say, the initial faces is correct, +but editing the buffer breaks this. Even with older Emacsen CPerl mode tries to corrects some Emacs misunderstandings, however, for efficiency reasons the degree of @@ -1565,7 +1740,7 @@ would. Upgrade. By similar reasons s\"abc\"def\"; -would confuse CPerl a lot. +could confuse CPerl a lot. If you still get wrong indentation in situation that you think the code should be able to parse, try: @@ -1586,7 +1761,7 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove `car' before `imenu-choose-buffer-index' in `imenu'. `imenu-add-to-menubar' in 20.2 is broken. A lot of things on XEmacs may be broken too, judging by bug reports I -recieve. Note that some releases of XEmacs are better than the others +receive. Note that some releases of XEmacs are better than the others as far as bugs reports I see are concerned.") (defvar cperl-praise 'please-ignore-this-line @@ -1650,8 +1825,10 @@ voice); B if A; n) Highlights (by user-choice) either 3-delimiters constructs - (such as tr/a/b/), or regular expressions and `y/tr'. - m) Highlights trailing whitespace. + (such as tr/a/b/), or regular expressions and `y/tr'; + o) Highlights trailing whitespace; + p) Is able to manipulate Perl Regular Expressions to ease + conversion to a more readable form. 5) The indentation engine was very smart, but most of tricks may be not needed anymore with the support for `syntax-table' property. Has @@ -1667,6 +1844,9 @@ the settings present before the switch. 9) When doing indentation of control constructs, may correct line-breaks/spacing between elements of the construct. + +10) Uses a linear-time algorith for indentation of regions (on Emaxen with +capable syntax engines). ") (defvar cperl-speed 'please-ignore-this-line @@ -1857,6 +2037,11 @@ the faces: please specify bold, italic, underline, shadow and box.) (condition-case nil (require 'info) (error nil)) + (if (fboundp 'ps-extend-face-list) + (defmacro cperl-ps-extend-face-list (arg) + (` (ps-extend-face-list (, arg)))) + (defmacro cperl-ps-extend-face-list (arg) + (` (error "This version of Emacs has no `ps-extend-face-list'.")))) ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, ;; macros instead of defsubsts don't work on Emacs, so we do the ;; expansion manually. Any other suggestions? @@ -1961,12 +2146,16 @@ the faces: please specify bold, italic, underline, shadow and box.) ["Fill paragraph/comment" cperl-fill-paragraph t] "----" ["Line up a construction" cperl-lineup (cperl-use-region-p)] - ["Invert if/unless/while/until" cperl-invert-if-unless t] + ["Invert if/unless/while etc" cperl-invert-if-unless t] ("Regexp" ["Beautify" cperl-beautify-regexp cperl-use-syntax-table-text-property] + ["Beautify one level deep" (cperl-beautify-regexp 1) + cperl-use-syntax-table-text-property] ["Beautify a group" cperl-beautify-level cperl-use-syntax-table-text-property] + ["Beautify a group one level deep" (cperl-beautify-level 1) + cperl-use-syntax-table-text-property] ["Contract a group" cperl-contract-level cperl-use-syntax-table-text-property] ["Contract groups" cperl-contract-levels @@ -2108,6 +2297,9 @@ The expansion is entirely correct because it uses the C preprocessor." (defvar perl-font-lock-keywords) (defvar perl-font-lock-keywords-1) (defvar perl-font-lock-keywords-2) +(defvar outline-level) +(defvar cperl-outline-regexp) + ;;;###autoload (defun cperl-mode () "Major mode for editing Perl code. @@ -2305,6 +2497,10 @@ or as help on variables `cperl-tips', `cperl-problems', ("formy" "formy" cperl-electric-keyword 0) ("foreachmy" "foreachmy" cperl-electric-keyword 0) ("do" "do" cperl-electric-keyword 0) + ("=pod" "=pod" cperl-electric-pod 0) + ("=over" "=over" cperl-electric-pod 0) + ("=head1" "=head1" cperl-electric-pod 0) + ("=head2" "=head2" cperl-electric-pod 0) ("pod" "pod" cperl-electric-pod 0) ("over" "over" cperl-electric-pod 0) ("head1" "head1" cperl-electric-pod 0) @@ -2313,6 +2509,11 @@ or as help on variables `cperl-tips', `cperl-problems', (setq local-abbrev-table cperl-mode-abbrev-table) (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0)) (set-syntax-table cperl-mode-syntax-table) + (make-local-variable 'outline-regexp) + ;; (setq outline-regexp imenu-example--function-name-regexp-perl) + (setq outline-regexp cperl-outline-regexp) + (make-local-variable 'outline-level) + (setq outline-level 'cperl-outline-level) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) @@ -2784,21 +2985,22 @@ to nil." (memq this-command '(self-insert-command newline)))) head1 notlast name p really-delete over) (and (save-excursion - (condition-case nil - (backward-sexp 1) - (error nil)) + (forward-word -1) (and (eq (preceding-char) ?=) (progn - (setq head1 (looking-at "head1\\>")) - (setq over (looking-at "over\\>")) + (setq head1 (looking-at "head1\\>[ \t]*$")) + (setq over (and (looking-at "over\\>[ \t]*$") + (not (looking-at "over[ \t]*\n\n\n*=item\\>")))) (forward-char -1) (bolp)) (or (get-text-property (point) 'in-pod) (cperl-after-expr-p nil "{;:") (and (re-search-backward - "\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t) + ;; "\\(\\`\n?\\|\n\n\\)=\\sw+" + "\\(\\`\n?\\|^\n\\)=\\sw+" + (point-min) t) (not (or (looking-at "=cut") (and cperl-use-syntax-table-text-property @@ -2806,12 +3008,12 @@ to nil." 'pod))))))))) (progn (save-excursion - (setq notlast (search-forward "\n\n=" nil t))) + (setq notlast (re-search-forward "^\n=" nil t))) (or notlast (progn (insert "\n\n=cut") (cperl-ensure-newlines 2) - (forward-sexp -2) + (forward-word -2) (if (and head1 (not (save-excursion @@ -2819,19 +3021,19 @@ to nil." (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" nil t)))) ; Only one (progn - (forward-sexp 1) + (forward-word 1) (setq name (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) p (point)) (insert " NAME\n\n" name - " - \n\n=head1 SYNOPSYS\n\n\n\n" + " - \n\n=head1 SYNOPSIS\n\n\n\n" "=head1 DESCRIPTION") (cperl-ensure-newlines 4) (goto-char p) - (forward-sexp 2) + (forward-word 2) (end-of-line) (setq really-delete t)) - (forward-sexp 1)))) + (forward-word 1)))) (if over (progn (setq p (point)) @@ -2839,7 +3041,7 @@ to nil." "=back") (cperl-ensure-newlines 2) (goto-char p) - (forward-sexp 1) + (forward-word 1) (end-of-line) (setq really-delete t))) (if (and delete really-delete) @@ -2908,6 +3110,7 @@ If in POD, insert appropriate lines." ; Leave the level of parens (looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr ; Are at end + (cperl-after-block-p (point-min)) (progn (backward-sexp 1) (setq start (point-marker)) @@ -2995,7 +3198,9 @@ If in POD, insert appropriate lines." (interactive "P") (if cperl-auto-newline (cperl-electric-terminator arg) - (self-insert-command (prefix-numeric-value arg)))) + (self-insert-command (prefix-numeric-value arg)) + (if cperl-autoindent-on-semi + (cperl-indent-line)))) (defun cperl-electric-terminator (arg) "Insert character and correct line's indentation." @@ -3234,8 +3439,9 @@ Will not correct the indentation for labels, but will correct it for braces and closing parentheses and brackets.." (save-excursion (if (or - (memq (get-text-property (point) 'syntax-type) - '(pod here-doc here-doc-delim format)) + (and (memq (get-text-property (point) 'syntax-type) + '(pod here-doc here-doc-delim format)) + (not (get-text-property (point) 'indentable))) ;; before start of POD - whitespace found since do not have 'pod! (and (looking-at "[ \t]*\n=") (error "Spaces before pod section!")) @@ -3249,7 +3455,7 @@ and closing parentheses and brackets.." (following-char))) (in-pod (get-text-property (point) 'in-pod)) (pre-indent-point (point)) - p prop look-prop) + p prop look-prop is-block delim) (cond (in-pod ;; In the verbatim part, probably code example. What to do??? @@ -3286,48 +3492,18 @@ and closing parentheses and brackets.." (setcar (cddr parse-data) start)) ;; Before this point: end of statement (setq old-indent (nth 3 parse-data)))) - ;; (or parse-start (null symbol) - ;; (setq parse-start (symbol-value symbol) - ;; start-indent (nth 2 parse-start) - ;; parse-start (car parse-start))) - ;; (if parse-start - ;; (goto-char parse-start) - ;; (beginning-of-defun)) - ;; ;; Try to go out - ;; (while (< (point) indent-point) - ;; (setq start (point) parse-start start moved nil - ;; state (parse-partial-sexp start indent-point -1)) - ;; (if (> (car state) -1) nil - ;; ;; The current line could start like }}}, so the indentation - ;; ;; corresponds to a different level than what we reached - ;; (setq moved t) - ;; (beginning-of-line 2))) ; Go to the next line. - ;; (if start ; Not at the start of file - ;; (progn - ;; (goto-char start) - ;; (setq start-indent (current-indentation)) - ;; (if moved ; Should correct... - ;; (setq start-indent (- start-indent cperl-indent-level)))) - ;; (setq start-indent 0)) - ;; (if (< (point) indent-point) (setq parse-start (point))) - ;; (or state (setq state (parse-partial-sexp - ;; (point) indent-point -1 nil start-state))) - ;; (setq containing-sexp - ;; (or (car (cdr state)) - ;; (and (>= (nth 6 state) 0) old-containing-sexp)) - ;; old-containing-sexp nil start-state nil) -;;;; (while (< (point) indent-point) -;;;; (setq parse-start (point)) -;;;; (setq state (parse-partial-sexp (point) indent-point -1 nil start-state)) -;;;; (setq containing-sexp -;;;; (or (car (cdr state)) -;;;; (and (>= (nth 6 state) 0) old-containing-sexp)) -;;;; old-containing-sexp nil start-state nil)) - ;; (if symbol (set symbol (list indent-point state start-indent))) - ;; (goto-char indent-point) - (cond ((or (nth 3 state) (nth 4 state)) + (cond ((get-text-property (point) 'indentable) + ;; indent to just after the surrounding open, + ;; skip blanks if we do not close the expression. + (goto-char (1+ (previous-single-property-change (point) 'indentable))) + (or (memq char-after (append ")]}" nil)) + (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (current-column)) + ((or (nth 3 state) (nth 4 state)) ;; return nil or t if should not change this line (nth 4 state)) + ;; XXXX Do we need to special-case this? ((null containing-sexp) ;; Line is at top level. May be data or function definition, ;; or may be function argument declaration. @@ -3366,27 +3542,50 @@ and closing parentheses and brackets.." (list pre-indent-point))) 0) cperl-continued-statement-offset)))) - ((/= (char-after containing-sexp) ?{) - ;; line is expression, not statement: - ;; indent to just after the surrounding open, + ((not + (or (setq is-block + (and (setq delim (= (char-after containing-sexp) ?{)) + (save-excursion ; Is it a hash? + (goto-char containing-sexp) + (cperl-block-p)))) + cperl-indent-parens-as-block)) + ;; group is an expression, not a block: + ;; indent to just after the surrounding open parens, ;; skip blanks if we do not close the expression. (goto-char (1+ containing-sexp)) - (or (memq char-after (append ")]}" nil)) + (or (memq char-after + (append (if delim "}" ")]}") nil)) (looking-at "[ \t]*\\(#\\|$\\)") (skip-chars-forward " \t")) - (current-column)) - ((progn - ;; Containing-expr starts with \{. Check whether it is a hash. - (goto-char containing-sexp) - (not (cperl-block-p))) - (goto-char (1+ containing-sexp)) - (or (eq char-after ?\}) - (looking-at "[ \t]*\\(#\\|$\\)") - (skip-chars-forward " \t")) - (+ (current-column) ; Correct indentation of trailing ?\} - (if (eq char-after ?\}) (+ cperl-indent-level - cperl-close-paren-offset) + (+ (current-column) + (if (and delim + (eq char-after ?\})) + ;; Correct indentation of trailing ?\} + (+ cperl-indent-level cperl-close-paren-offset) 0))) +;;; ((and (/= (char-after containing-sexp) ?{) +;;; (not cperl-indent-parens-as-block)) +;;; ;; line is expression, not statement: +;;; ;; indent to just after the surrounding open, +;;; ;; skip blanks if we do not close the expression. +;;; (goto-char (1+ containing-sexp)) +;;; (or (memq char-after (append ")]}" nil)) +;;; (looking-at "[ \t]*\\(#\\|$\\)") +;;; (skip-chars-forward " \t")) +;;; (current-column)) +;;; ((progn +;;; ;; Containing-expr starts with \{. Check whether it is a hash. +;;; (goto-char containing-sexp) +;;; (and (not (cperl-block-p)) +;;; (not cperl-indent-parens-as-block))) +;;; (goto-char (1+ containing-sexp)) +;;; (or (eq char-after ?\}) +;;; (looking-at "[ \t]*\\(#\\|$\\)") +;;; (skip-chars-forward " \t")) +;;; (+ (current-column) ; Correct indentation of trailing ?\} +;;; (if (eq char-after ?\}) (+ cperl-indent-level +;;; cperl-close-paren-offset) +;;; 0))) (t ;; Statement level. Is it a continuation or a new statement? ;; Find previous non-comment character. @@ -3408,11 +3607,12 @@ and closing parentheses and brackets.." (beginning-of-line) (cperl-backward-to-noncomment containing-sexp)) ;; Now we get the answer. - ;; Had \?, too: - (if (not (or (memq (preceding-char) (append " ;{" '(nil))) + (if (not (or (eq (1- (point)) containing-sexp) + (memq (preceding-char) + (append (if is-block " ;{" " ,;{") '(nil))) (and (eq (preceding-char) ?\}) (cperl-after-block-and-statement-beg - containing-sexp)))) ; Was ?\, + containing-sexp)))) ;; This line is continuation of preceding line's statement; ;; indent `cperl-continued-statement-offset' more than the ;; previous line of the statement. @@ -3424,6 +3624,12 @@ and closing parentheses and brackets.." (+ (if (memq char-after (append "}])" nil)) 0 ; Closing parenth cperl-continued-statement-offset) + (if (or is-block + (not delim) + (not (eq char-after ?\}))) + 0 + ;; Now it is a hash reference + (+ cperl-indent-level cperl-close-paren-offset)) (if (looking-at "\\w+[ \t]*:") (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) @@ -3479,6 +3685,12 @@ and closing parentheses and brackets.." (+ (if (and (bolp) (zerop cperl-indent-level)) (+ cperl-brace-offset cperl-continued-statement-offset) cperl-indent-level) + (if (or is-block + (not delim) + (not (eq char-after ?\}))) + 0 + ;; Now it is a hash reference + (+ cperl-indent-level cperl-close-paren-offset)) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the cperl-brace-imaginary-offset. @@ -3766,8 +3978,11 @@ Returns true if comment is found." nil ;; We suppose that e is _after_ the end of construction, as after eol. (setq string (if string cperl-st-sfence cperl-st-cfence)) - (cperl-modify-syntax-type bb string) - (cperl-modify-syntax-type (1- e) string) + (if (> bb (- e 2)) + ;; one-char string/comment?! + (cperl-modify-syntax-type bb cperl-st-punct) + (cperl-modify-syntax-type bb string) + (cperl-modify-syntax-type (1- e) string)) (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) (put-text-property (1+ bb) (1- e) 'syntax-table cperl-string-syntax-table)) @@ -3777,6 +3992,7 @@ Returns true if comment is found." (not cperl-pod-here-fontify) (put-text-property bb e 'face (if string 'font-lock-string-face 'font-lock-comment-face))))) + (defvar cperl-starters '(( ?\( . ?\) ) ( ?\[ . ?\] ) ( ?\{ . ?\} ) @@ -3786,7 +4002,7 @@ Returns true if comment is found." &optional ostart oend) ;; Works *before* syntax recognition is done ;; May modify syntax-type text property if the situation is too hard - (let (b starter ender st i i2 go-forward) + (let (b starter ender st i i2 go-forward reset-st) (skip-chars-forward " \t") ;; ender means matching-char matcher. (setq b (point) @@ -3819,9 +4035,13 @@ Returns true if comment is found." (not ender)) ;; $ has TeXish matching rules, so $$ equiv $... (forward-char 2) + (setq reset-st (syntax-table)) (set-syntax-table st) (forward-sexp 1) - (set-syntax-table cperl-mode-syntax-table) + (if (<= (point) (1+ b)) + (error "Unfinished regular expression")) + (set-syntax-table reset-st) + (setq reset-st nil) ;; Now the problem is with m;blah;; (and (not ender) (eq (preceding-char) @@ -3858,6 +4078,8 @@ Returns true if comment is found." ender (nth 2 ender))))) (error (goto-char lim) (setq set-st nil) + (if reset-st + (set-syntax-table reset-st)) (or end (message "End of `%s%s%c ... %c' string/RE not found: %s" @@ -3873,7 +4095,7 @@ Returns true if comment is found." ;; i2: start of the second arg, if any (before delim iff `ender'). ;; ender: the last arg bounded by parens-like chars, the second one of them ;; starter: the starting delimiter of the first arg - ;; go-forward: has 2 args, and the second part is empth + ;; go-forward: has 2 args, and the second part is empty (list i i2 ender starter go-forward))) (defvar font-lock-string-face) @@ -3899,6 +4121,7 @@ Returns true if comment is found." ;; After-initial-line--to-end is marked `syntax-type' ==> `format' ;; d) 'Q'uoted string: ;; part between markers inclusive is marked `syntax-type' ==> `string' +;; part between `q' and the first marker is marked `syntax-type' ==> `prestring' (defun cperl-unwind-to-safe (before &optional end) ;; if BEFORE, go to the previous start-of-line on each step of unwinding @@ -3915,6 +4138,11 @@ Returns true if comment is found." (goto-char (setq pos (cperl-1- pos)))) ;; Up to the start (goto-char (point-min)))) + ;; Skip empty lines + (and (looking-at "\n*=") + (/= 0 (skip-chars-backward "\n")) + (forward-char)) + (setq pos (point)) (if end ;; Do the same for end, going small steps (progn @@ -3923,6 +4151,10 @@ Returns true if comment is found." end (next-single-property-change end 'syntax-type))) (or end pos))))) +(defvar cperl-nonoverridable-face) +(defvar font-lock-function-name-face) +(defvar font-lock-comment-face) + (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify @@ -3934,6 +4166,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', cperl-syntax-done-to min)) (or max (setq max (point-max))) (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb + is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p)) @@ -3945,7 +4178,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (point-min))) (state (if use-syntax-state (cdr cperl-syntax-state))) - (st-l '(nil)) (err-l '(nil)) i2 + ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! + (st-l (list nil)) (err-l (list nil)) ;; Somehow font-lock may be not loaded yet... (font-lock-string-face (if (boundp 'font-lock-string-face) font-lock-string-face @@ -3957,6 +4191,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (if (boundp 'font-lock-function-name-face) font-lock-function-name-face 'font-lock-function-name-face)) + (font-lock-comment-face + (if (boundp 'font-lock-comment-face) + font-lock-comment-face + 'font-lock-comment-face)) (cperl-nonoverridable-face (if (boundp 'cperl-nonoverridable-face) cperl-nonoverridable-face @@ -3966,13 +4204,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', max)) (search (concat - "\\(\\`\n?\\|\n\n\\)=" + "\\(\\`\n?\\|^\n\\)=" "\\|" ;; One extra () before this: "<<" "\\(" ; 1 + 1 ;; First variant "BLAH" or just ``. - "\\([\"'`]\\)" ; 2 + 1 + "[ \t]*" ; Yes, whitespace is allowed! + "\\([\"'`]\\)" ; 2 + 1 = 3 "\\([^\"'`\n]*\\)" ; 3 + 1 "\\3" "\\|" @@ -4004,7 +4243,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" ;; 1+6+2+1+1+2+1+1=15 extra () before this: "\\|" - "__\\(END\\|DATA\\)__" ; Commented - does not help with indent... + "__\\(END\\|DATA\\)__" + ;; 1+6+2+1+1+2+1+1+1=16 extra () before this: + "\\|" + "\\\\\\(['`\"]\\)" ) "")))) (unwind-protect @@ -4019,7 +4261,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', here-face cperl-here-face)) (remove-text-properties min max '(syntax-type t in-pod t syntax-table t - cperl-postpone t)) + cperl-postpone t + syntax-subtype t + rear-nonsticky t + indentable t)) ;; Need to remove face as well... (goto-char min) (and (eq system-type 'emx) @@ -4033,8 +4278,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq tmpend nil) ; Valid for most cases (cond ((match-beginning 1) ; POD section - ;; "\\(\\`\n?\\|\n\n\\)=" - (if (looking-at "\n*cut\\>") + ;; "\\(\\`\n?\\|^\n\\)=" + (if (looking-at "cut\\>") (if ignore-max nil ; Doing a chunk only (message "=cut is not preceded by a POD section") @@ -4047,61 +4292,64 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', b1 nil) ; error condition ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (re-search-forward "\n\n=cut\\>" stop-point 'toend) + (or (re-search-forward "^\n=cut\\>" stop-point 'toend) (progn - (message "End of a POD section not marked by =cut") - (setq b1 t) - (or (car err-l) (setcar err-l b)))) + (goto-char b) + (if (re-search-forward "\n=cut\\>" stop-point 'toend) + (progn + (message "=cut is not preceded by an empty line") + (setq b1 t) + (or (car err-l) (setcar err-l b)))))) (beginning-of-line 2) ; An empty line after =cut is not POD! (setq e (point)) - (if (and b1 (eobp)) - ;; Unrecoverable error - nil - (and (> e max) - (progn - (remove-text-properties - max e '(syntax-type t in-pod t syntax-table t - 'cperl-postpone t)) - (setq tmpend tb))) - (put-text-property b e 'in-pod t) - (put-text-property b e 'syntax-type 'in-pod) - (goto-char b) - (while (re-search-forward "\n\n[ \t]" e t) - ;; We start 'pod 1 char earlier to include the preceding line - (beginning-of-line) - (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) - (cperl-put-do-not-fontify b (point) t) - ;; mark the non-literal parts as PODs - (if cperl-pod-here-fontify - (cperl-postpone-fontification b (point) 'face face t)) - (re-search-forward "\n\n[^ \t\f\n]" e 'toend) - (beginning-of-line) - (setq b (point))) - (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) - (cperl-put-do-not-fontify (point) e t) + (and (> e max) + (progn + (remove-text-properties + max e '(syntax-type t in-pod t syntax-table t + cperl-postpone t + syntax-subtype t + rear-nonsticky t + indentable t)) + (setq tmpend tb))) + (put-text-property b e 'in-pod t) + (put-text-property b e 'syntax-type 'in-pod) + (goto-char b) + (while (re-search-forward "\n\n[ \t]" e t) + ;; We start 'pod 1 char earlier to include the preceding line + (beginning-of-line) + (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) + (cperl-put-do-not-fontify b (point) t) + ;; mark the non-literal parts as PODs (if cperl-pod-here-fontify - (progn - ;; mark the non-literal parts as PODs - (cperl-postpone-fontification (point) e 'face face t) - (goto-char bb) - (if (looking-at - "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") - ;; mark the headers - (cperl-postpone-fontification - (match-beginning 1) (match-end 1) - 'face head-face)) - (while (re-search-forward - ;; One paragraph - "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" - e 'toend) + (cperl-postpone-fontification b (point) 'face face t)) + (re-search-forward "\n\n[^ \t\f\n]" e 'toend) + (beginning-of-line) + (setq b (point))) + (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) + (cperl-put-do-not-fontify (point) e t) + (if cperl-pod-here-fontify + (progn + ;; mark the non-literal parts as PODs + (cperl-postpone-fontification (point) e 'face face t) + (goto-char bb) + (if (looking-at + "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ;; mark the headers (cperl-postpone-fontification (match-beginning 1) (match-end 1) - 'face head-face)))) - (cperl-commentify bb e nil) - (goto-char e) - (or (eq e (point-max)) - (forward-char -1))))) ; Prepare for immediate pod start. + 'face head-face)) + (while (re-search-forward + ;; One paragraph + "^\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" + e 'toend) + ;; mark the headers + (cperl-postpone-fontification + (match-beginning 1) (match-end 1) + 'face head-face)))) + (cperl-commentify bb e nil) + (goto-char e) + (or (eq e (point-max)) + (forward-char -1)))) ; Prepare for immediate pod start. ;; Here document ;; We do only one here-per-line ;; ;; One extra () before this: @@ -4239,16 +4487,16 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (or (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y (and (eq bb ?-) (eq c ?s)) ; -s file test - (and (eq bb ?\&) ; &&m/blah/ - (not (eq (char-after + (and (eq bb ?\&) + (not (eq (char-after ; &&m/blah/ (- (match-beginning b1) 2)) ?\&)))) ;; <file> or <$file> (and (eq c ?\<) - ;; Do not stringify <FH> : + ;; Do not stringify <FH>, <$fh> : (save-match-data (looking-at - "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s *\\)?>")))) + "\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\)?>")))) tb (match-beginning 0)) (goto-char (match-beginning b1)) (cperl-backward-to-noncomment (point-min)) @@ -4275,8 +4523,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (if (eq (preceding-char) ?-) ;; -d ?foo? is a RE (looking-at "[a-zA-Z]\\>") - (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))) + (and + (not (memq (preceding-char) + '(?$ ?@ ?& ?%))) + (looking-at + "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) @@ -4301,9 +4552,12 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (goto-char b) (if (or bb (nth 3 state) (nth 4 state)) (goto-char i) + ;; Skip whitespace and comments... (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+") (goto-char (match-end 0)) (skip-chars-forward " \t\n\f")) + (if (> (point) b) + (put-text-property b (point) 'syntax-type 'prestring)) ;; qtag means two-arg matcher, may be reset to ;; 2 or 3 later if some special quoting is needed. ;; e1 means matching-char matcher. @@ -4326,16 +4580,23 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', tail (if (and i (not tag)) (1- e1)) e (if i i e1) ; end of the first part - qtag nil) ; need to preserve backslashitis + qtag nil ; need to preserve backslashitis + is-x-REx nil) ; REx has //x modifier ;; Commenting \\ is dangerous, what about ( ? (and i tail (eq (char-after i) ?\\) (setq qtag t)) + (if (looking-at "\\sw*x") ; qr//x + (setq is-x-REx t)) (if (null i) ;; Considered as 1arg form (progn (cperl-commentify b (point) t) (put-text-property b (point) 'syntax-type 'string) + (if (or is-x-REx + ;; ignore other text properties: + (string-match "^qw$" argument)) + (put-text-property b (point) 'indentable t)) (and go (setq e1 (cperl-1+ e1)) (or (eobp) @@ -4352,9 +4613,13 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (progn (cperl-modify-syntax-type (1- (point)) cperl-st-ket) (cperl-modify-syntax-type i cperl-st-bra))) - (put-text-property b i 'syntax-type 'string)) + (put-text-property b i 'syntax-type 'string) + (if is-x-REx + (put-text-property b i 'indentable t))) (cperl-commentify b1 (point) t) (put-text-property b (point) 'syntax-type 'string) + (if is-x-REx + (put-text-property b i 'indentable t)) (if qtag (cperl-modify-syntax-type (1+ i) cperl-st-punct)) (setq tail nil))) @@ -4364,12 +4629,15 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (forward-word 1) ; skip modifiers s///s (if tail (cperl-commentify tail (point) t)) (cperl-postpone-fontification - e1 (point) 'face cperl-nonoverridable-face))) + e1 (point) 'face 'cperl-nonoverridable-face))) ;; Check whether it is m// which means "previous match" ;; and highlight differently - (if (and (eq e (+ 2 b)) - (string-match "^\\([sm]?\\|qr\\)$" argument) - ;; <> is already filtered out + (setq is-REx + (and (string-match "^\\([sm]?\\|qr\\)$" argument) + (or (not (= (length argument) 0)) + (not (eq c ?\<))))) + (if (and is-REx + (eq e (+ 2 b)) ;; split // *is* using zero-pattern (save-excursion (condition-case nil @@ -4390,7 +4658,56 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (cperl-postpone-fontification b (cperl-1+ b) 'face font-lock-constant-face) (cperl-postpone-fontification - (1- e) e 'face font-lock-constant-face)))) + (1- e) e 'face font-lock-constant-face))) + (if (and is-REx cperl-regexp-scan) + ;; Process RExen better + (save-excursion + (goto-char (1+ b)) + (while + (and (< (point) e) + (re-search-forward + (if is-x-REx + (if (eq (char-after b) ?\#) + "\\((\\?\\\\#\\)\\|\\(\\\\#\\)" + "\\((\\?#\\)\\|\\(#\\)") + (if (eq (char-after b) ?\#) + "\\((\\?\\\\#\\)" + "\\((\\?#\\)")) + (1- e) 'to-end)) + (goto-char (match-beginning 0)) + (setq REx-comment-start (point) + was-comment t) + (if (save-excursion + (and + ;; XXX not working if outside delimiter is # + (eq (preceding-char) ?\\) + (= (% (skip-chars-backward "$\\\\") 2) -1))) + ;; Not a comment, avoid loop: + (progn (setq was-comment nil) + (forward-char 1)) + (if (match-beginning 2) + (progn + (beginning-of-line 2) + (if (> (point) e) + (goto-char (1- e)))) + ;; Works also if the outside delimiters are (). + (or (search-forward ")" (1- e) 'toend) + (message + "Couldn't find end of (?#...)-comment in a REx, pos=%s" + REx-comment-start)))) + (if (>= (point) e) + (goto-char (1- e))) + (if was-comment + (progn + (setq REx-comment-end (point)) + (cperl-commentify + REx-comment-start REx-comment-end nil) + (cperl-postpone-fontification + REx-comment-start REx-comment-end + 'face font-lock-comment-face)))))) + (if (and is-REx is-x-REx) + (put-text-property (1+ b) (1- e) + 'syntax-subtype 'x-REx))) (if i2 (progn (cperl-postpone-fontification @@ -4443,7 +4760,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (goto-char bb)) ;; 1+6+2+1+1+2+1+1=15 extra () before this: ;; "__\\(END\\|DATA\\)__" - (t ; __END__, __DATA__ + ((match-beginning 16) ; __END__, __DATA__ (setq bb (match-end 0) b (match-beginning 0) state (parse-partial-sexp @@ -4454,7 +4771,21 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat (cperl-commentify b bb nil) (setq end t)) - (goto-char bb))) + (goto-char bb)) + ((match-beginning 17) ; "\\\\\\(['`\"]\\)" + (setq bb (match-end 0) + b (match-beginning 0)) + (goto-char b) + (skip-chars-backward "\\\\") + ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1)) + (setq state (parse-partial-sexp + state-point b nil nil state) + state-point b) + (if (or (nth 3 state) (nth 4 state) ) + nil + (cperl-modify-syntax-type b cperl-st-punct)) + (goto-char bb)) + (t (error "Error in regexp of the sniffer"))) (if (> (point) stop-point) (progn (if end @@ -4542,6 +4873,7 @@ CHARS is a string that contains good characters to have before us (however, (setq stop t)))) (or (bobp) ; ???? Needed (eq (point) lim) + (looking-at "[ \t]*__\\(END\\|DATA\\)__") ; After this anything goes (progn (if test (eval test) (or (memq (preceding-char) (append (or chars "{;") nil)) @@ -4661,7 +4993,7 @@ Returns some position at the last line." ;; Looking at: ;; foreach my $var (if (looking-at - "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") + "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") (progn (forward-word 2) (delete-horizontal-space) @@ -4670,7 +5002,7 @@ Returns some position at the last line." ;; Looking at: ;; foreach my $var ( (if (looking-at - "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") + "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") (progn (forward-word 3) (delete-horizontal-space) @@ -4680,7 +5012,7 @@ Returns some position at the last line." ;; Looking at: ;; } foreach my $var () { (if (looking-at - "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ t]+\\(my\\|local\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") + "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") (progn (setq ml (match-beginning 8)) (re-search-forward "[({]") @@ -5022,12 +5354,13 @@ indentation and initial hashes. Behaves usually outside of comment." (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function)) (index-meth-alist '()) meth - packages ends-ranges p + packages ends-ranges p marker (prev-pos 0) char fchar index index1 name (end-range 0) package) (goto-char (point-min)) (if noninteractive (message "Scanning Perl for index") (imenu-progress-message prev-pos 0)) + (cperl-update-syntaxification (point-max) (point-max)) ;; Search for the function (progn ;;save-match-data (while (re-search-forward @@ -5044,7 +5377,7 @@ indentation and initial hashes. Behaves usually outside of comment." nil) ((and (match-beginning 2) ; package or sub - ;; Skip if quoted (will not skip multi-line ''-comments :-(): + ;; Skip if quoted (will not skip multi-line ''-strings :-(): (null (get-text-property (match-beginning 1) 'syntax-table)) (null (get-text-property (match-beginning 1) 'syntax-type)) (null (get-text-property (match-beginning 1) 'in-pod))) @@ -5054,7 +5387,7 @@ indentation and initial hashes. Behaves usually outside of comment." ) ;; (if (looking-at "([^()]*)[ \t\n\f]*") ;; (goto-char (match-end 0))) ; Messes what follows - (setq char (following-char) + (setq char (following-char) ; ?\; for "sub foo () ;" meth nil p (point)) (while (and ends-ranges (>= p (car ends-ranges))) @@ -5077,16 +5410,18 @@ indentation and initial hashes. Behaves usually outside of comment." ;; ) ;; Skip this function name if it is a prototype declaration. (if (and (eq fchar ?s) (eq char ?\;)) nil - (setq index (imenu-example--name-and-position)) - (if (eq fchar ?p) nil - (setq name (buffer-substring (match-beginning 3) (match-end 3))) - (set-text-properties 0 (length name) nil name) + (setq name (buffer-substring (match-beginning 3) (match-end 3)) + marker (make-marker)) + (set-text-properties 0 (length name) nil name) + (set-marker marker (match-end 3)) + (if (eq fchar ?p) + (setq name (concat "package " name)) (cond ((string-match "[:']" name) (setq meth t)) ((> p end-range) nil) (t (setq name (concat package name) meth t)))) - (setcar index name) + (setq index (cons name marker)) (if (eq fchar ?p) (push index index-pack-alist) (push index index-alist)) @@ -5160,6 +5495,25 @@ indentation and initial hashes. Behaves usually outside of comment." index-alist)) (cperl-imenu-addback index-alist))) + +(defvar cperl-outline-regexp + (concat imenu-example--function-name-regexp-perl "\\|" "\\`")) + +;; Suggested by Mark A. Hershberger +(defun cperl-outline-level () + (looking-at outline-regexp) + (cond ((not (match-beginning 1)) 0) ; beginning-of-file + ((match-beginning 2) + (if (eq (char-after (match-beginning 2)) ?p) + 0 ; package + 1)) ; sub + ((match-beginning 5) + (if (eq (char-after (match-beginning 5)) ?1) + 1 ; head1 + 2)) ; head2 + (t 3))) ; should not happen + + (defvar cperl-compilation-error-regexp-alist ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK). '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" @@ -5242,8 +5596,7 @@ indentation and initial hashes. Behaves usually outside of comment." '("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue" "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec" "sub" "do" "dump" "use" - "require" "package" "eval" "my" "our" - "BEGIN" "END" "CHECK" "INIT") + "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT") "\\|") ; Flow control "\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]" ; In what follows we use `type' style @@ -5280,7 +5633,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" ;; "shutdown" "sin" "sleep" "socket" "socketpair" ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink" - ;; "syscall" "sysread" "system" "syswrite" "tell" + ;; "syscall" "sysopen" "sysread" "system" "syswrite" "tell" ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" ;; "umask" "unlink" "unpack" "utime" "values" "vec" ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor" @@ -5309,7 +5662,7 @@ indentation and initial hashes. Behaves usually outside of comment." "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|" "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|" "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|" - "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|tem\\|write\\)\\|" + "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\)\\|" "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|" "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|" "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|" @@ -5322,19 +5675,19 @@ indentation and initial hashes. Behaves usually outside of comment." (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" - ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "__END__" "INIT" "chomp" + ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "__END__" "chomp" ;; "chop" "defined" "delete" "do" "each" "else" "elsif" ;; "eval" "exists" "for" "foreach" "format" "goto" ;; "grep" "if" "keys" "last" "local" "map" "my" "next" - ;; "no" "our" "package" "pop" "pos" "print" "printf" "push" + ;; "no" "package" "pop" "pos" "print" "printf" "push" ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift" ;; "sort" "splice" "split" "study" "sub" "tie" "tr" ;; "undef" "unless" "unshift" "untie" "until" "use" ;; "while" "y" "AUTOLOAD\\|BEGIN\\|CHECK\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|" "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|" - "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|INIT\\|keys\\|" - "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our|" + "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|INIT\\|if\\|keys\\|" + "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|" "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|" "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|" @@ -5372,6 +5725,10 @@ indentation and initial hashes. Behaves usually outside of comment." font-lock-constant-face) ; labels '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets 2 font-lock-constant-face) + ;; Uncomment to get perl-mode-like vars + ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) + ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" + ;;; (2 (cons font-lock-variable-name-face '(underline)))) (cond ((featurep 'font-lock-extra) '("^[ \t]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" (3 font-lock-variable-name-face) @@ -5386,10 +5743,10 @@ indentation and initial hashes. Behaves usually outside of comment." ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)" nil nil (1 font-lock-variable-name-face)))) - (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" + (t '("^[ \t{}]*\\(my\\|local\\our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" 3 font-lock-variable-name-face))) - '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" - 2 font-lock-variable-name-face))) + '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" + 4 font-lock-variable-name-face))) (setq t-font-lock-keywords-1 (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock @@ -5416,6 +5773,11 @@ indentation and initial hashes. Behaves usually outside of comment." ;; (if (cperl-slash-is-regexp) ;; font-lock-function-name-face 'default) nil t)) ))) + (if cperl-highlight-variables-indiscriminately + (setq t-font-lock-keywords-1 + (append t-font-lock-keywords-1 + (list '("[$*]{?\\(\\sw+\\)" 1 + font-lock-variable-name-face))))) (setq perl-font-lock-keywords-1 (if cperl-syntaxify-by-font-lock (cons 'cperl-fontify-update @@ -6216,19 +6578,29 @@ See `cperl-lazy-help-time' too." (imenu-progress-message prev-pos 100)) index-alist)) -(defun cperl-find-tags (file xs topdir) +(defvar cperl-unreadable-ok nil) + +(defun cperl-find-tags (ifile xs topdir) (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel - (cperl-pod-here-fontify nil)) + (cperl-pod-here-fontify nil) f file) (save-excursion (if b (set-buffer b) (cperl-setup-tmp-buf)) (erase-buffer) - (setq file (car (insert-file-contents file))) + (condition-case err + (setq file (car (insert-file-contents ifile))) + (error (if cperl-unreadable-ok nil + (if (y-or-n-p + (format "File %s unreadable. Continue? " ifile)) + (setq cperl-unreadable-ok t) + (error "Aborting: unreadable file %s" ifile))))) + (if (not file) + (message "Unreadable file %s" ifile) (message "Scanning file %s ..." file) (if (and cperl-use-syntax-table-text-property-for-tags (not xs)) (condition-case err ; after __END__ may have garbage - (cperl-find-pods-heres) + (cperl-find-pods-heres nil nil noninteractive) (error (message "While scanning for syntax: %s" err)))) (if xs (setq lst (cperl-xsub-scan)) @@ -6245,8 +6617,8 @@ See `cperl-lazy-help-time' too." (point) (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l (buffer-substring (progn - (skip-chars-forward - ":_a-zA-Z0-9") + (goto-char (cdr elt)) + ;; After name now... (or (eolp) (forward-char 1)) (point)) (progn @@ -6289,7 +6661,7 @@ See `cperl-lazy-help-time' too." (erase-buffer) (or noninteractive (message "Scanning file %s finished" file)) - ret))) + ret)))) (defun cperl-add-tags-recurse-noxs () "Add to TAGS data for Perl and XSUB files in the current directory and kids. @@ -6318,7 +6690,7 @@ Use as (setq topdir default-directory)) (let ((tags-file-name "TAGS") (case-fold-search (eq system-type 'emx)) - xs rel) + xs rel tm) (save-excursion (cond (inbuffer nil) ; Already there ((file-exists-p tags-file-name) @@ -6333,9 +6705,17 @@ Use as (erase-buffer) (setq erase 'ignore))) (let ((files - (directory-files file t - (if recurse nil cperl-scan-files-regexp) - t))) + (condition-case err + (directory-files file t + (if recurse nil cperl-scan-files-regexp) + t) + (error + (if cperl-unreadable-ok nil + (if (y-or-n-p + (format "Directory %s unreadable. Continue? " file)) + (setq cperl-unreadable-ok t + tm nil) ; Return empty list + (error "Aborting: unreadable directory %s" file))))))) (mapcar (function (lambda (file) (cond ((string-match cperl-noscan-files-regexp file) @@ -7012,6 +7392,8 @@ ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>. ARGVOUT Output filehandle with -i flag. BEGIN { ... } Immediately executed (during compilation) piece of code. END { ... } Pseudo-subroutine executed after the script finishes. +CHECK { ... } Pseudo-subroutine executed after the script is compiled. +INIT { ... } Pseudo-subroutine executed before the script starts running. DATA Input filehandle for what follows after __END__ or __DATA__. accept(NEWSOCKET,GENERICSOCKET) alarm(SECONDS) @@ -7113,6 +7495,7 @@ msgget(KEY,FLAGS) msgrcv(ID,VAR,SIZE,TYPE.FLAGS) msgsnd(ID,MSG,FLAGS) my VAR or my (VAR1,...) Introduces a lexical variable ($VAR, @ARR, or %HASH). +our VAR or our (VAR1,...) Lexically enable a global variable ($V, @A, or %H). ... ne ... String inequality. next [LABEL] oct(EXPR) @@ -7281,14 +7664,18 @@ prototype \&SUB Returns prototype of the function given a reference. 'variable-documentation)) (setq buffer-read-only t))))) -(defun cperl-beautify-regexp-piece (b e embed) +(defun cperl-beautify-regexp-piece (b e embed level) ;; b is before the starting delimiter, e before the ending ;; e should be a marker, may be changed, but remains "correct". - (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code) + ;; EMBED is nil iff we process the whole REx. + ;; The REx is guarantied to have //x + ;; LEVEL shows how many levels deep to go + ;; position at enter and at leave is not defined + (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos) (if (not embed) (goto-char (1+ b)) (goto-char b) - (cond ((looking-at "(\\?\\\\#") ; badly commented (?#) + (cond ((looking-at "(\\?\\\\#") ; (?#) wrongly commented when //x-ing (forward-char 2) (delete-char 1) (forward-char 1)) @@ -7306,8 +7693,9 @@ prototype \&SUB Returns prototype of the function given a reference. (goto-char e) (beginning-of-line) (if (re-search-forward "[^ \t]" e t) - (progn + (progn ; Something before the ending delimiter (goto-char e) + (delete-horizontal-space) (insert "\n") (indent-to-column c) (set-marker e (point)))) @@ -7350,17 +7738,27 @@ prototype \&SUB Returns prototype of the function given a reference. (setq tmp (point)) (if (looking-at "\\^?\\]") (goto-char (match-end 0))) - (or (re-search-forward "\\]\\([*+{?]\\)?" e t) + ;; XXXX POSIX classes?! + (while (and (not pos) + (re-search-forward "\\[:\\|\\]" e t)) + (if (eq (preceding-char) ?:) + (or (re-search-forward ":\\]" e t) + (error "[:POSIX:]-group in []-group not terminated")) + (setq pos t))) + (or (eq (preceding-char) ?\]) + (error "[]-group not terminated")) + (if (eq (following-char) ?\{) (progn - (goto-char (1- tmp)) - (error "[]-group not terminated"))) - (if (not (eq (preceding-char) ?\{)) nil - (forward-char -1) - (forward-sexp 1))) + (forward-sexp 1) + (and (eq (following-char) ??) + (forward-char 1))) + (re-search-forward "\\=\\([*+?]\\??\\)" e t))) ((match-beginning 7) ; () (goto-char (match-beginning 0)) - (or (eq (current-column) c1) + (setq pos (current-column)) + (or (eq pos c1) (progn + (delete-horizontal-space) (insert "\n") (indent-to-column c1))) (setq tmp (point)) @@ -7371,20 +7769,29 @@ prototype \&SUB Returns prototype of the function given a reference. ;; (error "()-group not terminated"))) (set-marker m (1- (point))) (set-marker m1 (point)) - (cond - ((not (match-beginning 8)) - (cperl-beautify-regexp-piece tmp m t)) - ((eq (char-after (+ 2 tmp)) ?\{) ; Code - t) - ((eq (char-after (+ 2 tmp)) ?\() ; Conditional - (goto-char (+ 2 tmp)) - (forward-sexp 1) - (cperl-beautify-regexp-piece (point) m t)) - ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind - (goto-char (+ 3 tmp)) - (cperl-beautify-regexp-piece (point) m t)) - (t - (cperl-beautify-regexp-piece tmp m t))) + (if (= level 1) + (if (progn ; indent rigidly if multiline + ;; In fact does not make a lot of sense, since + ;; the starting position can be already lost due + ;; to insertion of "\n" and " " + (goto-char tmp) + (search-forward "\n" m1 t)) + (indent-rigidly (point) m1 (- c1 pos))) + (setq level (1- level)) + (cond + ((not (match-beginning 8)) + (cperl-beautify-regexp-piece tmp m t level)) + ((eq (char-after (+ 2 tmp)) ?\{) ; Code + t) + ((eq (char-after (+ 2 tmp)) ?\() ; Conditional + (goto-char (+ 2 tmp)) + (forward-sexp 1) + (cperl-beautify-regexp-piece (point) m t level)) + ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind + (goto-char (+ 3 tmp)) + (cperl-beautify-regexp-piece (point) m t level)) + (t + (cperl-beautify-regexp-piece tmp m t level)))) (goto-char m1) (cond ((looking-at "[*+?]\\??") (goto-char (match-end 0))) @@ -7398,6 +7805,7 @@ prototype \&SUB Returns prototype of the function given a reference. (progn (or (eolp) (indent-for-comment)) (beginning-of-line 2)) + (delete-horizontal-space) (insert "\n")) (end-of-line) (setq inline nil)) @@ -7408,6 +7816,7 @@ prototype \&SUB Returns prototype of the function given a reference. (if (re-search-forward "[^ \t]" tmp t) (progn (goto-char tmp) + (delete-horizontal-space) (insert "\n")) ;; first at line (delete-region (point) tmp)) @@ -7417,6 +7826,7 @@ prototype \&SUB Returns prototype of the function given a reference. (setq spaces nil) (if (looking-at "[#\n]") (beginning-of-line 2) + (delete-horizontal-space) (insert "\n")) (end-of-line) (setq inline nil))) @@ -7425,8 +7835,8 @@ prototype \&SUB Returns prototype of the function given a reference. (insert " ")) (skip-chars-forward " \t")) (or (looking-at "[#\n]") - (error "unknown code \"%s\" in a regexp" (buffer-substring (point) - (1+ (point))))) + (error "unknown code \"%s\" in a regexp" + (buffer-substring (point) (1+ (point))))) (and inline (end-of-line 2))) ;; Special-case the last line of group (if (and (>= (point) (marker-position e)) @@ -7441,6 +7851,7 @@ prototype \&SUB Returns prototype of the function given a reference. (defun cperl-make-regexp-x () ;; Returns position of the start + ;; XXX this is called too often! Need to cache the result! (save-excursion (or cperl-use-syntax-table-text-property (error "I need to have a regexp marked!")) @@ -7471,15 +7882,19 @@ prototype \&SUB Returns prototype of the function given a reference. (forward-char 1))) b))) -(defun cperl-beautify-regexp () +(defun cperl-beautify-regexp (&optional deep) "do it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." - (interactive) - (goto-char (cperl-make-regexp-x)) - (let ((b (point)) (e (make-marker))) - (forward-sexp 1) - (set-marker e (1- (point))) - (cperl-beautify-regexp-piece b e nil))) + (interactive "P") + (if deep + (prefix-numeric-value deep) + (setq deep -1)) + (save-excursion + (goto-char (cperl-make-regexp-x)) + (let ((b (point)) (e (make-marker))) + (forward-sexp 1) + (set-marker e (1- (point))) + (cperl-beautify-regexp-piece b e nil deep)))) (defun cperl-regext-to-level-start () "Goto start of an enclosing group in regexp. @@ -7501,61 +7916,67 @@ We suppose that the regexp is scanned already." \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) - (cperl-regext-to-level-start) - (let ((b (point)) (e (make-marker)) s c) - (forward-sexp 1) - (set-marker e (1- (point))) - (goto-char b) - (while (re-search-forward "\\(#\\)\\|\n" e t) - (cond - ((match-beginning 1) ; #-comment - (or c (setq c (current-indentation))) - (beginning-of-line 2) ; Skip - (setq s (point)) - (skip-chars-forward " \t") - (delete-region s (point)) - (indent-to-column c)) - (t - (delete-char -1) - (just-one-space)))))) + ;; (save-excursion ; Can't, breaks `cperl-contract-levels' + (cperl-regext-to-level-start) + (let ((b (point)) (e (make-marker)) s c) + (forward-sexp 1) + (set-marker e (1- (point))) + (goto-char b) + (while (re-search-forward "\\(#\\)\\|\n" e 'to-end) + (cond + ((match-beginning 1) ; #-comment + (or c (setq c (current-indentation))) + (beginning-of-line 2) ; Skip + (setq s (point)) + (skip-chars-forward " \t") + (delete-region s (point)) + (indent-to-column c)) + (t + (delete-char -1) + (just-one-space)))))) (defun cperl-contract-levels () "Find an enclosing group in regexp and contract all the kids. \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) - (condition-case nil - (cperl-regext-to-level-start) - (error ; We are outside outermost group - (goto-char (cperl-make-regexp-x)))) - (let ((b (point)) (e (make-marker)) s c) - (forward-sexp 1) - (set-marker e (1- (point))) - (goto-char (1+ b)) - (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) - (cond - ((match-beginning 1) ; Skip - nil) - (t ; Group - (cperl-contract-level)))))) - -(defun cperl-beautify-level () + (save-excursion + (condition-case nil + (cperl-regext-to-level-start) + (error ; We are outside outermost group + (goto-char (cperl-make-regexp-x)))) + (let ((b (point)) (e (make-marker)) s c) + (forward-sexp 1) + (set-marker e (1- (point))) + (goto-char (1+ b)) + (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) + (cond + ((match-beginning 1) ; Skip + nil) + (t ; Group + (cperl-contract-level))))))) + +(defun cperl-beautify-level (&optional deep) "Find an enclosing group in regexp and beautify it. \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." - (interactive) - (cperl-regext-to-level-start) - (let ((b (point)) (e (make-marker))) - (forward-sexp 1) - (set-marker e (1- (point))) - (cperl-beautify-regexp-piece b e nil))) + (interactive "P") + (if deep + (prefix-numeric-value deep) + (setq deep -1)) + (save-excursion + (cperl-regext-to-level-start) + (let ((b (point)) (e (make-marker))) + (forward-sexp 1) + (set-marker e (1- (point))) + (cperl-beautify-regexp-piece b e nil deep)))) (defun cperl-invert-if-unless () - "Changes `if (A) {B}' into `B if A;' if possible." + "Change `if (A) {B}' into `B if A;' etc if possible." (interactive) (or (looking-at "\\<") (forward-sexp -1)) - (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\)\\>") + (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") (let ((pos1 (point)) pos2 pos3 pos4 pos5 s1 s2 state p pos45 (s0 (buffer-substring (match-beginning 0) (match-end 0)))) @@ -7626,6 +8047,7 @@ We suppose that the regexp is scanned already." (forward-word 1) (setq pos1 (point)) (insert " " s1 ";") + (delete-horizontal-space) (forward-char -1) (delete-horizontal-space) (goto-char pos1) @@ -7633,14 +8055,14 @@ We suppose that the regexp is scanned already." (cperl-indent-line)) (error "`%s' (EXPR) not with an {BLOCK}" s0))) (error "`%s' not with an (EXPR)" s0))) - (error "Not at `if', `unless', `while', or `unless'"))) + (error "Not at `if', `unless', `while', `unless', `for' or `foreach'"))) ;;; By Anthony Foiani <afoiani@uswest.com> ;;; Getting help on modules in C-h f ? +;;; This is a modified version of `man'. ;;; Need to teach it how to lookup functions -(defvar Man-filter-list) (defun cperl-perldoc (word) - "Run a 'perldoc' on WORD." + "Run `perldoc' on WORD." (interactive (list (let* ((default-entry (cperl-word-at-point)) (input (read-string @@ -7664,15 +8086,18 @@ We suppose that the regexp is scanned already." (Man-getpage-in-background word))) (defun cperl-perldoc-at-point () - "Run a 'perldoc' on WORD." + "Run a `perldoc' on the word around point." (interactive) (cperl-perldoc (cperl-word-at-point))) -;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes) -(defvar pod2man-program "pod2man") +(defcustom pod2man-program "pod2man" + "*File name for `pod2man'." + :type 'file + :group 'cperl) +;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes) (defun cperl-pod-to-manpage () - "Create a virtual manpage in emacs from the Perl Online Documentation" + "Create a virtual manpage in Emacs from the Perl Online Documentation." (interactive) (require 'man) (let* ((pod2man-args (concat buffer-file-name " | nroff -man ")) @@ -7759,6 +8184,7 @@ We suppose that the regexp is scanned already." (defvar cperl-d-l nil) (defun cperl-fontify-syntaxically (end) ;; Some vars for debugging only + ;; (message "Syntaxifying...") (let (start (dbg (point)) (iend end) (istate (car cperl-syntax-state))) (and cperl-syntaxify-unwind @@ -7776,12 +8202,6 @@ We suppose that the regexp is scanned already." (and (> end start) (setq cperl-syntax-done-to start) ; In case what follows fails (cperl-find-pods-heres start end t nil t)) - ;;(setq cperl-d-l (cons (format "Syntaxifying %s..%s from %s to %s\n" - ;; dbg end start cperl-syntax-done-to) - ;; cperl-d-l)) - ;;(let ((standard-output (get-buffer "*Messages*"))) - ;;(princ (format "Syntaxifying %s..%s from %s to %s\n" - ;; dbg end start cperl-syntax-done-to))) (if (eq cperl-syntaxify-by-font-lock 'message) (message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" dbg iend @@ -7809,7 +8229,7 @@ We suppose that the regexp is scanned already." (cperl-fontify-syntaxically to))))) (defvar cperl-version - (let ((v "$Revision: 4.19 $")) + (let ((v "$Revision: 4.32 $")) (string-match ":\\s *\\([0-9.]+\\)" v) (substring v (match-beginning 1) (match-end 1))) "Version of IZ-supported CPerl package this file is based on.") @@ -7817,4 +8237,3 @@ We suppose that the regexp is scanned already." (provide 'cperl-mode) ;;; cperl-mode.el ends here - @@ -71,6 +71,7 @@ #define append_elem Perl_append_elem #define append_list Perl_append_list #define apply Perl_apply +#define apply_attrs_string Perl_apply_attrs_string #define avhv_delete_ent Perl_avhv_delete_ent #define avhv_exists_ent Perl_avhv_exists_ent #define avhv_fetch_ent Perl_avhv_fetch_ent @@ -229,6 +230,7 @@ #define gv_check Perl_gv_check #define gv_efullname Perl_gv_efullname #define gv_efullname3 Perl_gv_efullname3 +#define gv_efullname4 Perl_gv_efullname4 #define gv_fetchfile Perl_gv_fetchfile #define gv_fetchmeth Perl_gv_fetchmeth #define gv_fetchmethod Perl_gv_fetchmethod @@ -236,6 +238,7 @@ #define gv_fetchpv Perl_gv_fetchpv #define gv_fullname Perl_gv_fullname #define gv_fullname3 Perl_gv_fullname3 +#define gv_fullname4 Perl_gv_fullname4 #define gv_init Perl_gv_init #define gv_stashpv Perl_gv_stashpv #define gv_stashpvn Perl_gv_stashpvn @@ -269,6 +272,7 @@ #define instr Perl_instr #define io_close Perl_io_close #define invert Perl_invert +#define is_gv_magical Perl_is_gv_magical #define is_uni_alnum Perl_is_uni_alnum #define is_uni_alnumc Perl_is_uni_alnumc #define is_uni_idfirst Perl_is_uni_idfirst @@ -304,6 +308,7 @@ #define to_uni_title_lc Perl_to_uni_title_lc #define to_uni_lower_lc Perl_to_uni_lower_lc #define is_utf8_char Perl_is_utf8_char +#define is_utf8_string Perl_is_utf8_string #define is_utf8_alnum Perl_is_utf8_alnum #define is_utf8_alnumc Perl_is_utf8_alnumc #define is_utf8_idfirst Perl_is_utf8_idfirst @@ -570,6 +575,7 @@ #define save_freeop Perl_save_freeop #define save_freepv Perl_save_freepv #define save_generic_svref Perl_save_generic_svref +#define save_generic_pvref Perl_save_generic_pvref #define save_gp Perl_save_gp #define save_hash Perl_save_hash #define save_helem Perl_save_helem @@ -719,6 +725,8 @@ #define utf16_to_utf8_reversed Perl_utf16_to_utf8_reversed #define utf8_distance Perl_utf8_distance #define utf8_hop Perl_utf8_hop +#define utf8_to_bytes Perl_utf8_to_bytes +#define bytes_to_utf8 Perl_bytes_to_utf8 #define utf8_to_uv Perl_utf8_to_uv #define uv_to_utf8 Perl_uv_to_utf8 #define vivify_defelem Perl_vivify_defelem @@ -759,6 +767,9 @@ #endif #define runops_standard Perl_runops_standard #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#define sv_lock Perl_sv_lock +#endif #define sv_catpvf_mg Perl_sv_catpvf_mg #define sv_vcatpvf_mg Perl_sv_vcatpvf_mg #define sv_catpv_mg Perl_sv_catpv_mg @@ -831,6 +842,7 @@ #define ptr_table_split Perl_ptr_table_split #endif #if defined(HAVE_INTERP_INTERN) +#define sys_intern_clear Perl_sys_intern_clear #define sys_intern_init Perl_sys_intern_init #endif #if defined(PERL_OBJECT) @@ -841,16 +853,12 @@ #define avhv_index S_avhv_index #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define do_trans_CC_simple S_do_trans_CC_simple -#define do_trans_CC_count S_do_trans_CC_count -#define do_trans_CC_complex S_do_trans_CC_complex -#define do_trans_UU_simple S_do_trans_UU_simple -#define do_trans_UU_count S_do_trans_UU_count -#define do_trans_UU_complex S_do_trans_UU_complex -#define do_trans_UC_simple S_do_trans_UC_simple -#define do_trans_CU_simple S_do_trans_CU_simple -#define do_trans_UC_trivial S_do_trans_UC_trivial -#define do_trans_CU_trivial S_do_trans_CU_trivial +#define do_trans_simple S_do_trans_simple +#define do_trans_count S_do_trans_count +#define do_trans_complex S_do_trans_complex +#define do_trans_simple_utf8 S_do_trans_simple_utf8 +#define do_trans_count_utf8 S_do_trans_count_utf8 +#define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv S_gv_init_sv @@ -1089,6 +1097,7 @@ #define scan_trans S_scan_trans #define scan_word S_scan_word #define skipspace S_skipspace +#define swallow_bom S_swallow_bom #define checkcomma S_checkcomma #define force_ident S_force_ident #define incline S_incline @@ -1102,6 +1111,7 @@ #define sublex_push S_sublex_push #define sublex_start S_sublex_start #define filter_gets S_filter_gets +#define find_in_my_stash S_find_in_my_stash #define new_constant S_new_constant #define ao S_ao #define depcom S_depcom @@ -1539,6 +1549,7 @@ #define append_elem(a,b,c) Perl_append_elem(aTHX_ a,b,c) #define append_list(a,b,c) Perl_append_list(aTHX_ a,b,c) #define apply(a,b,c) Perl_apply(aTHX_ a,b,c) +#define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d) #define avhv_delete_ent(a,b,c,d) Perl_avhv_delete_ent(aTHX_ a,b,c,d) #define avhv_exists_ent(a,b,c) Perl_avhv_exists_ent(aTHX_ a,b,c) #define avhv_fetch_ent(a,b,c,d) Perl_avhv_fetch_ent(aTHX_ a,b,c,d) @@ -1679,6 +1690,7 @@ #define gv_check(a) Perl_gv_check(aTHX_ a) #define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b) #define gv_efullname3(a,b,c) Perl_gv_efullname3(aTHX_ a,b,c) +#define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d) #define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a) #define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d) #define gv_fetchmethod(a,b) Perl_gv_fetchmethod(aTHX_ a,b) @@ -1686,6 +1698,7 @@ #define gv_fetchpv(a,b,c) Perl_gv_fetchpv(aTHX_ a,b,c) #define gv_fullname(a,b) Perl_gv_fullname(aTHX_ a,b) #define gv_fullname3(a,b,c) Perl_gv_fullname3(aTHX_ a,b,c) +#define gv_fullname4(a,b,c,d) Perl_gv_fullname4(aTHX_ a,b,c,d) #define gv_init(a,b,c,d,e) Perl_gv_init(aTHX_ a,b,c,d,e) #define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b) #define gv_stashpvn(a,b,c) Perl_gv_stashpvn(aTHX_ a,b,c) @@ -1719,6 +1732,7 @@ #define instr(a,b) Perl_instr(aTHX_ a,b) #define io_close(a,b) Perl_io_close(aTHX_ a,b) #define invert(a) Perl_invert(aTHX_ a) +#define is_gv_magical(a,b,c) Perl_is_gv_magical(aTHX_ a,b,c) #define is_uni_alnum(a) Perl_is_uni_alnum(aTHX_ a) #define is_uni_alnumc(a) Perl_is_uni_alnumc(aTHX_ a) #define is_uni_idfirst(a) Perl_is_uni_idfirst(aTHX_ a) @@ -1754,6 +1768,7 @@ #define to_uni_title_lc(a) Perl_to_uni_title_lc(aTHX_ a) #define to_uni_lower_lc(a) Perl_to_uni_lower_lc(aTHX_ a) #define is_utf8_char(a) Perl_is_utf8_char(aTHX_ a) +#define is_utf8_string(a,b) Perl_is_utf8_string(aTHX_ a,b) #define is_utf8_alnum(a) Perl_is_utf8_alnum(aTHX_ a) #define is_utf8_alnumc(a) Perl_is_utf8_alnumc(aTHX_ a) #define is_utf8_idfirst(a) Perl_is_utf8_idfirst(aTHX_ a) @@ -2017,6 +2032,7 @@ #define save_freeop(a) Perl_save_freeop(aTHX_ a) #define save_freepv(a) Perl_save_freepv(aTHX_ a) #define save_generic_svref(a) Perl_save_generic_svref(aTHX_ a) +#define save_generic_pvref(a) Perl_save_generic_pvref(aTHX_ a) #define save_gp(a,b) Perl_save_gp(aTHX_ a,b) #define save_hash(a) Perl_save_hash(aTHX_ a) #define save_helem(a,b,c) Perl_save_helem(aTHX_ a,b,c) @@ -2160,10 +2176,12 @@ #define unsharepvn(a,b,c) Perl_unsharepvn(aTHX_ a,b,c) #define unshare_hek(a) Perl_unshare_hek(aTHX_ a) #define utilize(a,b,c,d,e) Perl_utilize(aTHX_ a,b,c,d,e) -#define utf16_to_utf8(a,b,c) Perl_utf16_to_utf8(aTHX_ a,b,c) -#define utf16_to_utf8_reversed(a,b,c) Perl_utf16_to_utf8_reversed(aTHX_ a,b,c) +#define utf16_to_utf8(a,b,c,d) Perl_utf16_to_utf8(aTHX_ a,b,c,d) +#define utf16_to_utf8_reversed(a,b,c,d) Perl_utf16_to_utf8_reversed(aTHX_ a,b,c,d) #define utf8_distance(a,b) Perl_utf8_distance(aTHX_ a,b) #define utf8_hop(a,b) Perl_utf8_hop(aTHX_ a,b) +#define utf8_to_bytes(a,b) Perl_utf8_to_bytes(aTHX_ a,b) +#define bytes_to_utf8(a,b) Perl_bytes_to_utf8(aTHX_ a,b) #define utf8_to_uv(a,b) Perl_utf8_to_uv(aTHX_ a,b) #define uv_to_utf8(a,b) Perl_uv_to_utf8(aTHX_ a,b) #define vivify_defelem(a) Perl_vivify_defelem(aTHX_ a) @@ -2202,6 +2220,9 @@ #endif #define runops_standard() Perl_runops_standard(aTHX) #define runops_debug() Perl_runops_debug(aTHX) +#if defined(USE_THREADS) +#define sv_lock(a) Perl_sv_lock(aTHX_ a) +#endif #define sv_vcatpvf_mg(a,b,c) Perl_sv_vcatpvf_mg(aTHX_ a,b,c) #define sv_catpv_mg(a,b) Perl_sv_catpv_mg(aTHX_ a,b) #define sv_catpvn_mg(a,b,c) Perl_sv_catpvn_mg(aTHX_ a,b,c) @@ -2270,6 +2291,7 @@ #define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) #endif #if defined(HAVE_INTERP_INTERN) +#define sys_intern_clear() Perl_sys_intern_clear(aTHX) #define sys_intern_init() Perl_sys_intern_init(aTHX) #endif #if defined(PERL_OBJECT) @@ -2280,16 +2302,12 @@ #define avhv_index(a,b,c) S_avhv_index(aTHX_ a,b,c) #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define do_trans_CC_simple(a) S_do_trans_CC_simple(aTHX_ a) -#define do_trans_CC_count(a) S_do_trans_CC_count(aTHX_ a) -#define do_trans_CC_complex(a) S_do_trans_CC_complex(aTHX_ a) -#define do_trans_UU_simple(a) S_do_trans_UU_simple(aTHX_ a) -#define do_trans_UU_count(a) S_do_trans_UU_count(aTHX_ a) -#define do_trans_UU_complex(a) S_do_trans_UU_complex(aTHX_ a) -#define do_trans_UC_simple(a) S_do_trans_UC_simple(aTHX_ a) -#define do_trans_CU_simple(a) S_do_trans_CU_simple(aTHX_ a) -#define do_trans_UC_trivial(a) S_do_trans_UC_trivial(aTHX_ a) -#define do_trans_CU_trivial(a) S_do_trans_CU_trivial(aTHX_ a) +#define do_trans_simple(a) S_do_trans_simple(aTHX_ a) +#define do_trans_count(a) S_do_trans_count(aTHX_ a) +#define do_trans_complex(a) S_do_trans_complex(aTHX_ a) +#define do_trans_simple_utf8(a) S_do_trans_simple_utf8(aTHX_ a) +#define do_trans_count_utf8(a) S_do_trans_count_utf8(aTHX_ a) +#define do_trans_complex_utf8(a) S_do_trans_complex_utf8(aTHX_ a) #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv(a,b) S_gv_init_sv(aTHX_ a,b) @@ -2527,6 +2545,7 @@ #define scan_trans(a) S_scan_trans(aTHX_ a) #define scan_word(a,b,c,d,e) S_scan_word(aTHX_ a,b,c,d,e) #define skipspace(a) S_skipspace(aTHX_ a) +#define swallow_bom(a) S_swallow_bom(aTHX_ a) #define checkcomma(a,b,c) S_checkcomma(aTHX_ a,b,c) #define force_ident(a,b) S_force_ident(aTHX_ a,b) #define incline(a) S_incline(aTHX_ a) @@ -2540,6 +2559,7 @@ #define sublex_push() S_sublex_push(aTHX) #define sublex_start() S_sublex_start(aTHX) #define filter_gets(a,b,c) S_filter_gets(aTHX_ a,b,c) +#define find_in_my_stash(a,b) S_find_in_my_stash(aTHX_ a,b) #define new_constant(a,b,c,d,e,f) S_new_constant(aTHX_ a,b,c,d,e,f) #define ao(a) S_ao(aTHX_ a) #define depcom() S_depcom(aTHX) @@ -2987,6 +3007,8 @@ #define append_list Perl_append_list #define Perl_apply CPerlObj::Perl_apply #define apply Perl_apply +#define Perl_apply_attrs_string CPerlObj::Perl_apply_attrs_string +#define apply_attrs_string Perl_apply_attrs_string #define Perl_avhv_delete_ent CPerlObj::Perl_avhv_delete_ent #define avhv_delete_ent Perl_avhv_delete_ent #define Perl_avhv_exists_ent CPerlObj::Perl_avhv_exists_ent @@ -3287,6 +3309,8 @@ #define gv_efullname Perl_gv_efullname #define Perl_gv_efullname3 CPerlObj::Perl_gv_efullname3 #define gv_efullname3 Perl_gv_efullname3 +#define Perl_gv_efullname4 CPerlObj::Perl_gv_efullname4 +#define gv_efullname4 Perl_gv_efullname4 #define Perl_gv_fetchfile CPerlObj::Perl_gv_fetchfile #define gv_fetchfile Perl_gv_fetchfile #define Perl_gv_fetchmeth CPerlObj::Perl_gv_fetchmeth @@ -3301,6 +3325,8 @@ #define gv_fullname Perl_gv_fullname #define Perl_gv_fullname3 CPerlObj::Perl_gv_fullname3 #define gv_fullname3 Perl_gv_fullname3 +#define Perl_gv_fullname4 CPerlObj::Perl_gv_fullname4 +#define gv_fullname4 Perl_gv_fullname4 #define Perl_gv_init CPerlObj::Perl_gv_init #define gv_init Perl_gv_init #define Perl_gv_stashpv CPerlObj::Perl_gv_stashpv @@ -3367,6 +3393,8 @@ #define io_close Perl_io_close #define Perl_invert CPerlObj::Perl_invert #define invert Perl_invert +#define Perl_is_gv_magical CPerlObj::Perl_is_gv_magical +#define is_gv_magical Perl_is_gv_magical #define Perl_is_uni_alnum CPerlObj::Perl_is_uni_alnum #define is_uni_alnum Perl_is_uni_alnum #define Perl_is_uni_alnumc CPerlObj::Perl_is_uni_alnumc @@ -3437,6 +3465,8 @@ #define to_uni_lower_lc Perl_to_uni_lower_lc #define Perl_is_utf8_char CPerlObj::Perl_is_utf8_char #define is_utf8_char Perl_is_utf8_char +#define Perl_is_utf8_string CPerlObj::Perl_is_utf8_string +#define is_utf8_string Perl_is_utf8_string #define Perl_is_utf8_alnum CPerlObj::Perl_is_utf8_alnum #define is_utf8_alnum Perl_is_utf8_alnum #define Perl_is_utf8_alnumc CPerlObj::Perl_is_utf8_alnumc @@ -3950,6 +3980,8 @@ #define save_freepv Perl_save_freepv #define Perl_save_generic_svref CPerlObj::Perl_save_generic_svref #define save_generic_svref Perl_save_generic_svref +#define Perl_save_generic_pvref CPerlObj::Perl_save_generic_pvref +#define save_generic_pvref Perl_save_generic_pvref #define Perl_save_gp CPerlObj::Perl_save_gp #define save_gp Perl_save_gp #define Perl_save_hash CPerlObj::Perl_save_hash @@ -4240,6 +4272,10 @@ #define utf8_distance Perl_utf8_distance #define Perl_utf8_hop CPerlObj::Perl_utf8_hop #define utf8_hop Perl_utf8_hop +#define Perl_utf8_to_bytes CPerlObj::Perl_utf8_to_bytes +#define utf8_to_bytes Perl_utf8_to_bytes +#define Perl_bytes_to_utf8 CPerlObj::Perl_bytes_to_utf8 +#define bytes_to_utf8 Perl_bytes_to_utf8 #define Perl_utf8_to_uv CPerlObj::Perl_utf8_to_uv #define utf8_to_uv Perl_utf8_to_uv #define Perl_uv_to_utf8 CPerlObj::Perl_uv_to_utf8 @@ -4311,6 +4347,10 @@ #define runops_standard Perl_runops_standard #define Perl_runops_debug CPerlObj::Perl_runops_debug #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#define Perl_sv_lock CPerlObj::Perl_sv_lock +#define sv_lock Perl_sv_lock +#endif #define Perl_sv_catpvf_mg CPerlObj::Perl_sv_catpvf_mg #define sv_catpvf_mg Perl_sv_catpvf_mg #define Perl_sv_vcatpvf_mg CPerlObj::Perl_sv_vcatpvf_mg @@ -4448,6 +4488,8 @@ #define ptr_table_split Perl_ptr_table_split #endif #if defined(HAVE_INTERP_INTERN) +#define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear +#define sys_intern_clear Perl_sys_intern_clear #define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init #define sys_intern_init Perl_sys_intern_init #endif @@ -4461,26 +4503,18 @@ #define avhv_index S_avhv_index #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define S_do_trans_CC_simple CPerlObj::S_do_trans_CC_simple -#define do_trans_CC_simple S_do_trans_CC_simple -#define S_do_trans_CC_count CPerlObj::S_do_trans_CC_count -#define do_trans_CC_count S_do_trans_CC_count -#define S_do_trans_CC_complex CPerlObj::S_do_trans_CC_complex -#define do_trans_CC_complex S_do_trans_CC_complex -#define S_do_trans_UU_simple CPerlObj::S_do_trans_UU_simple -#define do_trans_UU_simple S_do_trans_UU_simple -#define S_do_trans_UU_count CPerlObj::S_do_trans_UU_count -#define do_trans_UU_count S_do_trans_UU_count -#define S_do_trans_UU_complex CPerlObj::S_do_trans_UU_complex -#define do_trans_UU_complex S_do_trans_UU_complex -#define S_do_trans_UC_simple CPerlObj::S_do_trans_UC_simple -#define do_trans_UC_simple S_do_trans_UC_simple -#define S_do_trans_CU_simple CPerlObj::S_do_trans_CU_simple -#define do_trans_CU_simple S_do_trans_CU_simple -#define S_do_trans_UC_trivial CPerlObj::S_do_trans_UC_trivial -#define do_trans_UC_trivial S_do_trans_UC_trivial -#define S_do_trans_CU_trivial CPerlObj::S_do_trans_CU_trivial -#define do_trans_CU_trivial S_do_trans_CU_trivial +#define S_do_trans_simple CPerlObj::S_do_trans_simple +#define do_trans_simple S_do_trans_simple +#define S_do_trans_count CPerlObj::S_do_trans_count +#define do_trans_count S_do_trans_count +#define S_do_trans_complex CPerlObj::S_do_trans_complex +#define do_trans_complex S_do_trans_complex +#define S_do_trans_simple_utf8 CPerlObj::S_do_trans_simple_utf8 +#define do_trans_simple_utf8 S_do_trans_simple_utf8 +#define S_do_trans_count_utf8 CPerlObj::S_do_trans_count_utf8 +#define do_trans_count_utf8 S_do_trans_count_utf8 +#define S_do_trans_complex_utf8 CPerlObj::S_do_trans_complex_utf8 +#define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define S_gv_init_sv CPerlObj::S_gv_init_sv @@ -4913,6 +4947,8 @@ #define scan_word S_scan_word #define S_skipspace CPerlObj::S_skipspace #define skipspace S_skipspace +#define S_swallow_bom CPerlObj::S_swallow_bom +#define swallow_bom S_swallow_bom #define S_checkcomma CPerlObj::S_checkcomma #define checkcomma S_checkcomma #define S_force_ident CPerlObj::S_force_ident @@ -4939,6 +4975,8 @@ #define sublex_start S_sublex_start #define S_filter_gets CPerlObj::S_filter_gets #define filter_gets S_filter_gets +#define S_find_in_my_stash CPerlObj::S_find_in_my_stash +#define find_in_my_stash S_find_in_my_stash #define S_new_constant CPerlObj::S_new_constant #define new_constant S_new_constant #define S_ao CPerlObj::S_ao @@ -916,6 +916,9 @@ START_EXTERN_C { return &(PL_##v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ { return &(PL_##v); } +#undef PERLVARIC +#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHXo) \ + { return (const t *)&(PL_##v); } #include "perlvars.h" #undef PERLVAR @@ -1078,12 +1081,12 @@ my %apidocs; my %gutsdocs; my %docfuncs; -sub autodoc ($) { # parse a file and extract documentation info - my($fh) = @_; - my($in, $doc); - +sub autodoc ($$) { # parse a file and extract documentation info + my($fh,$file) = @_; + my($in, $doc, $line); FUNC: while (defined($in = <$fh>)) { + $line++; if ($in =~ /^=for\s+apidoc\s+(.*)\n/) { my $proto = $1; $proto = "||$proto" unless $proto =~ /\|/; @@ -1091,24 +1094,33 @@ FUNC: my $docs = ""; DOC: while (defined($doc = <$fh>)) { + $line++; last DOC if $doc =~ /^=\w+/; + if ($doc =~ m:^\*/$:) { + warn "=cut missing? $file:$line:$doc";; + last DOC; + } $docs .= $doc; } $docs = "\n$docs" if $docs and $docs !~ /^\n/; if ($flags =~ /m/) { if ($flags =~ /A/) { - $apidocs{$name} = [$flags, $docs, $ret, @args]; + $apidocs{$name} = [$flags, $docs, $ret, $file, @args]; } else { - $gutsdocs{$name} = [$flags, $docs, $ret, @args]; + $gutsdocs{$name} = [$flags, $docs, $ret, $file, @args]; } } else { - $docfuncs{$name} = [$flags, $docs, $ret, @args]; + $docfuncs{$name} = [$flags, $docs, $ret, $file, @args]; } - if ($doc =~ /^=for/) { - $in = $doc; - redo FUNC; + if (defined $doc) { + if ($doc =~ /^=for/) { + $in = $doc; + redo FUNC; + } + } else { + warn "$file:$line:$in"; } } } @@ -1116,8 +1128,10 @@ DOC: sub docout ($$$) { # output the docs for one function my($fh, $name, $docref) = @_; - my($flags, $docs, $ret, @args) = @$docref; + my($flags, $docs, $ret, $file, @args) = @$docref; + $docs .= "NOTE: this function is experimental and may change or be +removed without notice.\n\n" if $flags =~ /x/; $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" if $flags =~ /p/; @@ -1134,12 +1148,13 @@ sub docout ($$$) { # output the docs for one function print $fh "(" . join(", ", @args) . ")"; print $fh "\n\n"; } + print $fh "=for hackers\nFound in file $file\n\n"; } my $file; for $file (glob('*.c'), glob('*.h')) { open F, "< $file" or die "Cannot open $file for docs: $!\n"; - autodoc(\*F); + autodoc(\*F,$file); close F or die "Error closing $file: $!\n"; } @@ -1156,16 +1171,21 @@ walk_table { # load documented functions into approriate hash if ($flags =~ /A/) { my $docref = delete $docfuncs{$func}; warn "no docs for $func\n" unless $docref and @$docref; - $apidocs{$func} = [$docref->[0] . 'A', $docref->[1], $retval, @args]; + $docref->[0].="x" if $flags =~ /M/; + $apidocs{$func} = [$docref->[0] . 'A', $docref->[1], $retval, + $docref->[3], @args]; } else { my $docref = delete $docfuncs{$func}; - $gutsdocs{$func} = [$docref->[0], $docref->[1], $retval, @args]; + $gutsdocs{$func} = [$docref->[0], $docref->[1], $retval, + $docref->[3], @args]; } } return ""; } \*DOC; for (sort keys %docfuncs) { + # Have you used a full for apidoc or just a func name? + # Have you used Ap instead of Am in the for apidoc? warn "Unable to place $_!\n"; } @@ -1285,6 +1305,7 @@ __END__ : o has no compatibility macro (#define foo Perl_foo) : j not a member of CPerlObj : x not exported +: M may change : : Individual flags may be separated by whitespace. : @@ -1358,6 +1379,7 @@ Ap |bool |Gv_AMupdate |HV* stash p |OP* |append_elem |I32 optype|OP* head|OP* tail p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp +Ap |void |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len Ap |SV* |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash Ap |bool |avhv_exists_ent|AV *ar|SV* keysv|U32 hash Ap |SV** |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash @@ -1366,17 +1388,17 @@ Ap |HE* |avhv_iternext |AV *ar Ap |SV* |avhv_iterval |AV *ar|HE* entry Ap |HV* |avhv_keys |AV *ar Apd |void |av_clear |AV* ar -Ap |SV* |av_delete |AV* ar|I32 key|I32 flags -Ap |bool |av_exists |AV* ar|I32 key +Apd |SV* |av_delete |AV* ar|I32 key|I32 flags +Apd |bool |av_exists |AV* ar|I32 key Apd |void |av_extend |AV* ar|I32 key -Ap |AV* |av_fake |I32 size|SV** svp +p |AV* |av_fake |I32 size|SV** svp Apd |SV** |av_fetch |AV* ar|I32 key|I32 lval -Ap |void |av_fill |AV* ar|I32 fill +Apd |void |av_fill |AV* ar|I32 fill Apd |I32 |av_len |AV* ar Apd |AV* |av_make |I32 size|SV** svp Apd |SV* |av_pop |AV* ar Apd |void |av_push |AV* ar|SV* val -Ap |void |av_reify |AV* ar +p |void |av_reify |AV* ar Apd |SV* |av_shift |AV* ar Apd |SV** |av_store |AV* ar|I32 key|SV* val Apd |void |av_undef |AV* ar @@ -1511,7 +1533,7 @@ Ap |char* |vform |const char* pat|va_list* args Ap |void |free_tmps p |OP* |gen_constant_list|OP* o #if !defined(HAS_GETENV_LEN) -p |char* |getenv_len |char* key|unsigned long *len +p |char* |getenv_len |const char* key|unsigned long *len #endif Ap |void |gp_free |GV* gv Ap |GP* |gp_ref |GP* gp @@ -1523,6 +1545,7 @@ Ap |GV* |gv_autoload4 |HV* stash|const char* name|STRLEN len \ Ap |void |gv_check |HV* stash Ap |void |gv_efullname |SV* sv|GV* gv Ap |void |gv_efullname3 |SV* sv|GV* gv|const char* prefix +Ap |void |gv_efullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain Ap |GV* |gv_fetchfile |const char* name Apd |GV* |gv_fetchmeth |HV* stash|const char* name|STRLEN len \ |I32 level @@ -1532,6 +1555,7 @@ Apd |GV* |gv_fetchmethod_autoload|HV* stash|const char* name \ Ap |GV* |gv_fetchpv |const char* name|I32 add|I32 sv_type Ap |void |gv_fullname |SV* sv|GV* gv Ap |void |gv_fullname3 |SV* sv|GV* gv|const char* prefix +Ap |void |gv_fullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain Ap |void |gv_init |GV* gv|HV* stash|const char* name \ |STRLEN len|int multi Apd |HV* |gv_stashpv |const char* name|I32 create @@ -1567,6 +1591,7 @@ p |U32 |intro_my Ap |char* |instr |const char* big|const char* little p |bool |io_close |IO* io|bool not_implicit p |OP* |invert |OP* cmd +dp |bool |is_gv_magical |char *name|STRLEN len|U32 flags Ap |bool |is_uni_alnum |U32 c Ap |bool |is_uni_alnumc |U32 c Ap |bool |is_uni_idfirst |U32 c @@ -1602,6 +1627,7 @@ Ap |U32 |to_uni_upper_lc|U32 c Ap |U32 |to_uni_title_lc|U32 c Ap |U32 |to_uni_lower_lc|U32 c Ap |int |is_utf8_char |U8 *p +Ap |bool |is_utf8_string |U8 *s|STRLEN len Ap |bool |is_utf8_alnum |U8 *p Ap |bool |is_utf8_alnumc |U8 *p Ap |bool |is_utf8_idfirst|U8 *p @@ -1885,6 +1911,7 @@ Ap |void |save_freesv |SV* sv p |void |save_freeop |OP* o Ap |void |save_freepv |char* pv Ap |void |save_generic_svref|SV** sptr +Ap |void |save_generic_pvref|char** str Ap |void |save_gp |GV* gv|I32 empty Ap |HV* |save_hash |GV* gv Ap |void |save_helem |HV* hv|SV *key|SV **sptr @@ -1945,7 +1972,7 @@ Ap |NV |sv_nv |SV* sv Ap |char* |sv_pvn |SV *sv|STRLEN *len Ap |char* |sv_pvutf8n |SV *sv|STRLEN *len Ap |char* |sv_pvbyten |SV *sv|STRLEN *len -Ap |I32 |sv_true |SV *sv +Apd |I32 |sv_true |SV *sv p |void |sv_add_arena |char* ptr|U32 size|U32 flags Ap |int |sv_backoff |SV* sv Apd |SV* |sv_bless |SV* sv|HV* stash @@ -1957,9 +1984,9 @@ Apd |void |sv_catsv |SV* dsv|SV* ssv Apd |void |sv_chop |SV* sv|char* ptr p |void |sv_clean_all p |void |sv_clean_objs -Ap |void |sv_clear |SV* sv +Apd |void |sv_clear |SV* sv Apd |I32 |sv_cmp |SV* sv1|SV* sv2 -Ap |I32 |sv_cmp_locale |SV* sv1|SV* sv2 +Apd |I32 |sv_cmp_locale |SV* sv1|SV* sv2 #if defined(USE_LOCALE_COLLATE) Ap |char* |sv_collxfrm |SV* sv|STRLEN* nxp #endif @@ -1968,9 +1995,9 @@ Apd |void |sv_dec |SV* sv Ap |void |sv_dump |SV* sv Apd |bool |sv_derived_from|SV* sv|const char* name Apd |I32 |sv_eq |SV* sv1|SV* sv2 -Ap |void |sv_free |SV* sv +Apd |void |sv_free |SV* sv p |void |sv_free_arenas -Ap |char* |sv_gets |SV* sv|PerlIO* fp|I32 append +Apd |char* |sv_gets |SV* sv|PerlIO* fp|I32 append Apd |char* |sv_grow |SV* sv|STRLEN newlen Apd |void |sv_inc |SV* sv Apd |void |sv_insert |SV* bigsv|STRLEN offset|STRLEN len \ @@ -1978,7 +2005,7 @@ Apd |void |sv_insert |SV* bigsv|STRLEN offset|STRLEN len \ Apd |int |sv_isa |SV* sv|const char* name Apd |int |sv_isobject |SV* sv Apd |STRLEN |sv_len |SV* sv -Ap |STRLEN |sv_len_utf8 |SV* sv +Apd |STRLEN |sv_len_utf8 |SV* sv Apd |void |sv_magic |SV* sv|SV* obj|int how|const char* name \ |I32 namlen Apd |SV* |sv_mortalcopy |SV* oldsv @@ -1987,11 +2014,11 @@ Ap |SV* |sv_newref |SV* sv Ap |char* |sv_peek |SV* sv Ap |void |sv_pos_u2b |SV* sv|I32* offsetp|I32* lenp Ap |void |sv_pos_b2u |SV* sv|I32* offsetp -Ap |char* |sv_pvn_force |SV* sv|STRLEN* lp -Ap |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp +Apd |char* |sv_pvn_force |SV* sv|STRLEN* lp +Apd |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp Ap |char* |sv_pvbyten_force|SV* sv|STRLEN* lp -Ap |char* |sv_reftype |SV* sv|int ob -Ap |void |sv_replace |SV* sv|SV* nsv +Apd |char* |sv_reftype |SV* sv|int ob +Apd |void |sv_replace |SV* sv|SV* nsv Ap |void |sv_report_used Ap |void |sv_reset |char* s|HV* stash Afpd |void |sv_setpvf |SV* sv|const char* pat|... @@ -2010,7 +2037,7 @@ Apd |void |sv_setpvn |SV* sv|const char* ptr|STRLEN len Apd |void |sv_setsv |SV* dsv|SV* ssv Ap |void |sv_taint |SV* sv Ap |bool |sv_tainted |SV* sv -Ap |int |sv_unmagic |SV* sv|int type +Apd |int |sv_unmagic |SV* sv|int type Apd |void |sv_unref |SV* sv Ap |void |sv_untaint |SV* sv Apd |bool |sv_upgrade |SV* sv|U32 mt @@ -2039,10 +2066,12 @@ Ap |void |unlock_condpair|void* svv Ap |void |unsharepvn |const char* sv|I32 len|U32 hash p |void |unshare_hek |HEK* hek p |void |utilize |int aver|I32 floor|OP* version|OP* id|OP* arg -Ap |U8* |utf16_to_utf8 |U16* p|U8 *d|I32 bytelen -Ap |U8* |utf16_to_utf8_reversed|U16* p|U8 *d|I32 bytelen +Ap |U8* |utf16_to_utf8 |U8* p|U8 *d|I32 bytelen|I32 *newlen +Ap |U8* |utf16_to_utf8_reversed|U8* p|U8 *d|I32 bytelen|I32 *newlen Ap |I32 |utf8_distance |U8 *a|U8 *b Ap |U8* |utf8_hop |U8 *s|I32 off +ApM |U8* |utf8_to_bytes |U8 *s|STRLEN len +ApM |U8* |bytes_to_utf8 |U8 *s|STRLEN *len Ap |UV |utf8_to_uv |U8 *s|I32* retlen Ap |U8* |uv_to_utf8 |U8 *d|UV uv p |void |vivify_defelem |SV* sv @@ -2083,6 +2112,9 @@ Ap |struct perl_vars *|GetVars #endif Ap |int |runops_standard Ap |int |runops_debug +#if defined(USE_THREADS) +Ap |SV* |sv_lock |SV *sv +#endif Afpd |void |sv_catpvf_mg |SV *sv|const char* pat|... Ap |void |sv_vcatpvf_mg |SV* sv|const char* pat|va_list* args Apd |void |sv_catpv_mg |SV *sv|const char *ptr @@ -2127,13 +2159,13 @@ Ap |char* |sv_2pvbyte_nolen|SV* sv Ap |char* |sv_pv |SV *sv Ap |char* |sv_pvutf8 |SV *sv Ap |char* |sv_pvbyte |SV *sv -Ap |void |sv_utf8_upgrade|SV *sv -Ap |bool |sv_utf8_downgrade|SV *sv|bool fail_ok -Ap |void |sv_utf8_encode |SV *sv +Apd |void |sv_utf8_upgrade|SV *sv +ApdM |bool |sv_utf8_downgrade|SV *sv|bool fail_ok +ApdM |void |sv_utf8_encode |SV *sv Ap |bool |sv_utf8_decode |SV *sv Ap |void |sv_force_normal|SV *sv Ap |void |tmps_grow |I32 n -Ap |SV* |sv_rvweaken |SV *sv +Apd |SV* |sv_rvweaken |SV *sv p |int |magic_killbackrefs|SV *sv|MAGIC *mg Ap |OP* |newANONATTRSUB |I32 floor|OP *proto|OP *attrs|OP *block Ap |CV* |newATTRSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block @@ -2162,6 +2194,7 @@ Ap |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv Ap |void |ptr_table_split|PTR_TBL_t *tbl #endif #if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_clear Ap |void |sys_intern_init #endif @@ -2177,16 +2210,12 @@ s |I32 |avhv_index |AV* av|SV* sv|U32 hash #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -s |I32 |do_trans_CC_simple |SV *sv -s |I32 |do_trans_CC_count |SV *sv -s |I32 |do_trans_CC_complex |SV *sv -s |I32 |do_trans_UU_simple |SV *sv -s |I32 |do_trans_UU_count |SV *sv -s |I32 |do_trans_UU_complex |SV *sv -s |I32 |do_trans_UC_simple |SV *sv -s |I32 |do_trans_CU_simple |SV *sv -s |I32 |do_trans_UC_trivial |SV *sv -s |I32 |do_trans_CU_trivial |SV *sv +s |I32 |do_trans_simple |SV *sv +s |I32 |do_trans_count |SV *sv +s |I32 |do_trans_complex |SV *sv +s |I32 |do_trans_simple_utf8 |SV *sv +s |I32 |do_trans_count_utf8 |SV *sv +s |I32 |do_trans_complex_utf8 |SV *sv #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) @@ -2451,6 +2480,7 @@ s |char* |scan_trans |char *start s |char* |scan_word |char *s|char *dest|STRLEN destlen \ |int allow_package|STRLEN *slp s |char* |skipspace |char *s +s |char* |swallow_bom |U8 *s s |void |checkcomma |char *s|char *name|char *what s |void |force_ident |char *s|int kind s |void |incline |char *s @@ -2464,6 +2494,7 @@ s |I32 |sublex_done s |I32 |sublex_push s |I32 |sublex_start s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append +s |HV * |find_in_my_stash|char *pkgname|I32 len s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ |SV *pv|const char *type s |int |ao |int toketype diff --git a/embedvar.h b/embedvar.h index 889b4d44f2..10339b27e1 100644 --- a/embedvar.h +++ b/embedvar.h @@ -246,6 +246,7 @@ #define PL_exitlistlen (PERL_GET_INTERP->Iexitlistlen) #define PL_expect (PERL_GET_INTERP->Iexpect) #define PL_fdpid (PERL_GET_INTERP->Ifdpid) +#define PL_fdpid_mutex (PERL_GET_INTERP->Ifdpid_mutex) #define PL_filemode (PERL_GET_INTERP->Ifilemode) #define PL_forkprocess (PERL_GET_INTERP->Iforkprocess) #define PL_formfeed (PERL_GET_INTERP->Iformfeed) @@ -254,6 +255,7 @@ #define PL_gid (PERL_GET_INTERP->Igid) #define PL_glob_index (PERL_GET_INTERP->Iglob_index) #define PL_globalstash (PERL_GET_INTERP->Iglobalstash) +#define PL_he_arenaroot (PERL_GET_INTERP->Ihe_arenaroot) #define PL_he_root (PERL_GET_INTERP->Ihe_root) #define PL_hintgv (PERL_GET_INTERP->Ihintgv) #define PL_hints (PERL_GET_INTERP->Ihints) @@ -377,6 +379,7 @@ #define PL_subname (PERL_GET_INTERP->Isubname) #define PL_sv_arenaroot (PERL_GET_INTERP->Isv_arenaroot) #define PL_sv_count (PERL_GET_INTERP->Isv_count) +#define PL_sv_lock_mutex (PERL_GET_INTERP->Isv_lock_mutex) #define PL_sv_mutex (PERL_GET_INTERP->Isv_mutex) #define PL_sv_no (PERL_GET_INTERP->Isv_no) #define PL_sv_objcount (PERL_GET_INTERP->Isv_objcount) @@ -415,16 +418,27 @@ #define PL_widesyscalls (PERL_GET_INTERP->Iwidesyscalls) #define PL_xiv_arenaroot (PERL_GET_INTERP->Ixiv_arenaroot) #define PL_xiv_root (PERL_GET_INTERP->Ixiv_root) +#define PL_xnv_arenaroot (PERL_GET_INTERP->Ixnv_arenaroot) #define PL_xnv_root (PERL_GET_INTERP->Ixnv_root) +#define PL_xpv_arenaroot (PERL_GET_INTERP->Ixpv_arenaroot) #define PL_xpv_root (PERL_GET_INTERP->Ixpv_root) +#define PL_xpvav_arenaroot (PERL_GET_INTERP->Ixpvav_arenaroot) #define PL_xpvav_root (PERL_GET_INTERP->Ixpvav_root) +#define PL_xpvbm_arenaroot (PERL_GET_INTERP->Ixpvbm_arenaroot) #define PL_xpvbm_root (PERL_GET_INTERP->Ixpvbm_root) +#define PL_xpvcv_arenaroot (PERL_GET_INTERP->Ixpvcv_arenaroot) #define PL_xpvcv_root (PERL_GET_INTERP->Ixpvcv_root) +#define PL_xpvhv_arenaroot (PERL_GET_INTERP->Ixpvhv_arenaroot) #define PL_xpvhv_root (PERL_GET_INTERP->Ixpvhv_root) +#define PL_xpviv_arenaroot (PERL_GET_INTERP->Ixpviv_arenaroot) #define PL_xpviv_root (PERL_GET_INTERP->Ixpviv_root) +#define PL_xpvlv_arenaroot (PERL_GET_INTERP->Ixpvlv_arenaroot) #define PL_xpvlv_root (PERL_GET_INTERP->Ixpvlv_root) +#define PL_xpvmg_arenaroot (PERL_GET_INTERP->Ixpvmg_arenaroot) #define PL_xpvmg_root (PERL_GET_INTERP->Ixpvmg_root) +#define PL_xpvnv_arenaroot (PERL_GET_INTERP->Ixpvnv_arenaroot) #define PL_xpvnv_root (PERL_GET_INTERP->Ixpvnv_root) +#define PL_xrv_arenaroot (PERL_GET_INTERP->Ixrv_arenaroot) #define PL_xrv_root (PERL_GET_INTERP->Ixrv_root) #define PL_yychar (PERL_GET_INTERP->Iyychar) #define PL_yydebug (PERL_GET_INTERP->Iyydebug) @@ -511,6 +525,7 @@ #define PL_exitlistlen (vTHX->Iexitlistlen) #define PL_expect (vTHX->Iexpect) #define PL_fdpid (vTHX->Ifdpid) +#define PL_fdpid_mutex (vTHX->Ifdpid_mutex) #define PL_filemode (vTHX->Ifilemode) #define PL_forkprocess (vTHX->Iforkprocess) #define PL_formfeed (vTHX->Iformfeed) @@ -519,6 +534,7 @@ #define PL_gid (vTHX->Igid) #define PL_glob_index (vTHX->Iglob_index) #define PL_globalstash (vTHX->Iglobalstash) +#define PL_he_arenaroot (vTHX->Ihe_arenaroot) #define PL_he_root (vTHX->Ihe_root) #define PL_hintgv (vTHX->Ihintgv) #define PL_hints (vTHX->Ihints) @@ -642,6 +658,7 @@ #define PL_subname (vTHX->Isubname) #define PL_sv_arenaroot (vTHX->Isv_arenaroot) #define PL_sv_count (vTHX->Isv_count) +#define PL_sv_lock_mutex (vTHX->Isv_lock_mutex) #define PL_sv_mutex (vTHX->Isv_mutex) #define PL_sv_no (vTHX->Isv_no) #define PL_sv_objcount (vTHX->Isv_objcount) @@ -680,16 +697,27 @@ #define PL_widesyscalls (vTHX->Iwidesyscalls) #define PL_xiv_arenaroot (vTHX->Ixiv_arenaroot) #define PL_xiv_root (vTHX->Ixiv_root) +#define PL_xnv_arenaroot (vTHX->Ixnv_arenaroot) #define PL_xnv_root (vTHX->Ixnv_root) +#define PL_xpv_arenaroot (vTHX->Ixpv_arenaroot) #define PL_xpv_root (vTHX->Ixpv_root) +#define PL_xpvav_arenaroot (vTHX->Ixpvav_arenaroot) #define PL_xpvav_root (vTHX->Ixpvav_root) +#define PL_xpvbm_arenaroot (vTHX->Ixpvbm_arenaroot) #define PL_xpvbm_root (vTHX->Ixpvbm_root) +#define PL_xpvcv_arenaroot (vTHX->Ixpvcv_arenaroot) #define PL_xpvcv_root (vTHX->Ixpvcv_root) +#define PL_xpvhv_arenaroot (vTHX->Ixpvhv_arenaroot) #define PL_xpvhv_root (vTHX->Ixpvhv_root) +#define PL_xpviv_arenaroot (vTHX->Ixpviv_arenaroot) #define PL_xpviv_root (vTHX->Ixpviv_root) +#define PL_xpvlv_arenaroot (vTHX->Ixpvlv_arenaroot) #define PL_xpvlv_root (vTHX->Ixpvlv_root) +#define PL_xpvmg_arenaroot (vTHX->Ixpvmg_arenaroot) #define PL_xpvmg_root (vTHX->Ixpvmg_root) +#define PL_xpvnv_arenaroot (vTHX->Ixpvnv_arenaroot) #define PL_xpvnv_root (vTHX->Ixpvnv_root) +#define PL_xrv_arenaroot (vTHX->Ixrv_arenaroot) #define PL_xrv_root (vTHX->Ixrv_root) #define PL_yychar (vTHX->Iyychar) #define PL_yydebug (vTHX->Iyydebug) @@ -913,6 +941,7 @@ #define PL_exitlistlen (aTHXo->interp.Iexitlistlen) #define PL_expect (aTHXo->interp.Iexpect) #define PL_fdpid (aTHXo->interp.Ifdpid) +#define PL_fdpid_mutex (aTHXo->interp.Ifdpid_mutex) #define PL_filemode (aTHXo->interp.Ifilemode) #define PL_forkprocess (aTHXo->interp.Iforkprocess) #define PL_formfeed (aTHXo->interp.Iformfeed) @@ -921,6 +950,7 @@ #define PL_gid (aTHXo->interp.Igid) #define PL_glob_index (aTHXo->interp.Iglob_index) #define PL_globalstash (aTHXo->interp.Iglobalstash) +#define PL_he_arenaroot (aTHXo->interp.Ihe_arenaroot) #define PL_he_root (aTHXo->interp.Ihe_root) #define PL_hintgv (aTHXo->interp.Ihintgv) #define PL_hints (aTHXo->interp.Ihints) @@ -1044,6 +1074,7 @@ #define PL_subname (aTHXo->interp.Isubname) #define PL_sv_arenaroot (aTHXo->interp.Isv_arenaroot) #define PL_sv_count (aTHXo->interp.Isv_count) +#define PL_sv_lock_mutex (aTHXo->interp.Isv_lock_mutex) #define PL_sv_mutex (aTHXo->interp.Isv_mutex) #define PL_sv_no (aTHXo->interp.Isv_no) #define PL_sv_objcount (aTHXo->interp.Isv_objcount) @@ -1082,16 +1113,27 @@ #define PL_widesyscalls (aTHXo->interp.Iwidesyscalls) #define PL_xiv_arenaroot (aTHXo->interp.Ixiv_arenaroot) #define PL_xiv_root (aTHXo->interp.Ixiv_root) +#define PL_xnv_arenaroot (aTHXo->interp.Ixnv_arenaroot) #define PL_xnv_root (aTHXo->interp.Ixnv_root) +#define PL_xpv_arenaroot (aTHXo->interp.Ixpv_arenaroot) #define PL_xpv_root (aTHXo->interp.Ixpv_root) +#define PL_xpvav_arenaroot (aTHXo->interp.Ixpvav_arenaroot) #define PL_xpvav_root (aTHXo->interp.Ixpvav_root) +#define PL_xpvbm_arenaroot (aTHXo->interp.Ixpvbm_arenaroot) #define PL_xpvbm_root (aTHXo->interp.Ixpvbm_root) +#define PL_xpvcv_arenaroot (aTHXo->interp.Ixpvcv_arenaroot) #define PL_xpvcv_root (aTHXo->interp.Ixpvcv_root) +#define PL_xpvhv_arenaroot (aTHXo->interp.Ixpvhv_arenaroot) #define PL_xpvhv_root (aTHXo->interp.Ixpvhv_root) +#define PL_xpviv_arenaroot (aTHXo->interp.Ixpviv_arenaroot) #define PL_xpviv_root (aTHXo->interp.Ixpviv_root) +#define PL_xpvlv_arenaroot (aTHXo->interp.Ixpvlv_arenaroot) #define PL_xpvlv_root (aTHXo->interp.Ixpvlv_root) +#define PL_xpvmg_arenaroot (aTHXo->interp.Ixpvmg_arenaroot) #define PL_xpvmg_root (aTHXo->interp.Ixpvmg_root) +#define PL_xpvnv_arenaroot (aTHXo->interp.Ixpvnv_arenaroot) #define PL_xpvnv_root (aTHXo->interp.Ixpvnv_root) +#define PL_xrv_arenaroot (aTHXo->interp.Ixrv_arenaroot) #define PL_xrv_root (aTHXo->interp.Ixrv_root) #define PL_yychar (aTHXo->interp.Iyychar) #define PL_yydebug (aTHXo->interp.Iyydebug) @@ -1179,6 +1221,7 @@ #define PL_Iexitlistlen PL_exitlistlen #define PL_Iexpect PL_expect #define PL_Ifdpid PL_fdpid +#define PL_Ifdpid_mutex PL_fdpid_mutex #define PL_Ifilemode PL_filemode #define PL_Iforkprocess PL_forkprocess #define PL_Iformfeed PL_formfeed @@ -1187,6 +1230,7 @@ #define PL_Igid PL_gid #define PL_Iglob_index PL_glob_index #define PL_Iglobalstash PL_globalstash +#define PL_Ihe_arenaroot PL_he_arenaroot #define PL_Ihe_root PL_he_root #define PL_Ihintgv PL_hintgv #define PL_Ihints PL_hints @@ -1310,6 +1354,7 @@ #define PL_Isubname PL_subname #define PL_Isv_arenaroot PL_sv_arenaroot #define PL_Isv_count PL_sv_count +#define PL_Isv_lock_mutex PL_sv_lock_mutex #define PL_Isv_mutex PL_sv_mutex #define PL_Isv_no PL_sv_no #define PL_Isv_objcount PL_sv_objcount @@ -1348,16 +1393,27 @@ #define PL_Iwidesyscalls PL_widesyscalls #define PL_Ixiv_arenaroot PL_xiv_arenaroot #define PL_Ixiv_root PL_xiv_root +#define PL_Ixnv_arenaroot PL_xnv_arenaroot #define PL_Ixnv_root PL_xnv_root +#define PL_Ixpv_arenaroot PL_xpv_arenaroot #define PL_Ixpv_root PL_xpv_root +#define PL_Ixpvav_arenaroot PL_xpvav_arenaroot #define PL_Ixpvav_root PL_xpvav_root +#define PL_Ixpvbm_arenaroot PL_xpvbm_arenaroot #define PL_Ixpvbm_root PL_xpvbm_root +#define PL_Ixpvcv_arenaroot PL_xpvcv_arenaroot #define PL_Ixpvcv_root PL_xpvcv_root +#define PL_Ixpvhv_arenaroot PL_xpvhv_arenaroot #define PL_Ixpvhv_root PL_xpvhv_root +#define PL_Ixpviv_arenaroot PL_xpviv_arenaroot #define PL_Ixpviv_root PL_xpviv_root +#define PL_Ixpvlv_arenaroot PL_xpvlv_arenaroot #define PL_Ixpvlv_root PL_xpvlv_root +#define PL_Ixpvmg_arenaroot PL_xpvmg_arenaroot #define PL_Ixpvmg_root PL_xpvmg_root +#define PL_Ixpvnv_arenaroot PL_xpvnv_arenaroot #define PL_Ixpvnv_root PL_xpvnv_root +#define PL_Ixrv_arenaroot PL_xrv_arenaroot #define PL_Ixrv_root PL_xrv_root #define PL_Iyychar PL_yychar #define PL_Iyydebug PL_yydebug diff --git a/epoc/config.sh b/epoc/config.sh index 714185a1e2..5b37e3a7dd 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -79,7 +79,7 @@ cppsymbols='' crosscompile='define' cryptlib='' csh='csh' -d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_Gconvert='epoc_gcvt((x),(n),(b))' d_PRIEldbl='undef' d_PRIFldbl='undef' d_PRIGldbl='undef' @@ -134,7 +134,6 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' -d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -156,6 +155,7 @@ d_fstatfs='define' d_fstatvfs='undef' d_ftello='undef' d_ftime='undef' +d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' @@ -179,12 +179,12 @@ d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getprpwnam='undef' d_getpwent='undef' d_getsbyname='undef' d_getsbyport='undef' d_getsent='undef' d_getservprotos='define' -d_getspent='undef' d_getspnam='undef' d_gettimeod='define' d_gnulibc='undef' @@ -194,7 +194,7 @@ d_htonl='define' d_iconv='undef' d_index='undef' d_inetaton='define' -d_int64t='undef' +d_int64_t='undef' d_iovec_s='undef' d_isascii='define' d_isnan='define' @@ -305,7 +305,6 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' -d_setspent='undef' d_setvbuf='undef' d_sfio='undef' d_shm='undef' @@ -386,7 +385,7 @@ emacs='' eunicefix=':' exe_ext='' expr='expr' -extensions='Data/Dumper File/Glob IO Socket' +extensions='Data/Dumper File/Glob IO Socket Fcntl' fflushNULL='undef' fflushall='define' find='' @@ -436,6 +435,7 @@ i_neterrno='undef' i_netinettcp='define' i_niin='define' i_poll='undef' +i_prot='undef' i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='undef' @@ -497,7 +497,7 @@ installstyle='' installusrbinperl='undef' installvendorlib='' intsize='4' -known_extensions='Data/Dumper File/Glob IO Socket' +known_extensions='Data/Dumper File/Glob IO Socket Fcntl' ksh='' large='' ld='echo' @@ -645,7 +645,7 @@ sleep='' smail='' small='' so='' -socksizetype='int' +socksizetype='size_t' sockethdr='' socketlib='' sort='sort' @@ -656,7 +656,7 @@ src='.' ssizetype='long' startperl='' startsh='#!/bin/sh' -static_ext='Data/Dumper File/Glob IO Socket' +static_ext='Data/Dumper File/Glob IO Socket Fcntl' stdchar='char' stdio_base='' stdio_bufsiz='' @@ -789,7 +789,164 @@ d_strtold='undef' d_strtoll='undef' d_strtouq='undef' d_nv_preserves_uv='define' +d_nv_preserves_uv_bits='32' +use5005threads='undef' +useithreads='undef' +inc_version_list=' ' +inc_version_list_init='0' +d_madvise='undef' +d_mkdtemp='undef' +d_mkstemp='undef' +d_mkstemps='undef' +d_mmap='undef' +d_mprotect='undef' +d_msync='undef' +d_munmap='undef' +d_qgcvt='undef' +d_socklen_t='undef' +d_vendorarch='' +i_iconv='undef' +i_ieeefp='undef' +i_sunmath='undef' +i_syslog='undef' +i_sysmman='undef' +i_sysutsname='undef' +installvendorarch='' +mmaptype='' +revision='5' +sizesize='4' +socksizetype='int' + +double='undef' +usemorebits='undef' +usemultiplicity='undef' +usemymalloc='n' +usenm='' +useopcode='' +useperlio='undef' +useposix='' +usesfio='' +useshrplib='' +usesocks='undef' +usethreads='undef' +usevendorprefix='' +usevfork='' +usrinc='' +uuname='' +vendorlib='' +vendorlib_stem='' +vendorlibexp='' +vendorprefix='' +vendorprefixexp='' +version='5.6.0' +vi='' +voidflags='15' +xlibpth='' +zcat='' +zip='' +# Configure command line arguments. +config_arg0='' +config_args='' +config_argc=11 +config_arg1='' +config_arg2='' +config_arg3='' +config_arg4='' +config_arg5='' +config_arg6='' +config_arg7='' +config_arg8='' +config_arg9='' +config_arg10='' +config_arg11='' +PERL_REVISION=5 +PERL_VERSION=6 +PERL_SUBVERSION=0 +PERL_API_REVISION=5 +PERL_API_VERSION=6 +PERL_API_SUBVERSION=0 +CONFIGDOTSH=true +# Variables propagated from previous config.sh file. +pp_sys_cflags='' +epocish_cflags='ccflags="$cflags -xc++"' +ivtype='int' +uvtype='unsigned int' +i8type='char' +u8type='unsigned char' +i16type='short' +u16type='unsigned short' +i32type='int' +u32type='unsigned int' +i64type='long long' +u64type='unsigned long long' +d_quad='define' +quadtype='long long' +quadtype='unsigned long long' +quadkind='QUAD_IS_LONG_LONG' +nvtype='double' +ivsize='4' +uvsize='4' +i8size='1' +u8size='1' +i16size='2' +u16size='2' +i32size='4' +u32size='4' +i64size='8' +u64size='8' +d_fs_data_s='undef' +d_fseeko='undef' +d_ldbl_dig='undef' +d_sqrtl='undef' +d_getmnt='undef' +d_statfs_f_flags='undef' +d_statfs_s='undef' +d_ustat='undef' +i_sysstatfs='undef' +i_sysvfs='undef' +i_ustat='undef' +uidsize='2' +uidsign='1' +gidsize='2' +gidsign='1' +ivdformat='"ld"' +uvuformat='"lu"' +uvoformat='"lo"' +uvxformat='"lx"' +uidformat='"hu"' +gidformat='"hu"' +d_strtold='undef' +d_strtoll='undef' +d_strtouq='undef' +d_nv_preserves_uv='define' use5005threads='undef' useithreads='undef' inc_version_list=' ' inc_version_list_init='0' +d_madvise='undef' +d_mkdtemp='undef' +d_mkstemp='undef' +d_mkstemps='undef' +d_mmap='undef' +d_mprotect='undef' +d_msync='undef' +d_munmap='undef' +d_qgcvt='undef' +d_socklen_t='undef' +d_vendorarch='' +i_iconv='undef' +i_ieeefp='undef' +i_sunmath='undef' +i_syslog='undef' +i_sysmman='undef' +i_sysutsname='undef' +installvendorarch='' +mmaptype='' +revision='5' +sizesize='4' +socksizetype='int' +xs_apiversion='5.005' +d_getcwd='define' +i_sysmode='undef' +d_vendorarch='undef' + diff --git a/epoc/createpkg.pl b/epoc/createpkg.pl index 6977bd385f..77dafb1103 100644 --- a/epoc/createpkg.pl +++ b/epoc/createpkg.pl @@ -3,11 +3,11 @@ use File::Find; use Cwd; -$VERSION="5.5"; -$PATCH="650"; -$EPOC_VERSION=19; +$VERSION="5.6"; +$PATCH="0"; +$EPOC_VERSION=20; $CROSSCOMPILEPATH=cwd; -$CROSSREPLACEPATH="H:\\devel\\perl5.5.650"; +$CROSSREPLACEPATH="H:\\perl"; sub filefound { diff --git a/epoc/epocish.c b/epoc/epocish.c index 134eaef0e0..4963a2e5b5 100644 --- a/epoc/epocish.c +++ b/epoc/epocish.c @@ -6,7 +6,7 @@ * */ -/* This is indeed C++ Code !! */ +/* This is C++ Code !! */ #include <e32std.h> @@ -31,4 +31,25 @@ epoc_spawn( char *cmd, char *cmdline) { return 0; } + + /* Workaround for defect atof(), see java defect list for epoc */ + double epoc_atof( const char* str) { + TReal64 aRes; + + TLex lex( _L( str)); + TInt err = lex.Val( aRes, TChar( '.')); + return aRes; + } + + void epoc_gcvt( double x, int digits, unsigned char *buf) { + TRealFormat trel; + + trel.iPlaces = digits; + trel.iPoint = TChar( '.'); + + TPtr result( buf, 80); + + result.Num( x, trel); + result.Append( TChar( 0)); + } } diff --git a/epoc/epocish.h b/epoc/epocish.h index f4be0ff677..75a64fcda0 100644 --- a/epoc/epocish.h +++ b/epoc/epocish.h @@ -121,9 +121,6 @@ /* getsockname returns the size of struct sockaddr_in *without* padding */ #define BOGUS_GETNAME_RETURN 8 -/* Yes, size_t is size_t */ -#define Sock_size_t size_t - /* read() on a socket blocks until buf is filled completly, recv() returns each massage @@ -133,3 +130,13 @@ /* No /dev/random available*/ #define PERL_NO_DEV_RANDOM + +/* + work around for buggy atof(): + atof() in ER5 stdlib depends on locale. +*/ + +double epoc_atof( const char *ptr); +#define atof(a) epoc_atof(a) + + diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm index b9b828f505..f3a8247877 100644 --- a/ext/B/B/Stash.pm +++ b/ext/B/B/Stash.pm @@ -2,6 +2,14 @@ # vishalb@hotmail.com package B::Stash; +=pod + +=head1 NAME + +B::Stash - show what stashes are loaded + +=cut + BEGIN { %Seen = %INC } CHECK { diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL index cac6578bb3..041416029a 100644 --- a/ext/DB_File/Makefile.PL +++ b/ext/DB_File/Makefile.PL @@ -17,6 +17,7 @@ WriteMakefile( OBJECT => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)', XSPROTOARG => '-noprototypes', DEFINE => $OS2 || "", + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); sub MY::postamble { diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs index bb606f42ca..d3cf292e9e 100644 --- a/ext/Data/Dumper/Dumper.xs +++ b/ext/Data/Dumper/Dumper.xs @@ -584,7 +584,10 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, if (SvIOK(val)) { STRLEN len; - (void) sprintf(tmpbuf, "%"IVdf, SvIV(val)); + if (SvIsUV(val)) + (void) sprintf(tmpbuf, "%"UVuf, SvUV(val)); + else + (void) sprintf(tmpbuf, "%"IVdf, SvIV(val)); len = strlen(tmpbuf); sv_catpvn(retval, tmpbuf, len); } diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs index 31e984f929..7167a0028f 100644 --- a/ext/Devel/DProf/DProf.xs +++ b/ext/Devel/DProf/DProf.xs @@ -502,7 +502,7 @@ prof_record(pTHX) static void check_depth(pTHX_ void *foo) { - U32 need_depth = (U32)foo; + U32 need_depth = PTR2UV(foo); if (need_depth != g_depth) { if (need_depth > g_depth) { warn("garbled call depth when profiling"); diff --git a/ext/Devel/Peek/Peek.pm b/ext/Devel/Peek/Peek.pm index 080251bb5e..101adcd00f 100644 --- a/ext/Devel/Peek/Peek.pm +++ b/ext/Devel/Peek/Peek.pm @@ -58,11 +58,11 @@ C<CV>. Devel::Peek also supplies C<SvREFCNT()>, C<SvREFCNT_inc()>, and C<SvREFCNT_dec()> which can query, increment, and decrement reference counts on SVs. This document will take a passive, and safe, approach to data debugging and for that it will describe only the C<Dump()> -function. For format of output of mstats() see +function. For more information on the format of output of mstat() see L<perldebug/Using C<$ENV{PERL_DEBUG_MSTATS}>>. Function C<DumpArray()> allows dumping of multiple values (useful when you -need to analize returns of functions). +need to analyze returns of functions). The global variable $Devel::Peek::pv_limit can be set to limit the number of character printed in various string values. Setting it to 0 diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 55b8eca727..b7b45d8372 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -21,7 +21,7 @@ package DynaLoader; # feast like to keep their secret; for wonder makes the words of # praise louder.' -# (Quote from Tolkien sugested by Anno Siegel.) +# (Quote from Tolkien suggested by Anno Siegel.) # # See pod text at end of file for documentation. # See also ext/DynaLoader/README in source tree for other information. @@ -170,8 +170,8 @@ sub bootstrap { print STDERR "DynaLoader::bootstrap for $module ", ($Is_MacOS - ? "(auto/$modpname/$modfname.$dl_dlext)\n" : - "(:auto:$modpname:$modfname.$dl_dlext)\n") + ? "(:auto:$modpname:$modfname.$dl_dlext)\n" : + "(auto/$modpname/$modfname.$dl_dlext)\n") if $dl_debug; foreach (@INC) { diff --git a/ext/DynaLoader/dl_mac.xs b/ext/DynaLoader/dl_mac.xs new file mode 100644 index 0000000000..136e6d58c3 --- /dev/null +++ b/ext/DynaLoader/dl_mac.xs @@ -0,0 +1,137 @@ +/* dl_mac.xs + * + * Platform: Macintosh CFM + * Author: Matthias Neeracher <neeri@iis.ee.ethz.ch> + * Adapted from dl_dlopen.xs reference implementation by + * Paul Marquess (pmarquess@bfsec.bt.co.uk) + * $Log: dl_mac.xs,v $ + * Revision 1.3 1998/04/07 01:47:24 neeri + * MacPerl 5.2.0r4b1 + * + * Revision 1.2 1997/08/08 16:39:18 neeri + * MacPerl 5.1.4b1 + time() fix + * + * Revision 1.1 1997/04/07 20:48:23 neeri + * Synchronized with MacPerl 5.1.4a1 + * + */ + +#define MAC_CONTEXT +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include <CodeFragments.h> + + +#include "dlutils.c" /* SaveError() etc */ + +typedef CFragConnectionID ConnectionID; + +static ConnectionID ** connections; + +static void terminate(void) +{ + int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID); + HLock((Handle) connections); + while (size) + CloseConnection(*connections + --size); + DisposeHandle((Handle) connections); + connections = nil; +} + +static void +dl_private_init(pTHX) +{ + (void)dl_generic_private_init(aTHX); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(aTHX); + + +ConnectionID +dl_load_file(filename, flags=0) + char * filename + int flags + PREINIT: + OSErr err; + FSSpec spec; + ConnectionID connID; + Ptr mainAddr; + Str255 errName; + CODE: + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + err = GUSIPath2FSp(filename, &spec); + if (!err) + err = + GetDiskFragment( + &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName); + if (!err) { + if (!connections) { + connections = (ConnectionID **)NewHandle(0); + atexit(terminate); + } + PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID)); + RETVAL = connID; + } else + RETVAL = (ConnectionID) 0; + DLDEBUG(2,fprintf(stderr," libref=%d\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (err) + SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ; + else + sv_setiv( ST(0), (IV)RETVAL); + +void * +dl_find_symbol(connID, symbol) + ConnectionID connID + Str255 symbol + CODE: + { + OSErr err; + Ptr symAddr; + CFragSymbolClass symClass; + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%#s)\n", + connID, symbol)); + err = FindSymbol(connID, symbol, &symAddr, &symClass); + if (err) + symAddr = (Ptr) 0; + RETVAL = (void *) symAddr; + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (err) + SaveError(aTHX_ "DynaLoader error [%d]!", err) ; + else + sv_setiv( ST(0), (IV)RETVAL); + } + +void +dl_undef_symbols() + PPCODE: + + + +# These functions should not need changing on any platform: + +void +dl_install_xsub(perl_name, symref, filename="$Package") + char * perl_name + void * symref + char * filename + CODE: + DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/DynaLoader/hints/netbsd.pl b/ext/DynaLoader/hints/netbsd.pl new file mode 100644 index 0000000000..a0fbaf7d89 --- /dev/null +++ b/ext/DynaLoader/hints/netbsd.pl @@ -0,0 +1,3 @@ +# XXX Configure test needed? +# Some NetBSDs seem to have a dlopen() that won't accept relative paths +$self->{CCFLAGS} = $Config{ccflags} . ' -DDLOPEN_WONT_DO_RELATIVE_PATHS'; diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm index 98ee34d57d..57bfa0d1c1 100644 --- a/ext/File/Glob/Glob.pm +++ b/ext/File/Glob/Glob.pm @@ -138,6 +138,9 @@ sub csh_glob { $pat = $_ unless defined $pat; # extract patterns + $pat =~ s/^\s+//; # Protect against empty elements in + $pat =~ s/\s+$//; # things like < *.c> and <*.c >. + # These alone shouldn't trigger ParseWords. if ($pat =~ /\s/) { # XXX this is needed for compatibility with the csh # implementation in Perl. Need to support a flag diff --git a/ext/IPC/SysV/Makefile.PL b/ext/IPC/SysV/Makefile.PL index 60dd74d9a9..f994950d19 100644 --- a/ext/IPC/SysV/Makefile.PL +++ b/ext/IPC/SysV/Makefile.PL @@ -31,7 +31,7 @@ WriteMakefile( 'clean' => {FILES => join(" ", map { "$_ */$_ */*/$_" } - qw(*% *.html *.b[ac]k *.old *.orig)) + qw(*% *.html *.b[ac]k *.old)) }, 'macro' => { INSTALLDIRS => 'perl' }, ); diff --git a/ext/NDBM_File/Makefile.PL b/ext/NDBM_File/Makefile.PL index 6ceab55a4a..7b586017d7 100644 --- a/ext/NDBM_File/Makefile.PL +++ b/ext/NDBM_File/Makefile.PL @@ -5,4 +5,5 @@ WriteMakefile( MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'NDBM_File.pm', + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 581cbc94d9..e191ec7c9c 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -250,7 +250,7 @@ PPCODE: save_aptr(&PL_endav); PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ - save_hptr(&PL_defstash); /* save current default stack */ + save_hptr(&PL_defstash); /* save current default stash */ /* the assignment to global defstash changes our sense of 'main' */ PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */ save_hptr(&PL_curstash); @@ -263,6 +263,10 @@ PPCODE: sv_free((SV*)GvHV(gv)); GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); + /* %INC must be clean for use/require in compartment */ + save_hash(PL_incgv); + GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpv("INC",TRUE,SVt_PVHV)))); + PUSHMARK(SP); perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ SPAGAIN; /* for the PUTBACK added by xsubpp */ diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 9416f70809..252e5bbad1 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -565,9 +565,9 @@ sub chmod { sub fstat { usage "fstat(fd)" if @_ != 1; local *TMP; - open(TMP, "<&$_[0]"); # Gross. + CORE::open(TMP, "<&$_[0]"); # Gross. my @l = CORE::stat(TMP); - close(TMP); + CORE::close(TMP); @l; } @@ -893,7 +893,7 @@ sub load_imports { difftime mktime strftime tzset tzname)], unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET - STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK + STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod index 08300e4337..314147cb2b 100644 --- a/ext/POSIX/POSIX.pod +++ b/ext/POSIX/POSIX.pod @@ -65,15 +65,19 @@ all. This could be construed to be a bug. =item _exit -This is identical to the C function C<_exit()>. +This is identical to the C function C<_exit()>. It exits the program +immediately which means among other things buffered I/O is B<not> flushed. =item abort -This is identical to the C function C<abort()>. +This is identical to the C function C<abort()>. It terminates the +process with a C<SIGABRT> signal unless caught by a signal handler or +if the handler does not return normally (it e.g. does a C<longjmp>). =item abs -This is identical to Perl's builtin C<abs()> function. +This is identical to Perl's builtin C<abs()> function, returning +the absolute value of its numerical argument. =item access @@ -83,83 +87,117 @@ Determines the accessibility of a file. print "have read permission\n"; } -Returns C<undef> on failure. +Returns C<undef> on failure. Note: do not use C<access()> for +security purposes. Between the C<access()> call and the operation +you are preparing for the permissions might change: a classic +I<race condition>. =item acos -This is identical to the C function C<acos()>. +This is identical to the C function C<acos()>, returning +the arcus cosine of its numerical argument. See also L<Math::Trig>. =item alarm -This is identical to Perl's builtin C<alarm()> function. +This is identical to Perl's builtin C<alarm()> function, +either for arming or disarming the C<SIGARLM> timer. =item asctime -This is identical to the C function C<asctime()>. +This is identical to the C function C<asctime()>. It returns +a string of the form + + "Fri Jun 2 18:22:13 2000\n\0" + +and it is called thusly + + $asctime = asctime($sec, $min, $hour, $mday, $mon, $year, + $wday, $yday, $isdst); + +The C<$mon> is zero-based: January equals C<0>. The C<$year> is +1900-based: 2001 equals C<101>. The C<$wday>, C<$yday>, and C<$isdst> +default to zero (and the first two are usually ignored anyway). =item asin -This is identical to the C function C<asin()>. +This is identical to the C function C<asin()>, returning +the arcus sine of its numerical argument. See also L<Math::Trig>. =item assert -Unimplemented. +Unimplemented, but you can use L<perlfunc/die> and the L<Carp> module +to achieve similar things. =item atan -This is identical to the C function C<atan()>. +This is identical to the C function C<atan()>, returning the +arcus tangent of its numerical argument. See also L<Math::Trig>. =item atan2 -This is identical to Perl's builtin C<atan2()> function. +This is identical to Perl's builtin C<atan2()> function, returning +the arcus tangent defined by its two numerical arguments, the I<y> +coordinate and the I<x> coordinate. See also L<Math::Trig>. =item atexit -atexit() is C-specific: use END {} instead. +atexit() is C-specific: use C<END {}> instead, see L<perlsub>. =item atof -atof() is C-specific. +atof() is C-specific. Perl converts strings to numbers transparently. +If you need to force a scalar to a number, add a zero to it. =item atoi -atoi() is C-specific. +atoi() is C-specific. Perl converts strings to numbers transparently. +If you need to force a scalar to a number, add a zero to it. +If you need to have just the integer part, see L<perlfunc/int>. =item atol -atol() is C-specific. +atol() is C-specific. Perl converts strings to numbers transparently. +If you need to force a scalar to a number, add a zero to it. +If you need to have just the integer part, see L<perlfunc/int>. =item bsearch -bsearch() not supplied. +bsearch() not supplied. For doing binary search on wordlists, +see L<Search::Dict>. =item calloc -calloc() is C-specific. +calloc() is C-specific. Perl does memory management transparently. =item ceil -This is identical to the C function C<ceil()>. +This is identical to the C function C<ceil()>, returning the smallest +integer value greater than or equal to the given numerical argument. =item chdir -This is identical to Perl's builtin C<chdir()> function. +This is identical to Perl's builtin C<chdir()> function, allowing +one to change the working (default) directory, see L<perlfunc/chdir>. =item chmod -This is identical to Perl's builtin C<chmod()> function. +This is identical to Perl's builtin C<chmod()> function, allowing +one to change file and directory permissions, see L<perlfunc/chmod>. =item chown -This is identical to Perl's builtin C<chown()> function. +This is identical to Perl's builtin C<chown()> function, allowing one +to change file and directory owners and groups, see L<perlfunc/chown>. =item clearerr -Use method C<IO::Handle::clearerr()> instead. +Use the method L<IO::Handle::clearerr()> instead, to reset the error +state (if any) and EOF state (if any) of the given stream. =item clock -This is identical to the C function C<clock()>. +This is identical to the C function C<clock()>, returning the +amount of spent processor time in microseconds. =item close @@ -171,17 +209,23 @@ C<POSIX::open>. Returns C<undef> on failure. +See also L<perlfunc/close>. + =item closedir -This is identical to Perl's builtin C<closedir()> function. +This is identical to Perl's builtin C<closedir()> function for closing +a directory handle, see L<perlfunc/closedir>. =item cos -This is identical to Perl's builtin C<cos()> function. +This is identical to Perl's builtin C<cos()> function, for returning +the cosine of its numerical argument, see L<perlfunc/cos>. +See also L<Math::Trig>. =item cosh -This is identical to the C function C<cosh()>. +This is identical to the C function C<cosh()>, for returning +the hyperbolic cosine of its numeric argument. See also L<Math::Trig>. =item creat @@ -191,6 +235,8 @@ C<POSIX::open>. Use C<POSIX::close> to close the file. $fd = POSIX::creat( "foo", 0611 ); POSIX::close( $fd ); +See also L<perlfunc/sysopen> and its C<O_CREAT> flag. + =item ctermid Generates the path name for the controlling terminal. @@ -199,25 +245,30 @@ Generates the path name for the controlling terminal. =item ctime -This is identical to the C function C<ctime()>. +This is identical to the C function C<ctime()> and equivalent +to C<asctime(localtime(...))>, see L</asctime> and L</localtime>. =item cuserid -Get the character login name of the user. +Get the login name of the owner of the current process. $name = POSIX::cuserid(); =item difftime -This is identical to the C function C<difftime()>. +This is identical to the C function C<difftime()>, for returning +the time difference (in seconds) between two times (as returned +by C<time()>), see L</time>. =item div -div() is C-specific. +div() is C-specific, use L<perlfunc/int> on the usual C</> division and +the modulus C<%>. =item dup -This is similar to the C function C<dup()>. +This is similar to the C function C<dup()>, for duplicating a file +descriptor. This uses file descriptors such as those obtained by calling C<POSIX::open>. @@ -226,7 +277,8 @@ Returns C<undef> on failure. =item dup2 -This is similar to the C function C<dup2()>. +This is similar to the C function C<dup2()>, for duplicating a file +descriptor to an another known file descriptor. This uses file descriptors such as those obtained by calling C<POSIX::open>. @@ -239,57 +291,64 @@ Returns the value of errno. $errno = POSIX::errno(); +This identical to the numerical values of the C<$!>, see L<perlvar/$ERRNO>. + =item execl -execl() is C-specific. +execl() is C-specific, see L<perlfunc/exec>. =item execle -execle() is C-specific. +execle() is C-specific, see L<perlfunc/exec>. =item execlp -execlp() is C-specific. +execlp() is C-specific, see L<perlfunc/exec>. =item execv -execv() is C-specific. +execv() is C-specific, see L<perlfunc/exec>. =item execve -execve() is C-specific. +execve() is C-specific, see L<perlfunc/exec>. =item execvp -execvp() is C-specific. +execvp() is C-specific, see L<perlfunc/exec>. =item exit -This is identical to Perl's builtin C<exit()> function. +This is identical to Perl's builtin C<exit()> function for exiting the +program, see L<perlfunc/exit>. =item exp -This is identical to Perl's builtin C<exp()> function. +This is identical to Perl's builtin C<exp()> function for +returning the exponent (I<e>-based) of the numerical argument, +see L<perlfunc/exp>. =item fabs -This is identical to Perl's builtin C<abs()> function. +This is identical to Perl's builtin C<abs()> function for returning +the absolute value of the numerical argument, see L<perlfunc/abs>. =item fclose -Use method C<IO::Handle::close()> instead. +Use method C<IO::Handle::close()> instead, or see L<perlfunc/close>. =item fcntl -This is identical to Perl's builtin C<fcntl()> function. +This is identical to Perl's builtin C<fcntl()> function, +see L<perlfunc/fcntl>. =item fdopen -Use method C<IO::Handle::new_from_fd()> instead. +Use method C<IO::Handle::new_from_fd()> instead, or see L<perlfunc/open>. =item feof -Use method C<IO::Handle::eof()> instead. +Use method C<IO::Handle::eof()> instead, or see L<perlfunc/eof>. =item ferror @@ -298,38 +357,49 @@ Use method C<IO::Handle::error()> instead. =item fflush Use method C<IO::Handle::flush()> instead. +See also L<perlvar/$OUTPUT_AUTOFLUSH>. =item fgetc -Use method C<IO::Handle::getc()> instead. +Use method C<IO::Handle::getc()> instead, or see L<perlfunc/read>. =item fgetpos -Use method C<IO::Seekable::getpos()> instead. +Use method C<IO::Seekable::getpos()> instead, or see L<L/seek>. =item fgets -Use method C<IO::Handle::gets()> instead. +Use method C<IO::Handle::gets()> instead. Similar to E<lt>E<gt>, also known +as L<perlfunc/readline>. =item fileno -Use method C<IO::Handle::fileno()> instead. +Use method C<IO::Handle::fileno()> instead, or see L<perlfunc/fileno>. =item floor -This is identical to the C function C<floor()>. +This is identical to the C function C<floor()>, returning the largest +integer value less than or equal to the numerical argument. =item fmod This is identical to the C function C<fmod()>. + $r = modf($x, $y); + +It returns the remainder C<$r = $x - $n*$y>, where C<$n = trunc($x/$y)>. +The C<$r> has the same sign as C<$x> and magnitude (absolute value) +less than the magnitude of C<$y>. + =item fopen -Use method C<IO::File::open()> instead. +Use method C<IO::File::open()> instead, or see L<perlfunc/open>. =item fork -This is identical to Perl's builtin C<fork()> function. +This is identical to Perl's builtin C<fork()> function +for duplicating the current process, see L<perlfunc/fork> +and L<perlfork> if you are in Windows. =item fpathconf @@ -346,45 +416,45 @@ Returns C<undef> on failure. =item fprintf -fprintf() is C-specific--use printf instead. +fprintf() is C-specific, see L<perlfunc/printf> instead. =item fputc -fputc() is C-specific--use print instead. +fputc() is C-specific, see L<perlfunc/print> instead. =item fputs -fputs() is C-specific--use print instead. +fputs() is C-specific, see L<perlfunc/print> instead. =item fread -fread() is C-specific--use read instead. +fread() is C-specific, see L<perlfunc/read> instead. =item free -free() is C-specific. +free() is C-specific. Perl does memory management transparently. =item freopen -freopen() is C-specific--use open instead. +freopen() is C-specific, see L<perlfunc/open> instead. =item frexp Return the mantissa and exponent of a floating-point number. - ($mantissa, $exponent) = POSIX::frexp( 3.14 ); + ($mantissa, $exponent) = POSIX::frexp( 1.234e56 ); =item fscanf -fscanf() is C-specific--use <> and regular expressions instead. +fscanf() is C-specific, use E<lt>E<gt> and regular expressions instead. =item fseek -Use method C<IO::Seekable::seek()> instead. +Use method C<IO::Seekable::seek()> instead, or see L<perlfunc/seek>. =item fsetpos -Use method C<IO::Seekable::setpos()> instead. +Use method C<IO::Seekable::setpos()> instead, or seek L<perlfunc/seek>. =item fstat @@ -397,174 +467,221 @@ Perl's builtin C<stat> function. =item ftell -Use method C<IO::Seekable::tell()> instead. +Use method C<IO::Seekable::tell()> instead, or see L<perlfunc/tell>. =item fwrite -fwrite() is C-specific--use print instead. +fwrite() is C-specific, see L<perlfunc/print> instead. =item getc -This is identical to Perl's builtin C<getc()> function. +This is identical to Perl's builtin C<getc()> function, +see L<perlfunc/getc>. =item getchar -Returns one character from STDIN. +Returns one character from STDIN. Identical to Perl's C<getc()>, +see L<perlfunc/getc>. =item getcwd Returns the name of the current working directory. +See also L<Cwd>. =item getegid -Returns the effective group id. +Returns the effective group identifier. Similar to Perl' s builtin +variable C<$(>, see L<perlvar/$EGID>. =item getenv Returns the value of the specified enironment variable. +The same information is available through the C<%ENV> array. =item geteuid -Returns the effective user id. +Returns the effective user identifier. Identical to Perl's builtin C<$E<gt>> +variable, see L<perlvar/$EUID>. =item getgid -Returns the user's real group id. +Returns the user's real group identifier. Similar to Perl's builtin +variable C<$)>, see L<perlvar/$GID>. =item getgrgid -This is identical to Perl's builtin C<getgrgid()> function. +This is identical to Perl's builtin C<getgrgid()> function for +returning group entries by group identifiers, see +L<perlfunc/getgrgid>. =item getgrnam -This is identical to Perl's builtin C<getgrnam()> function. +This is identical to Perl's builtin C<getgrnam()> function for +returning group entries by group names, see L<perlfunc/getgrnam>. =item getgroups -Returns the ids of the user's supplementary groups. +Returns the ids of the user's supplementary groups. Similar to Perl's +builtin variable C<$)>, see L<perlvar/$GID>. =item getlogin -This is identical to Perl's builtin C<getlogin()> function. +This is identical to Perl's builtin C<getlogin()> function for +returning the user name associated with the current session, see +L<perlfunc/getlogin>. =item getpgrp -This is identical to Perl's builtin C<getpgrp()> function. +This is identical to Perl's builtin C<getpgrp()> function for +returning the prcess group identifier of the current process, see +L<perlfunc/getpgrp>. =item getpid -Returns the process's id. +Returns the process identifier. Identical to Perl's builtin +variable C<$$>, see L<perlvar/$PID>. =item getppid -This is identical to Perl's builtin C<getppid()> function. +This is identical to Perl's builtin C<getppid()> function for +returning the process identifier of the parent process of the current +process , see L<perlfunc/getppid>. =item getpwnam -This is identical to Perl's builtin C<getpwnam()> function. +This is identical to Perl's builtin C<getpwnam()> function for +returning user entries by user names, see L<perlfunc/getpwnam>. =item getpwuid -This is identical to Perl's builtin C<getpwuid()> function. +This is identical to Perl's builtin C<getpwuid()> function for +returning user entries by user identifiers, see L<perlfunc/getpwuid>. =item gets -Returns one line from STDIN. +Returns one line from C<STDIN>, similar to E<lt>E<gt>, also known +as the C<readline()> function, see L<perlfunc/readline>. + +B<NOTE>: if you have C programs that still use C<gets()>, be very +afraid. The C<gets()> function is a source of endless grief because +it has no buffer overrun checks. It should B<never> be used. The +C<fgets()> function should be preferred instead. =item getuid -Returns the user's id. +Returns the user's identifier. Identical to Perl's builtin C<$E<lt>> variable, +see L<perlvar/$UID>. =item gmtime -This is identical to Perl's builtin C<gmtime()> function. +This is identical to Perl's builtin C<gmtime()> function for +converting seconds since the epoch to a date in Greenwich Mean Time, +see L<perlfunc/gmtime>. =item isalnum This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isalnum:]]/> construct instead, or possibly the C</\w/> construct. =item isalpha This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isalpha:]]/> construct instead. =item isatty Returns a boolean indicating whether the specified filehandle is connected -to a tty. +to a tty. Similar to the C<-t> operator, see L<perlfunc/-X>. =item iscntrl This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:iscntrl:]]/> construct instead. =item isdigit This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isdigit:]]/> construct instead, or the C</\d/> construct. =item isgraph This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isgraph:]]/> construct instead. =item islower This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:islower:]]/> construct instead. Do B<not> use C</a-z/>. =item isprint This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isprint:]]/> construct instead. =item ispunct This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:ispunct:]]/> construct instead. =item isspace This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isspace:]]/> construct instead, or the C</\s/> construct. =item isupper This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isupper:]]/> construct instead. Do B<not> use C</A-Z/>. =item isxdigit This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C</[[:isxdigit:]]/> construct instead, or simply C</[0-9a-f]/i>. =item kill -This is identical to Perl's builtin C<kill()> function. +This is identical to Perl's builtin C<kill()> function for sending +signals to processes (often to terminate them), see L<perlfunc/kill>. =item labs -labs() is C-specific, use abs instead. +(For returning absolute values of long integers.) +labs() is C-specific, see L<perlfunc/abs> instead. =item ldexp -This is identical to the C function C<ldexp()>. +This is identical to the C function C<ldexp()> +for multiplying floating point numbers with powers of two. + + $x_quadrupled = POSIX::ldexp($x, 2); =item ldiv -ldiv() is C-specific, use / and int instead. +(For computing dividends of long integers.) +ldiv() is C-specific, use C</> and C<int()> instead. =item link -This is identical to Perl's builtin C<link()> function. +This is identical to Perl's builtin C<link()> function +for creating hard links into files, see L<perlfunc/link>. =item localeconv Get numeric formatting information. Returns a reference to a hash containing the current locale formatting values. -The database for the B<de> (Deutsch or German) locale. +Here is how to query the database for the B<de> (Deutsch or German) locale. $loc = POSIX::setlocale( &POSIX::LC_ALL, "de" ); print "Locale = $loc\n"; @@ -590,19 +707,34 @@ The database for the B<de> (Deutsch or German) locale. =item localtime -This is identical to Perl's builtin C<localtime()> function. +This is identical to Perl's builtin C<localtime()> function for +converting seconds since the epoch to a date see L<perlfunc/localtime>. =item log -This is identical to Perl's builtin C<log()> function. +This is identical to Perl's builtin C<log()> function, +returning the natural (I<e>-based) logarithm of the numerical argument, +see L<perlfunc/log>. =item log10 -This is identical to the C function C<log10()>. +This is identical to the C function C<log10()>, +returning the 10-base logarithm of the numerical argument. +You can also use + + sub log10 { log($_[0]) / log(10) } + +or + + sub log10 { log($_[0]) / 2.30258509299405 } + +or + + sub log10 { log($_[0]) * 0.434294481903252 } =item longjmp -longjmp() is C-specific: use die instead. +longjmp() is C-specific: use L<perlfunc/die> instead. =item lseek @@ -616,49 +748,63 @@ Returns C<undef> on failure. =item malloc -malloc() is C-specific. +malloc() is C-specific. Perl does memory management transparently. =item mblen This is identical to the C function C<mblen()>. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item mbstowcs This is identical to the C function C<mbstowcs()>. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item mbtowc This is identical to the C function C<mbtowc()>. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item memchr -memchr() is C-specific, use index() instead. +memchr() is C-specific, see L<perlfunc/index> instead. =item memcmp -memcmp() is C-specific, use eq instead. +memcmp() is C-specific, use C<eq> instead, see L<perlop>. =item memcpy -memcpy() is C-specific, use = instead. +memcpy() is C-specific, use C<=>, see L<perlop>, or see L<perlfunc/substr>. =item memmove -memmove() is C-specific, use = instead. +memmove() is C-specific, use C<=>, see L<perlop>, or see L<perlfunc/substr>. =item memset -memset() is C-specific, use x instead. +memset() is C-specific, use C<x> instead, see L<perlop>. =item mkdir -This is identical to Perl's builtin C<mkdir()> function. +This is identical to Perl's builtin C<mkdir()> function +for creating directories, see L<perlfunc/mkdir>. =item mkfifo -This is similar to the C function C<mkfifo()>. +This is similar to the C function C<mkfifo()> for creating +FIFO special files. -Returns C<undef> on failure. + if (mkfifo($path, $mode)) { .... + +Returns C<undef> on failure. The C<$mode> is similar to the +mode of C<mkdir()>, see L<perlfunc/mkdir>. =item mktime @@ -689,13 +835,16 @@ Return the integral and fractional parts of a floating-point number. =item nice -This is similar to the C function C<nice()>. +This is similar to the C function C<nice()>, for changing +the scheduling preference of the current process. Positive +arguments mean more polite process, negative values more +needy process. Normal user processes can only be more polite. Returns C<undef> on failure. =item offsetof -offsetof() is C-specific. +offsetof() is C-specific, you probably want to see L<perlfunc/pack> instead. =item open @@ -720,6 +869,8 @@ Create a new file with mode 0640. Set up the file for writing. Returns C<undef> on failure. +See also L<perlfunc/sysopen>. + =item opendir Open a directory for reading. @@ -743,13 +894,17 @@ Returns C<undef> on failure. =item pause -This is similar to the C function C<pause()>. +This is similar to the C function C<pause()>, which suspends +the execution of the current process until a signal is received. Returns C<undef> on failure. =item perror -This is identical to the C function C<perror()>. +This is identical to the C function C<perror()>, which outputs to the +standard error stream the specified message followed by ": " and the +current error string. Use the C<warn()> function and the C<$!> +variable instead, see L<perlfunc/warn> and L<perlvar/$ERRNO>. =item pipe @@ -760,39 +915,45 @@ returned by C<POSIX::open>. POSIX::write( $fd0, "hello", 5 ); POSIX::read( $fd1, $buf, 5 ); +See also L<perlfunc/pipe>. + =item pow -Computes $x raised to the power $exponent. +Computes C<$x> raised to the power C<$exponent>. $ret = POSIX::pow( $x, $exponent ); +You can also use the C<**> operator, see L<perlop>. + =item printf -Prints the specified arguments to STDOUT. +Formats and prints the specified arguments to STDOUT. +See also L<perlfunc/printf>. =item putc -putc() is C-specific--use print instead. +putc() is C-specific, see L<perlfunc/print> instead. =item putchar -putchar() is C-specific--use print instead. +putchar() is C-specific, see L<perlfunc/print> instead. =item puts -puts() is C-specific--use print instead. +puts() is C-specific, see L<perlfunc/print> instead. =item qsort -qsort() is C-specific, use sort instead. +qsort() is C-specific, see L<perlfunc/sort> instead. =item raise Sends the specified signal to the current process. +See also L<perlfunc/kill> and the C<$$> in L<perlvar/$PID>. =item rand -rand() is non-portable, use Perl's rand instead. +C<rand()> is non-portable, see L<perlfunc/rand> instead. =item read @@ -805,21 +966,26 @@ read then Perl will extend it to make room for the request. Returns C<undef> on failure. +See also L<perlfunc/sysread>. + =item readdir -This is identical to Perl's builtin C<readdir()> function. +This is identical to Perl's builtin C<readdir()> function +for reading directory entries, see L<perlfunc/readdir>. =item realloc -realloc() is C-specific. +realloc() is C-specific. Perl does memory management transparently. =item remove -This is identical to Perl's builtin C<unlink()> function. +This is identical to Perl's builtin C<unlink()> function +for removing files, see L<perlfunc/unlink>. =item rename -This is identical to Perl's builtin C<rename()> function. +This is identical to Perl's builtin C<rename()> function +for renaming files, see L<perlfunc/rename>. =item rewind @@ -827,23 +993,29 @@ Seeks to the beginning of the file. =item rewinddir -This is identical to Perl's builtin C<rewinddir()> function. +This is identical to Perl's builtin C<rewinddir()> function for +rewinding directory entry streams, see L<perlfunc/rewinddir>. =item rmdir -This is identical to Perl's builtin C<rmdir()> function. +This is identical to Perl's builtin C<rmdir()> function +for removing (empty) directories, see L<perlfunc/rmdir>. =item scanf -scanf() is C-specific--use <> and regular expressions instead. +scanf() is C-specific, use E<lt>E<gt> and regular expressions instead, +see L<perlre>. =item setgid -Sets the real group id for this process. +Sets the real group identifier for this process. +Identical to assigning a value to the Perl's builtin C<$)> variable, +see L<perlvar/$UID>. =item setjmp -setjmp() is C-specific: use eval {} instead. +C<setjmp()> is C-specific: use C<eval {}> instead, +see L<perlfunc/eval>. =item setlocale @@ -879,17 +1051,21 @@ out which locales are available in your system. =item setpgid -This is similar to the C function C<setpgid()>. +This is similar to the C function C<setpgid()> for +setting the process group identifier of the current process. Returns C<undef> on failure. =item setsid -This is identical to the C function C<setsid()>. +This is identical to the C function C<setsid()> for +setting the session identifier of the current process. =item setuid -Sets the real user id for this process. +Sets the real user identifier for this process. +Identical to assigning a value to the Perl's builtin C<$E<lt>> variable, +see L<perlvar/$UID>. =item sigaction @@ -905,7 +1081,7 @@ Returns C<undef> on failure. =item siglongjmp -siglongjmp() is C-specific: use die instead. +siglongjmp() is C-specific: use L<perlfunc/die> instead. =item sigpending @@ -933,7 +1109,8 @@ Returns C<undef> on failure. =item sigsetjmp -sigsetjmp() is C-specific: use eval {} instead. +C<sigsetjmp()> is C-specific: use C<eval {}> instead, +see L<perlfunc/eval>. =item sigsuspend @@ -949,63 +1126,80 @@ Returns C<undef> on failure. =item sin -This is identical to Perl's builtin C<sin()> function. +This is identical to Perl's builtin C<sin()> function +for returning the sine of the numerical argument, +see L<perlfunc/sin>. See also L<Math::Trig>. =item sinh -This is identical to the C function C<sinh()>. +This is identical to the C function C<sinh()> +for returning the hyperbolic sine of the numerical argument. +See also L<Math::Trig>. =item sleep -This is identical to Perl's builtin C<sleep()> function. +This is identical to Perl's builtin C<sleep()> function +for suspending the execution of the current for process +for certain number of seconds, see L<perlfunc/sleep>. =item sprintf -This is identical to Perl's builtin C<sprintf()> function. +This is similar to Perl's builtin C<sprintf()> function +for returning a string that has the arguments formatted as requested, +see L<perlfunc/sprintf>. =item sqrt This is identical to Perl's builtin C<sqrt()> function. +for returning the square root of the numerical argument, +see L<perlfunc/sqrt>. =item srand -srand(). +Give a seed the pseudorandom number generator, see L<perlfunc/srand>. =item sscanf -sscanf() is C-specific--use regular expressions instead. +sscanf() is C-specific, use regular expressions instead, +see L<perlre>. =item stat -This is identical to Perl's builtin C<stat()> function. +This is identical to Perl's builtin C<stat()> function +for retutning information about files and directories. =item strcat -strcat() is C-specific, use .= instead. +strcat() is C-specific, use C<.=> instead, see L<perlop>. =item strchr -strchr() is C-specific, use index() instead. +strchr() is C-specific, see L<perlfunc/index> instead. =item strcmp -strcmp() is C-specific, use eq instead. +strcmp() is C-specific, use C<eq> or C<cmp> instead, see L<perlop>. =item strcoll -This is identical to the C function C<strcoll()>. +This is identical to the C function C<strcoll()> +for collating (comparing) strings transformed using +the C<strxfrm()> function. Not really needed since +Perl can do this transparently, see L<perllocale>. =item strcpy -strcpy() is C-specific, use = instead. +strcpy() is C-specific, use C<=> instead, see L<perlop>. =item strcspn -strcspn() is C-specific, use regular expressions instead. +strcspn() is C-specific, use regular expressions instead, +see L<perlre>. =item strerror Returns the error string for the specified errno. +Identical to the string form of the C<$!>, see L<perlvar/$ERRNO>. =item strftime @@ -1034,39 +1228,38 @@ The string for Tuesday, December 12, 1995. =item strlen -strlen() is C-specific, use length instead. +strlen() is C-specific, use C<length()> instead, see L<perlfunc/length>. =item strncat -strncat() is C-specific, use .= instead. +strncat() is C-specific, use C<.=> instead, see L<perlop>. =item strncmp -strncmp() is C-specific, use eq instead. +strncmp() is C-specific, use C<eq> instead, see L<perlop>. =item strncpy -strncpy() is C-specific, use = instead. - -=item stroul - -stroul() is C-specific. +strncpy() is C-specific, use C<=> instead, see L<perlop>. =item strpbrk -strpbrk() is C-specific. +strpbrk() is C-specific, use regular expressions instead, +see L<perlre>. =item strrchr -strrchr() is C-specific, use rindex() instead. +strrchr() is C-specific, see L<perlfunc/rindex> instead. =item strspn -strspn() is C-specific. +strspn() is C-specific, use regular expressions instead, +see L<perlre>. =item strstr -This is identical to Perl's builtin C<index()> function. +This is identical to Perl's builtin C<index()> function, +see L<perlfunc/index>. =item strtod @@ -1093,7 +1286,8 @@ When called in a scalar context strtod returns the parsed number. =item strtok -strtok() is C-specific. +strtok() is C-specific, use regular expressions instead, see +L<perlre>, or L<perlfunc/split>. =item strtol @@ -1127,12 +1321,12 @@ When called in a scalar context strtol returns the parsed number. =item strtoul -String to unsigned (long) integer translation. strtoul is identical -to strtol except that strtoul only parses unsigned integers. See -I<strtol> for details. +String to unsigned (long) integer translation. strtoul() is identical +to strtol() except that strtoul() only parses unsigned integers. See +L</strtol> for details. -Note: Some vendors supply strtod and strtol but not strtoul. -Other vendors that do suply strtoul parse "-1" as a valid value. +Note: Some vendors supply strtod() and strtol() but not strtoul(). +Other vendors that do supply strtoul() parse "-1" as a valid value. =item strxfrm @@ -1140,6 +1334,11 @@ String transformation. Returns the transformed string. $dst = POSIX::strxfrm( $src ); +Used in conjunction with the C<strcoll()> function, see L</strcoll>. + +Not really needed since Perl can do this transparently, see +L<perllocale>. + =item sysconf Retrieves values of system configurable variables. @@ -1152,53 +1351,66 @@ Returns C<undef> on failure. =item system -This is identical to Perl's builtin C<system()> function. +This is identical to Perl's builtin C<system()> function, see +L<perlfunc/system>. =item tan -This is identical to the C function C<tan()>. +This is identical to the C function C<tan()>, returning the +tangent of the numerical argument. See also L<Math::Trig>. =item tanh -This is identical to the C function C<tanh()>. +This is identical to the C function C<tanh()>, returning the +hyperbolic tangent of the numerical argument. See also L<Math::Trig>. =item tcdrain -This is similar to the C function C<tcdrain()>. +This is similar to the C function C<tcdrain()> for draining +the output queue of its argument stream. Returns C<undef> on failure. =item tcflow -This is similar to the C function C<tcflow()>. +This is similar to the C function C<tcflow()> for controlling +the flow of its argument stream. Returns C<undef> on failure. =item tcflush -This is similar to the C function C<tcflush()>. +This is similar to the C function C<tcflush()> for flushing +the I/O buffers of its argumeny stream. Returns C<undef> on failure. =item tcgetpgrp -This is identical to the C function C<tcgetpgrp()>. +This is identical to the C function C<tcgetpgrp()> for returning the +process group identifier of the foreground process group of the controlling +terminal. =item tcsendbreak -This is similar to the C function C<tcsendbreak()>. +This is similar to the C function C<tcsendbreak()> for sending +a break on its argument stream. Returns C<undef> on failure. =item tcsetpgrp -This is similar to the C function C<tcsetpgrp()>. +This is similar to the C function C<tcsetpgrp()> for setting the +process group identifier of the foreground process group of the controlling +terminal. Returns C<undef> on failure. =item time -This is identical to Perl's builtin C<time()> function. +This is identical to Perl's builtin C<time()> function +for returning the number of seconds since the epoch +(whatever it is for the system), see L<perlfunc/time>. =item times @@ -1214,7 +1426,7 @@ seconds. =item tmpfile -Use method C<IO::File::new_tmpfile()> instead. +Use method C<IO::File::new_tmpfile()> instead, or see L<File::Temp>. =item tmpnam @@ -1222,17 +1434,26 @@ Returns a name for a temporary file. $tmpfile = POSIX::tmpnam(); +See also L<File::Temp>. + =item tolower -This is identical to Perl's builtin C<lc()> function. +This is identical to the C function, except that it can apply to a single +character or to a whole string. Consider using the C<lc()> function, +see L<perlfunc/lc>, or the equivalent C<\L> operator inside doublequotish +strings. =item toupper -This is identical to Perl's builtin C<uc()> function. +This is identical to the C function, except that it can apply to a single +character or to a whole string. Consider using the C<uc()> function, +see L<perlfunc/uc>, or the equivalent C<\U> operator inside doublequotish +strings. =item ttyname -This is identical to the C function C<ttyname()>. +This is identical to the C function C<ttyname()> for returning the +name of the current terminal. =item tzname @@ -1243,17 +1464,31 @@ Retrieves the time conversion information from the C<tzname> variable. =item tzset -This is identical to the C function C<tzset()>. +This is identical to the C function C<tzset()> for setting +the current timezone based on the environment variable C<TZ>, +to be used by C<ctime()>, C<localtime()>, C<mktime()>, and C<strftime()> +functions. =item umask -This is identical to Perl's builtin C<umask()> function. +This is identical to Perl's builtin C<umask()> function +for setting (and querying) the file creation permission mask, +see L<perlfunc/umask>. =item uname Get name of current operating system. - ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname(); + ($sysname, $nodename, $release, $version, $machine) = POSIX::uname(); + +Note that the actual meanings of the various fields are not +that well standardized, do not expect any great portability. +The C<$sysname> might be the name of the operating system, +the C<$nodename> might be the name of the host, the C<$release> +might be the (major) release number of the operating system, +the C<$version> might be the (minor) release number of the +operating system, and the C<$machine> might be a hardware identifier. +Maybe. =item ungetc @@ -1261,32 +1496,36 @@ Use method C<IO::Handle::ungetc()> instead. =item unlink -This is identical to Perl's builtin C<unlink()> function. +This is identical to Perl's builtin C<unlink()> function +for removing files, see L<perlfunc/unlink>. =item utime -This is identical to Perl's builtin C<utime()> function. +This is identical to Perl's builtin C<utime()> function +for changing the time stamps of files and directories, +see L<perlfunc/utime>. =item vfprintf -vfprintf() is C-specific. +vfprintf() is C-specific, see L<perlfunc/printf> instead. =item vprintf -vprintf() is C-specific. +vprintf() is C-specific, see L<perlfunc/printf> instead. =item vsprintf -vsprintf() is C-specific. +vsprintf() is C-specific, see L<perlfunc/sprintf> instead. =item wait -This is identical to Perl's builtin C<wait()> function. +This is identical to Perl's builtin C<wait()> function, +see L<perlfunc/wait>. =item waitpid Wait for a child process to change state. This is identical to Perl's -builtin C<waitpid()> function. +builtin C<waitpid()> function, see L<perlfunc/waitpid>. $pid = POSIX::waitpid( -1, &POSIX::WNOHANG ); print "status = ", ($? / 256), "\n"; @@ -1294,10 +1533,16 @@ builtin C<waitpid()> function. =item wcstombs This is identical to the C function C<wcstombs()>. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item wctomb This is identical to the C function C<wctomb()>. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item write @@ -1310,6 +1555,8 @@ calling C<POSIX::open>. Returns C<undef> on failure. +See also L<perlfunc/syswrite>. + =back =head1 CLASSES @@ -1715,7 +1962,7 @@ CLK_TCK CLOCKS_PER_SEC =item Constants -R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STRERR_FILENO W_OK X_OK +R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STDERR_FILENO W_OK X_OK =back @@ -1733,7 +1980,3 @@ WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG =back -=head1 CREATION - -This document generated by ./mkposixman.PL version 19960129. - diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index b33e9619a4..b8b80d411b 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -55,6 +55,9 @@ #ifdef I_UNISTD #include <unistd.h> #endif +#ifdef MACOS_TRADITIONAL +#undef fdopen +#endif #include <fcntl.h> #if defined(__VMS) && !defined(__POSIX_SOURCE) @@ -80,7 +83,7 @@ /* The non-POSIX CRTL times() has void return type, so we just get the current time directly */ - clock_t vms_times(struct tms *PL_bufptr) { + clock_t vms_times(struct tms *bufptr) { dTHX; clock_t retval; /* Get wall time and convert to 10 ms intervals to @@ -101,7 +104,7 @@ _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder)); # endif /* Fill in the struct tms using the CRTL routine . . .*/ - times((tbuffer_t *)PL_bufptr); + times((tbuffer_t *)bufptr); return (clock_t) retval; } # define times(t) vms_times(t) @@ -142,7 +145,7 @@ #else # ifndef HAS_MKFIFO -# ifdef OS2 +# if defined(OS2) || defined(MACOS_TRADITIONAL) # define mkfifo(a,b) not_here("mkfifo") # else /* !( defined OS2 ) */ # ifndef mkfifo @@ -151,12 +154,19 @@ # endif # endif /* !HAS_MKFIFO */ -# include <grp.h> -# include <sys/times.h> -# ifdef HAS_UNAME -# include <sys/utsname.h> +# ifdef MACOS_TRADITIONAL + struct tms { time_t tms_utime, tms_stime, tms_cutime, tms_cstime; }; +# define times(a) not_here("times") +# define ttyname(a) (char*)not_here("ttyname") +# define tzset() not_here("tzset") +# else +# include <grp.h> +# include <sys/times.h> +# ifdef HAS_UNAME +# include <sys/utsname.h> +# endif +# include <sys/wait.h> # endif -# include <sys/wait.h> # ifdef I_UTIME # include <utime.h> # endif @@ -2296,9 +2306,9 @@ constant(char *name, int arg) #else goto not_there; #endif - if (strEQ(name, "STRERR_FILENO")) -#ifdef STRERR_FILENO - return STRERR_FILENO; + if (strEQ(name, "STDERR_FILENO")) +#ifdef STDERR_FILENO + return STDERR_FILENO; #else goto not_there; #endif @@ -3352,7 +3362,7 @@ modf(x) PPCODE: double intvar; /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); + PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar)))); PUSHs(sv_2mortal(newSVnv(intvar))); double diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm index c5e26c8e04..438b8d02c1 100644 --- a/ext/SDBM_File/SDBM_File.pm +++ b/ext/SDBM_File/SDBM_File.pm @@ -20,14 +20,98 @@ SDBM_File - Tied access to sdbm files =head1 SYNOPSIS + use Fcntl; # For O_RDWR, O_CREAT, etc. use SDBM_File; - tie(%h, 'SDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); + tie(%h, 'SDBM_File', 'filename', O_RDWR|O_CREAT, 0666) + or die "Couldn't tie SDBM file 'filename': $!; aborting"; + + # Now read and change the hash + $h{newkey} = newvalue; + print $h{oldkey}; + ... untie %h; =head1 DESCRIPTION -See L<perlfunc/tie>, L<perldbmfilter> +C<SDBM_File> establishes a connection between a Perl hash variable and +a file in SDBM_File format;. You can manipulate the data in the file +just as if it were in a Perl hash, but when your program exits, the +data will remain in the file, to be used the next time your program +runs. + +Use C<SDBM_File> with the Perl built-in C<tie> function to establish +the connection between the variable and the file. The arguments to +C<tie> should be: + +=over 4 + +=item 1. + +The hash variable you want to tie. + +=item 2. + +The string C<"SDBM_File">. (Ths tells Perl to use the C<SDBM_File> +package to perform the functions of the hash.) + +=item 3. + +The name of the file you want to tie to the hash. + +=item 4. + +Flags. Use one of: + +=over 2 + +=item C<O_RDONLY> + +Read-only access to the data in the file. + +=item C<O_WRONLY> + +Write-only access to the data in the file. + +=item C<O_RDWR> + +Both read and write access. + +=back + +If you want to create the file if it does not exist, add C<O_CREAT> to +any of these, as in the example. If you omit C<O_CREAT> and the file +does not already exist, the C<tie> call will fail. + +=item 5. + +The default permissions to use if a new file is created. The actual +permissions will be modified by the user's umask, so you should +probably use 0666 here. (See L<perlfunc/umask>.) + +=back + +=head1 DIAGNOSTICS + +On failure, the C<tie> call returns an undefined value and probably +sets C<$!> to contain the reason the file could not be tied. + +=head2 C<sdbm store returned -1, errno 22, key "..." at ...> + +This warning is emmitted when you try to store a key or a value that +is too long. It means that the change was not recorded in the +database. See BUGS AND WARNINGS below. + + + +=head1 BUGS AND WARNINGS + +There are a number of limits on the size of the data that you can +store in the SDBM file. The most important is that the length of a +key, plus the length of its associated value, may not exceed 1008 +bytes. + +See L<perlfunc/tie>, L<perldbmfilter>, L<Fcntl> =cut diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index 02f098df77..025888d8ab 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -325,116 +325,6 @@ sub sockaddr_un { } } -sub INADDR_ANY (); -sub INADDR_BROADCAST (); -sub INADDR_LOOPBACK (); -sub INADDR_LOOPBACK (); - -sub AF_802 (); -sub AF_APPLETALK (); -sub AF_CCITT (); -sub AF_CHAOS (); -sub AF_DATAKIT (); -sub AF_DECnet (); -sub AF_DLI (); -sub AF_ECMA (); -sub AF_GOSIP (); -sub AF_HYLINK (); -sub AF_IMPLINK (); -sub AF_INET (); -sub AF_LAT (); -sub AF_MAX (); -sub AF_NBS (); -sub AF_NIT (); -sub AF_NS (); -sub AF_OSI (); -sub AF_OSINET (); -sub AF_PUP (); -sub AF_SNA (); -sub AF_UNIX (); -sub AF_UNSPEC (); -sub AF_X25 (); -sub IOV_MAX (); -sub MSG_BCAST (); -sub MSG_CTLFLAGS (); -sub MSG_CTLIGNORE (); -sub MSG_CTRUNC (); -sub MSG_DONTROUTE (); -sub MSG_DONTWAIT (); -sub MSG_EOF (); -sub MSG_EOR (); -sub MSG_ERRQUEUE (); -sub MSG_FIN (); -sub MSG_MAXIOVLEN (); -sub MSG_MCAST (); -sub MSG_NOSIGNAL (); -sub MSG_OOB (); -sub MSG_PEEK (); -sub MSG_PROXY (); -sub MSG_RST (); -sub MSG_SYN (); -sub MSG_TRUNC (); -sub MSG_URG (); -sub MSG_WAITALL (); -sub PF_802 (); -sub PF_APPLETALK (); -sub PF_CCITT (); -sub PF_CHAOS (); -sub PF_DATAKIT (); -sub PF_DECnet (); -sub PF_DLI (); -sub PF_ECMA (); -sub PF_GOSIP (); -sub PF_HYLINK (); -sub PF_IMPLINK (); -sub PF_INET (); -sub PF_LAT (); -sub PF_MAX (); -sub PF_NBS (); -sub PF_NIT (); -sub PF_NS (); -sub PF_OSI (); -sub PF_OSINET (); -sub PF_PUP (); -sub PF_SNA (); -sub PF_UNIX (); -sub PF_UNSPEC (); -sub PF_X25 (); -sub SCM_CONNECT (); -sub SCM_CREDENTIALS (); -sub SCM_CREDS (); -sub SCM_RIGHTS (); -sub SCM_TIMESTAMP (); -sub SHUT_RD (); -sub SHUT_RDWR (); -sub SHUT_WR (); -sub SOCK_DGRAM (); -sub SOCK_RAW (); -sub SOCK_RDM (); -sub SOCK_SEQPACKET (); -sub SOCK_STREAM (); -sub SOL_SOCKET (); -sub SOMAXCONN (); -sub SO_ACCEPTCONN (); -sub SO_BROADCAST (); -sub SO_DEBUG (); -sub SO_DONTLINGER (); -sub SO_DONTROUTE (); -sub SO_ERROR (); -sub SO_KEEPALIVE (); -sub SO_LINGER (); -sub SO_OOBINLINE (); -sub SO_RCVBUF (); -sub SO_RCVLOWAT (); -sub SO_RCVTIMEO (); -sub SO_REUSEADDR (); -sub SO_SNDBUF (); -sub SO_SNDLOWAT (); -sub SO_SNDTIMEO (); -sub SO_TYPE (); -sub SO_USELOOPBACK (); -sub UIO_MAXIOV (); - sub AUTOLOAD { my($constname); ($constname = $AUTOLOAD) =~ s/.*:://; diff --git a/fix_pl b/fix_pl new file mode 100644 index 0000000000..44c3f52170 --- /dev/null +++ b/fix_pl @@ -0,0 +1,21 @@ +#!perl +# Not fixing perl, but fixing the patchlevel if this perl comes +# from the repository rather than an official release +exit unless -e ".patch"; +open PATCH, ".patch" or die "Couldn't open .patch: $!"; +open PLIN, "patchlevel.h" or die "Couldn't open patchlevel.h : $!"; +open PLOUT, ">patchlevel.new" or die "Couldn't write on patchlevel.new : $!"; +my $pl = <PATCH>; +chomp ($pl); +$pl =~ s/\D//g; +my $seen=0; +while (<PLIN>) { + if (/\t,NULL/ and $seen) { + print PLOUT "\t,\"devel-$pl\"\n"; + } + $seen++ if /local_patches\[\]/; + print PLOUT; +} +close PLOUT; close PLIN; +rename "patchlevel.new", "patchlevel.h" or die "Couldn't rename: $!"; +unlink ".patch"; diff --git a/global.sym b/global.sym index 796f8513d4..89c8824b93 100644 --- a/global.sym +++ b/global.sym @@ -21,6 +21,7 @@ Perl_get_context Perl_set_context Perl_amagic_call Perl_Gv_AMupdate +Perl_apply_attrs_string Perl_avhv_delete_ent Perl_avhv_exists_ent Perl_avhv_fetch_ent @@ -32,14 +33,12 @@ Perl_av_clear Perl_av_delete Perl_av_exists Perl_av_extend -Perl_av_fake Perl_av_fetch Perl_av_fill Perl_av_len Perl_av_make Perl_av_pop Perl_av_push -Perl_av_reify Perl_av_shift Perl_av_store Perl_av_undef @@ -185,6 +184,7 @@ Perl_to_uni_upper_lc Perl_to_uni_title_lc Perl_to_uni_lower_lc Perl_is_utf8_char +Perl_is_utf8_string Perl_is_utf8_alnum Perl_is_utf8_alnumc Perl_is_utf8_idfirst @@ -336,6 +336,7 @@ Perl_save_destructor_x Perl_save_freesv Perl_save_freepv Perl_save_generic_svref +Perl_save_generic_pvref Perl_save_gp Perl_save_hash Perl_save_helem @@ -459,6 +460,8 @@ Perl_utf16_to_utf8 Perl_utf16_to_utf8_reversed Perl_utf8_distance Perl_utf8_hop +Perl_utf8_to_bytes +Perl_bytes_to_utf8 Perl_utf8_to_uv Perl_uv_to_utf8 Perl_warn @@ -479,6 +482,7 @@ Perl_safexfree Perl_GetVars Perl_runops_standard Perl_runops_debug +Perl_sv_lock Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg Perl_sv_catpv_mg @@ -540,4 +544,5 @@ Perl_ptr_table_new Perl_ptr_table_fetch Perl_ptr_table_store Perl_ptr_table_split +Perl_sys_intern_clear Perl_sys_intern_init @@ -106,7 +106,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; - sv_magic((SV*)gv, (SV*)gv, '*', name, len); + sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0); GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; @@ -372,7 +372,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) gv = gv_fetchmeth(stash, name, nend - name, 0); if (!gv) { - if (strEQ(name,"import")) + if (strEQ(name,"import") || strEQ(name,"unimport")) gv = (GV*)&PL_sv_yes; else if (autoload) gv = gv_autoload4(stash, name, nend - name, TRUE); @@ -418,6 +418,9 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) return Nullgv; cv = GvCV(gv); + if (!CvROOT(cv)) + return Nullgv; + /* * Inheriting AUTOLOAD for non-methods works ... for now. */ @@ -435,9 +438,18 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) */ varstash = GvSTASH(CvGV(cv)); vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE); + ENTER; + +#ifdef USE_THREADS + sv_lock((SV *)varstash); +#endif if (!isGV(vargv)) gv_init(vargv, varstash, autoload, autolen, FALSE); + LEAVE; varsv = GvSV(vargv); +#ifdef USE_THREADS + sv_lock(varsv); +#endif sv_setpv(varsv, HvNAME(stash)); sv_catpvn(varsv, "::", 2); sv_catpvn(varsv, name, len); @@ -907,6 +919,22 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) } void +Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) +{ + HV *hv = GvSTASH(gv); + if (!hv) { + (void)SvOK_off(sv); + return; + } + sv_setpv(sv, prefix ? prefix : ""); + if (keepmain || strNE(HvNAME(hv), "main")) { + sv_catpv(sv,HvNAME(hv)); + sv_catpvn(sv,"::", 2); + } + sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); +} + +void Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix) { HV *hv = GvSTASH(gv); @@ -921,6 +949,15 @@ Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix) } void +Perl_gv_efullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) +{ + GV *egv = GvEGV(gv); + if (!egv) + egv = gv; + gv_fullname4(sv, egv, prefix, keepmain); +} + +void Perl_gv_efullname3(pTHX_ SV *sv, GV *gv, const char *prefix) { GV *egv = GvEGV(gv); @@ -1580,3 +1617,110 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } } + +/* +=for apidoc is_gv_magical + +Returns C<TRUE> if given the name of a magical GV. + +Currently only useful internally when determining if a GV should be +created even in rvalue contexts. + +C<flags> is not used at present but available for future extension to +allow selecting particular classes of magical variable. + +=cut +*/ +bool +Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags) +{ + if (!len) + return FALSE; + + switch (*name) { + case 'I': + if (len == 3 && strEQ(name, "ISA")) + goto yes; + break; + case 'O': + if (len == 8 && strEQ(name, "OVERLOAD")) + goto yes; + break; + case 'S': + if (len == 3 && strEQ(name, "SIG")) + goto yes; + break; + case '\027': /* $^W & $^WARNING_BITS */ + if (len == 1 + || (len == 12 && strEQ(name, "\027ARNING_BITS")) + || (len == 17 && strEQ(name, "\027IDE_SYSTEM_CALLS"))) + { + goto yes; + } + break; + + case '&': + case '`': + case '\'': + case ':': + case '?': + case '!': + case '-': + case '#': + case '*': + case '[': + case '^': + case '~': + case '=': + case '%': + case '.': + case '(': + case ')': + case '<': + case '>': + case ',': + case '\\': + case '/': + case '|': + case '+': + case ';': + case ']': + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\010': /* $^H */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\014': /* $^L */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\023': /* $^S */ + case '\024': /* $^T */ + case '\026': /* $^V */ + if (len == 1) + goto yes; + break; + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + if (len > 1) { + char *end = name + len; + while (--end > name) { + if (!isDIGIT(*end)) + return FALSE; + } + } + yes: + return TRUE; + default: + break; + } + return FALSE; +} @@ -261,7 +261,7 @@ C<strncmp>). /* =for apidoc Am|bool|isALNUM|char ch Returns a boolean indicating whether the C C<char> is an ASCII alphanumeric -character or digit. +character (including underscore) or digit. =for apidoc Am|bool|isALPHA|char ch Returns a boolean indicating whether the C C<char> is an ASCII alphabetic @@ -505,7 +505,7 @@ The XSUB-writer's interface to the C C<realloc> function. The XSUB-writer's interface to the C C<realloc> function, with cast. -=for apidoc Am|void|Safefree|void* src|void* dest|int nitems|type +=for apidoc Am|void|Safefree|void* ptr The XSUB-writer's interface to the C C<free> function. =for apidoc Am|void|Move|void* src|void* dest|int nitems|type diff --git a/hints/aix.sh b/hints/aix.sh index d6f3dd78e0..8a29b93e5b 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -206,30 +206,29 @@ EOCBU cat > UU/uselargefiles.cbu <<'EOCBU' case "$uselargefiles" in ''|$define|true|[yY]*) - lfcflags="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" - lfldflags="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" +# Keep these at the left margin. +ccflags_largefiles="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" +ldflags_largefiles="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to # insert(?) *something* to $ldflags so that later (in Configure) evaluating # $ldflags causes a newline after the '-b64' (the result of the getconf). # (nothing strange shows up in $ldflags even in hexdump; # so it may be something in the shell, instead?) # Try it out: just uncomment the below line and rerun Configure: -# echo >&4 "AIX 4.3.1.0 $lfldflags mystery" ; exit 1 +# echo >&4 "AIX 4.3.1.0 $ldflags_largefiles mystery" ; exit 1 # Just don't ask me how AIX does it, I spent hours wondering. - # Therefore the line re-evaluating lfldflags: it seems to fix + # Therefore the line re-evaluating ldflags_largefiles: it seems to fix # the whatever it was that AIX managed to break. --jhi - lfldflags="`echo $lfldflags`" - lflibs="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" - case "$lfcflags$lfldflags$lflibs" in + ldflags_largefiles="`echo $ldflags_largefiles`" +# Keep this at the left margin. +libswanted_largefiles="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + case "$ccflags_largefiles$ldflags_largefiles$libs_largefiles" in '');; - *) ccflags="$ccflags $lfcflags" - ldflags="$ldflags $lfldflags" - libswanted="$libswanted $lflibs" + *) ccflags="$ccflags $ccflags_largefiles" + ldflags="$ldflags $ldflags_largefiles" + libswanted="$libswanted $libswanted_largefiles" ;; esac - lfcflags='' - lfldflags='' - lflibs='' ;; esac EOCBU @@ -279,18 +278,18 @@ int main (void) EOCP set size if eval $compile_ok; then - lfcpuwidth=`./size` - echo "You are running on $lfcpuwidth bit hardware." + qacpuwidth=`./size` + echo "You are running on $qacpuwidth bit hardware." else dflt="32" echo " " echo "(I can't seem to compile the test program. Guessing...)" rp="What is the width of your CPU (in bits)?" . ./myread - lfcpuwidth="$ans" + qacpuwidth="$ans" fi $rm -f size.c size - case "$lfcpuwidth" in + case "$qacpuwidth" in 32*) cat >&4 <<EOM Bzzzt! At present, you can only perform a @@ -299,8 +298,8 @@ EOM exit 1 ;; esac - lfcflags="`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" - lfldflags="`getconf XBS5_LP64_OFF64_LDFLAGS 2>/dev/null`" + qacflags="`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" + qaldflags="`getconf XBS5_LP64_OFF64_LDFLAGS 2>/dev/null`" # See jhi's comments above regarding this re-eval. I've # seen similar weirdness in the form of: # @@ -309,8 +308,8 @@ EOM # error messages from 'cc -E' invocation. Again, the offending # string is simply not detectable by any means. Since it doesn't # do any harm, I didn't pursue it. -- sh - lfldflags="`echo $lfldflags`" - lflibs="`getconf XBS5_LP64_OFF64_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + qaldflags="`echo $qaldflags`" + qalibs="`getconf XBS5_LP64_OFF64_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" # -q32 and -b32 may have been set by uselargefiles or user. # Remove them. ccflags="`echo $ccflags | sed -e 's@-q32@@'`" @@ -322,15 +321,15 @@ EOM trylist="`echo $trylist | sed -e 's@^ar @@' -e 's@ ar @ @g' -e 's@ ar$@@'`" ar="ar -X64" nm_opt="-X64 $nm_opt" - # Note: Placing the 'lfcflags' variable into the 'ldflags' string - # is NOT a typo. ldlflags is passed to the C compiler for final + # Note: Placing the 'qacflags' variable into the 'ldflags' string + # is NOT a typo. ldqalags is passed to the C compiler for final # linking, and it wants -q64 (-b64 is for ld only!). - case "$lfcflags$lfldflags$lflibs" in + case "$qacflags$qaldflags$qalibs" in '');; - *) ccflags="$ccflags $lfcflags" - ldflags="$ldflags $lfcflags" - lddlflags="$lfldflags $lddlflags" - libswanted="$libswanted $lflibs" + *) ccflags="$ccflags $qacflags" + ldflags="$ldflags $qacflags" + lddqalags="$qaldflags $lddqalags" + libswanted="$libswanted $qalibs" ;; esac case "$ccflags" in @@ -344,10 +343,10 @@ EOM # Don't try backwards compatibility bincompat="$undef" d_bincompat5005="$undef" - lfcflags='' - lfldflags='' - lflibs='' - lfcpuwidth='' + qacflags='' + qaldflags='' + qalibs='' + qacpuwidth='' ;; esac EOCBU diff --git a/hints/bsdos.sh b/hints/bsdos.sh index c54a0c1606..1d1d823b03 100644 --- a/hints/bsdos.sh +++ b/hints/bsdos.sh @@ -3,8 +3,12 @@ # hints file for BSD/OS (adapted from bsd386.sh) # Original by Neil Bowers <neilb@khoros.unm.edu>; Tue Oct 4 12:01:34 EDT 1994 # Updated by Tony Sanders <sanders@bsdi.com>; Sat Aug 23 12:47:45 MDT 1997 -# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0) -# SYSV IPC tested Ok so I re-enabled. +# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. +# Estimated for 4.0) SYSV IPC tested Ok so I re-enabled. +# +# Updated to work in post-4.0 by Todd C. Miller <millert@openbsd.org> +# +# Updated for threads by "Timur I. Bakeyev" <bsdi@listserv.bat.ru> # # To override the compiler on the command line: # ./Configure -Dcc=gcc2 @@ -18,7 +22,7 @@ d_voidsig='define' usemymalloc='n' # setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions. -# See http://www.bsdi.com/bsdi-man?setuid(2) +# See <A HREF="http://www.bsdi.com/bsdi-man?setuid">http://www.bsdi.com/bsdi-man?setuid</A>(2) d_setregid='undef' d_setreuid='undef' d_setrgid='undef' @@ -85,8 +89,8 @@ case "$osvers" in libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted" libswanted="rpc curses termcap $libswanted" ;; -4.0*) - # ELF dynamic link libraries starting in 4.0 (???) +4.*) + # ELF dynamic link libraries starting in 4.0 useshrplib='true' so='so' dlext='so' @@ -94,13 +98,34 @@ case "$osvers" in case "$cc" in '') cc='cc' # cc is gcc2 in 4.0 cccdlflags="-fPIC" - ccdlflags=" " ;; + ccdlflags="-rdynamic -Wl,-rpath,$privlib/$archname/CORE" + ;; esac case "$ld" in '') ld='ld' lddlflags="-shared -x $lddlflags" ;; esac - ;; + # Due usage of static pointer from crt.o + libswanted="util $libswanted" ;; esac +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + case "$osvers" in + 3.*|4.*) ccflags="-D_REENTRANT $ccflags" + ;; + *) cat <<EOM >&4 +I did not know that BSD/OS $osvers supports POSIX threads. + +Feel free to tell perlbug@perl.com otherwise. +EOM + exit 1 + ;; + esac + ;; +esac +EOCBU diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh index db7b869cf2..c110d1ef13 100644 --- a/hints/dec_osf.sh +++ b/hints/dec_osf.sh @@ -65,30 +65,38 @@ cc=${cc:-cc} # reset _DEC_cc_style= case "`$cc -v 2>&1 | grep cc`" in -*gcc*) _gcc_version=`$cc -v 2>&1 | grep "gcc version" | sed 's%^gcc version \([0-9]*\)\.\([0-9]*\) .*%\1 \2%'` +*gcc*) _gcc_version=`$cc --version 2>&1 | tr . ' '` set $_gcc_version - if test "$1" -lt 2 -o \( "$1" -eq 2 -a "$2" -lt 95 \); then + if test "$1" -lt 2 -o \( "$1" -eq 2 -a \( "$2" -lt 95 -o \( "$2" -eq 95 -a "$3" -lt 2 \) \) \); then cat >&4 <<EOF -Your cc seems to be gcc and its version seems to be less than 2.95. -This is not a good idea since old versions of gcc are known to produce -buggy code when compiling Perl (and no doubt for other programs, too). - -Therefore, I strongly suggest upgrading your gcc. (Why don't you -use the vendor cc is also a good question. It comes with the operating -system and produces good code.) - -Note that as of gcc 2.95 (19990728) and Perl 5.6.0 (end of March 2000) -if the said Perl is compiled with the said gcc the lib/sdbm test will -dump core. As this doesn't happen with the vendor cc, this is -most probably a lingering bug in gcc. Therefore unless you have -a better gcc you are still better off using the vendor cc. +*** Your cc seems to be gcc and its version seems to be less than 2.95.2. +*** This is not a good idea since old versions of gcc are known to produce +*** buggy code when compiling Perl (and no doubt for other programs, too). +*** +*** Therefore, I strongly suggest upgrading your gcc. (Why don't you +*** use the vendor cc is also a good question. It comes with the operating +*** system and produces good code.) Cannot continue, aborting. EOF exit 1 fi + if test "$1" -eq 2 -a "$2" -eq 95 -a "$3" -le 2; then + cat >&4 <<EOF + +*** Note that as of gcc 2.95.2 (19991024) and Perl 5.6.0 (March 2000) +*** if the said Perl is compiled with the said gcc the lib/sdbm test +*** dumps core (meaning that the SDBM_File is unusable). As this core +*** dump doesn't happen with the vendor cc, this is most probably +*** a lingering bug in gcc. Therefore unless you have a better gcc +*** you are still better off using the vendor cc. + +Since you explicitly chose gcc, I assume that you know what are doing. + +EOF + fi ;; *) # compile something small: taint.c is fine for this. # the main point is the '-v' flag of 'cc'. diff --git a/hints/freebsd.sh b/hints/freebsd.sh index fd60ba3cb9..712281367e 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -86,8 +86,13 @@ case "$osvers" in d_setegid='undef' d_seteuid='undef' ;; +3.*) + usevfork='true' + usemymalloc='n' + libswanted=`echo $libswanted | sed 's/ malloc / /'` + ;; # -# Guesses at what will be needed after 2.2 +# Guesses at what will be needed after 3.* *) usevfork='true' usemymalloc='n' libswanted=`echo $libswanted | sed 's/ malloc / /'` diff --git a/hints/hpux.sh b/hints/hpux.sh index ce15f552b4..ecfcb6d572 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -387,8 +387,10 @@ cat > UU/uselargefiles.cbu <<'EOCBU' case "$uselargefiles" in ''|$define|true|[yY]*) # there are largefile flags available via getconf(1) - # but we cheat for now. - ccflags="$ccflags -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + # but we cheat for now. (Keep that in the left margin.) +ccflags_largefiles="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + + ccflags="$ccflags $ccflags_largefiles" if test -z "$ccisgcc" -a -z "$gccversion"; then # The strict ANSI mode (-Aa) doesn't like large files. diff --git a/hints/irix_6.sh b/hints/irix_6.sh index 8be23ac65f..ce301df2ff 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -32,6 +32,14 @@ # Don't bother with -n32 unless you have the 7.1 or later compilers. # But there's no quick and light-weight way to check in 6.2. +# NOTE: some IRIX cc versions, e.g. 7.3.1.1m (try cc -version) have +# been known to have issues (coredumps) when compiling perl.c. +# If you've used -OPT:fast_io=ON and this happens, try removing it. +# If that fails, or you didn't use that, then try adjusting other +# optimization options (-LNO, -INLINE, -O3 to -O2, etcetera). +# The compiler bug has been reported to SGI. +# -- Allen Smith <easmith@beatrice.rutgers.edu> + # Let's assume we want to use 'cc -n32' by default, unless the # necessary libm is missing (which has happened at least twice) case "$cc" in @@ -226,8 +234,10 @@ esac # Don't groan about unused libraries. ldflags="$ldflags -Wl,-woff,84" +# workaround for an optimizer bug case "`$cc -version 2>&1`" in -*7.2.*) op_cflags='optimize=-O1' ;; # workaround for an optimizer bug +*7.2.*) op_cflags='optimize=-O1'; opmini_cflags='optimize=-O1' ;; +*7.3.1.*) op_cflags='optimize=-O2'; opmini_cflags='optimize=-O2' ;; esac # We don't want these libraries. diff --git a/hints/linux.sh b/hints/linux.sh index 4fb2f89e7c..0fa46bd05d 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -282,7 +282,10 @@ cat > UU/uselargefiles.cbu <<'EOCBU' # after it has prompted the user for whether to use large files. case "$uselargefiles" in ''|$define|true|[yY]*) - ccflags="$ccflags -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" +# Keep this in the left margin. +ccflags_largefiles="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + + ccflags="$ccflags $ccflags_largefiles" ;; esac EOCBU diff --git a/hints/machten.sh b/hints/machten.sh index b4409c1bf0..69f16355c2 100644 --- a/hints/machten.sh +++ b/hints/machten.sh @@ -46,10 +46,7 @@ # # MachTen 4.1.1's support for shadow password file access is incomplete: # disable its use completely. -d_endspent=${d_endspent:-undef} -d_getspent=${d_getspent:-undef} d_getspnam=${d_getspnam:-undef} -d_setspent=${d_setspent:-undef} # MachTen 4.1.1 does support dynamic loading, but perl doesn't # know how to use it yet. @@ -241,10 +238,9 @@ Similarly, when you see select the default answer: vfork() works, and avoids expensive data copying. -You may also see "WHOA THERE!!!" messages concerning \$d_endspent, -\$d_getspent, \$d_getspnam and \$d_setspent. In all cases, select the -default answer: MachTen's support for shadow password file access is -incomplete, and should not be used. +You may also see "WHOA THERE!!!" messages concerning \$d_getspnam. +Select the default answer: MachTen's support for shadow password +file access is incomplete, and should not be used. At the end of Configure, you will see a harmless message diff --git a/hints/mpeix.sh b/hints/mpeix.sh index 556d22148c..d2ca5f09af 100644 --- a/hints/mpeix.sh +++ b/hints/mpeix.sh @@ -10,9 +10,10 @@ # Created for 5.003 by Mark Klein, mklein@dis.com. # Substantially revised for 5.004_01 by Mark Bixby, markb@cccd.edu. # Revised again for 5.004_69 by Mark Bixby, markb@cccd.edu. +# Revised for 5.6.0 by Mark Bixby, mbixby@power.net. # osname='mpeix' -osvers='5.5' # Isn't there a way to determine this dynamically? +osvers=`uname -r | sed -e 's/.[A-Z]\.\([0-9]\)\([0-9]\)\.[0-9][0-9]/\1.\2/'` # # Force Configure to use our wrapper mpeix/nm script # @@ -53,16 +54,34 @@ toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' # Linking. # lddlflags='-b' -# What if you want additional libs (e.g. gdbm)? -# This should remove the unwanted libraries from $libswanted and -# add on whatever ones are needed instead. -libs="$libs -lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc" +# Delete bsd and BSD from the library list. Remove other randomly ordered +# libraries and then re-add them in their proper order (the MPE linker is +# order-sensitive). Add additional MPE-specific libraries. +for mpe_remove in bind bsd BSD c curses m socket str svipc syslog; do + set `echo " $libswanted " | sed -e 's/ / /g' -e "s/ $mpe_remove //"` + libswanted="$*" +done +libswanted="$libswanted bind syslog curses svipc socket str m c" loclibpth="$loclibpth /usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB" # # External functions and data items. # -# Does Configure *really* get *all* of these wrong? +# Q: Does Configure *really* get *all* of these wrong? # +# A: Yes. There are two MPE problems here. The 'undef' functions exist on MPE, +# but are merely dummy routines that return ENOTIMPL or ESYSERR. Since they're +# useless, let's just tell Perl to avoid them. Also, a few data items are +# 'undef' because while they may exist in structures, they are uninitialized. +# +# The 'define' cases are a bit weirder. MPE has a libc.a, libc.sl, and two +# special kernel shared libraries, /SYS/PUB/XL and /SYS/PUB/NL. Much of what +# is in libc.a is duplicated within XL and NL, so when we created libc.sl, we +# omitted the duplicated functions. Since Configure end ups scanning libc.sl, +# we need to 'define' the functions that had been removed. +# +# We don't want to scan XL or NL because we would find way too many POSIX or +# Unix named functions that are really vanilla MPE functions that do something +# completely different than on POSIX or Unix. d_crypt='define' d_difftime='define' d_dlerror='undef' @@ -100,7 +119,7 @@ d_wctomb='define' # # Include files. # -i_termios='undef' +i_termios='undef' # we have termios, but not the full set (just tcget/setattr) i_time='define' i_systime='undef' i_systimek='undef' @@ -109,3 +128,8 @@ timeincl='/usr/include/time.h' # Data types. # timetype='time_t' +# +# Functionality. +# +bincompat5005="$undef" +uselargefiles="$undef" diff --git a/hints/os2.sh b/hints/os2.sh index 1d9df3683f..0e9f786d25 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -93,7 +93,7 @@ if test "$libemx" = "X"; then echo "Cannot find C library!" >&2; fi libpth="`echo \"$LIBRARY_PATH\" | tr ';\\\' ' /'`" libpth="$libpth $libemx/mt $libemx" -set `emxrev -f emxlibcm` +set `cmd /c emxrev -f emxlibcm` emxcrtrev=$5 # indented to not put it into config.sh _defemxcrtrev=-D_EMX_CRT_REV_=$emxcrtrev diff --git a/hints/powerux.sh b/hints/powerux.sh index 4070c01767..dc1b3d07f0 100644 --- a/hints/powerux.sh +++ b/hints/powerux.sh @@ -63,7 +63,7 @@ lddlflags='-Zlink=so' # i_ndbm='undef' -# I have no clude what perl thinks it wants <sys/mode.h> for, but if +# I have no clue what perl thinks it wants <sys/mode.h> for, but if # you include it in a program in PowerMAX without first including # <sys/vnode.h> the code don't compile... # diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 8aee6d40dc..21b0b0e4f5 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -374,9 +374,15 @@ cat > UU/uselargefiles.cbu <<'EOCBU' # after it has prompted the user for whether to use large files. case "$uselargefiles" in ''|$define|true|[yY]*) - ccflags="$ccflags `getconf LFS_CFLAGS 2>/dev/null`" - ldflags="$ldflags `getconf LFS_LDFLAGS 2>/dev/null`" - libswanted="$libswanted `getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + +# Keep these in the left margin. +ccflags_largefiles="`getconf LFS_CFLAGS 2>/dev/null`" +ldflags_largefiles="`getconf LFS_LDFLAGS 2>/dev/null`" +libswanted_largefiles="`getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + + ccflags="$ccflags $ccflags_largefiles" + ldflags="$ldflags $ldflags_largefiles" + libswanted="$libswanted $libswanted_largefiles" ;; esac EOCBU @@ -387,10 +393,10 @@ cat > UU/use64bitint.cbu <<'EOCBU' case "$use64bitint" in "$define"|true|[yY]*) case "`uname -r`" in - 2.[1-6]) + 5.[1-6]) cat >&4 <<EOM -Solaris `uname -r` does not support 64-bit integers. -You should upgrade to at least Solaris 2.7. +Solaris `uname -r|sed -e 's/^5\.\([789]\)$/\1/'` does not support 64-bit integers. +You should upgrade to at least Solaris 7. EOM exit 1 ;; diff --git a/hints/unicos.sh b/hints/unicos.sh index 33974f2b81..e49b373758 100644 --- a/hints/unicos.sh +++ b/hints/unicos.sh @@ -6,9 +6,11 @@ case "$optimize" in # --Mark P. Lutz '') optimize="$optimize -h nofastmd" ;; esac -# The default is to die on math overflows with an runtime error. +# The default is to die in runtime on math overflows. # Let's not do that. --jhi ccflags="$ccflags -h matherror=errno" +# Give int((2/3)*3) a chance to be 2, not 1. --jhi +ccflags="$ccflags -h rounddiv" # Avoid an optimizer bug where a volatile variables # isn't correctly saved and restored --Mark P. Lutz pp_ctl_cflags='ccflags="$ccflags -h scalar0 -h vector0"' @@ -42,9 +42,14 @@ S_more_he(pTHX) { register HE* he; register HE* heend; - New(54, PL_he_root, 1008/sizeof(HE), HE); - he = PL_he_root; + XPV *ptr; + New(54, ptr, 1008/sizeof(XPV), XPV); + ptr->xpv_pv = (char*)PL_he_arenaroot; + PL_he_arenaroot = ptr; + + he = (HE*)ptr; heend = &he[1008 / sizeof(HE) - 1]; + PL_he_root = ++he; while (he < heend) { HeNEXT(he) = (HE*)(he + 1); he++; diff --git a/installperl b/installperl index 09ffc806dd..f296712799 100755 --- a/installperl +++ b/installperl @@ -307,7 +307,7 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM my $mainperl_is_instperl = 0; -if ($Config{installusrbinperl} eq 'define' && +if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' && !$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR && -w $mainperldir && ! samepath($mainperldir, $installbin)) { my($usrbinperl) = "$mainperldir/$perl$exe_ext"; @@ -465,7 +465,7 @@ sub yn { my($prompt) = @_; my($answer); my($default) = $prompt =~ m/\[([yn])\]\s*$/i; - print $prompt; + print STDERR $prompt; chop($answer = <STDIN>); $answer = $default if $answer =~ m/^\s*$/; ($answer =~ m/^[yY]/); diff --git a/intrpvar.h b/intrpvar.h index 8ed93f8fc9..f84de796c7 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -245,19 +245,19 @@ PERLVARI(Ish_path, char *, SH_PATH)/* full path of shell */ PERLVAR(Isighandlerp, Sighandler_t) PERLVAR(Ixiv_arenaroot, XPV*) /* list of allocated xiv areas */ -PERLVAR(Ixiv_root, IV *) /* free xiv list--shared by interpreters */ -PERLVAR(Ixnv_root, NV *) /* free xnv list--shared by interpreters */ -PERLVAR(Ixrv_root, XRV *) /* free xrv list--shared by interpreters */ -PERLVAR(Ixpv_root, XPV *) /* free xpv list--shared by interpreters */ -PERLVAR(Ixpviv_root, XPVIV *) /* free xpviv list--shared by interpreters */ -PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list--shared by interpreters */ -PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list--shared by interpreters */ -PERLVAR(Ixpvav_root, XPVAV *) /* free xpvav list--shared by interpreters */ -PERLVAR(Ixpvhv_root, XPVHV *) /* free xpvhv list--shared by interpreters */ -PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list--shared by interpreters */ -PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list--shared by interpreters */ -PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list--shared by interpreters */ -PERLVAR(Ihe_root, HE *) /* free he list--shared by interpreters */ +PERLVAR(Ixiv_root, IV *) /* free xiv list */ +PERLVAR(Ixnv_root, NV *) /* free xnv list */ +PERLVAR(Ixrv_root, XRV *) /* free xrv list */ +PERLVAR(Ixpv_root, XPV *) /* free xpv list */ +PERLVAR(Ixpviv_root, XPVIV *) /* free xpviv list */ +PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list */ +PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list */ +PERLVAR(Ixpvav_root, XPVAV *) /* free xpvav list */ +PERLVAR(Ixpvhv_root, XPVHV *) /* free xpvhv list */ +PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list */ +PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list */ +PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list */ +PERLVAR(Ihe_root, HE *) /* free he list */ PERLVAR(Inice_chunk, char *) /* a nice chunk of memory to reuse */ PERLVAR(Inice_chunk_size, U32) /* how nice the chunk of memory is */ @@ -444,4 +444,26 @@ PERLVAR(IProc, struct IPerlProc*) PERLVAR(Iptr_table, PTR_TBL_t*) #endif +#ifdef USE_THREADS +PERLVAR(Ifdpid_mutex, perl_mutex) /* mutex for fdpid array */ +PERLVAR(Isv_lock_mutex, perl_mutex) /* mutex for SvLOCK macro */ +#endif + PERLVAR(Inullstash, HV *) /* illegal symbols end up here */ + +PERLVAR(Ixnv_arenaroot, XPV*) /* list of allocated xnv areas */ +PERLVAR(Ixrv_arenaroot, XPV*) /* list of allocated xrv areas */ +PERLVAR(Ixpv_arenaroot, XPV*) /* list of allocated xpv areas */ +PERLVAR(Ixpviv_arenaroot,XPVIV*) /* list of allocated xpviv areas */ +PERLVAR(Ixpvnv_arenaroot,XPVNV*) /* list of allocated xpvnv areas */ +PERLVAR(Ixpvcv_arenaroot,XPVCV*) /* list of allocated xpvcv areas */ +PERLVAR(Ixpvav_arenaroot,XPVAV*) /* list of allocated xpvav areas */ +PERLVAR(Ixpvhv_arenaroot,XPVHV*) /* list of allocated xpvhv areas */ +PERLVAR(Ixpvmg_arenaroot,XPVMG*) /* list of allocated xpvmg areas */ +PERLVAR(Ixpvlv_arenaroot,XPVLV*) /* list of allocated xpvlv areas */ +PERLVAR(Ixpvbm_arenaroot,XPVBM*) /* list of allocated xpvbm areas */ +PERLVAR(Ihe_arenaroot, XPV*) /* list of allocated he areas */ + +/* New variables must be added to the very end for binary compatibility. + * XSUB.h provides wrapper functions via perlapi.h that make this + * irrelevant, but not all code may be expected to #include XSUB.h. */ diff --git a/jpl/JNI/Makefile.PL b/jpl/JNI/Makefile.PL index 1a54b9d82c..754bde68ed 100644 --- a/jpl/JNI/Makefile.PL +++ b/jpl/JNI/Makefile.PL @@ -115,11 +115,12 @@ sub find_stuff { my ($candidates, $locations) = @_; - my $lib; + my ($pos,$lib); $wanted = sub { foreach my $name (@$candidates) { - if (/$name$/ and ! /green_threads/ and !/include-old/) { - $lib = $File::Find::name; + $pos = $File::Find::name; + if (/$name$/ && $pos !~ /green_threads/ && $pos !~ /include-old/) { + $lib = $pos; } } }; diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index 8fd7d3b8fe..c26db72394 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -140,6 +140,11 @@ sub import { } } +sub unimport { + my $callpkg = caller; + eval "package $callpkg; sub AUTOLOAD;"; +} + 1; __END__ @@ -259,6 +264,12 @@ the package namespace. Variables pre-declared with this pragma will be visible to any autoloaded routines (but will not be invisible outside the package, unfortunately). +=head2 Not Using AutoLoader + +You can stop using AutoLoader by simply + + no AutoLoader; + =head2 B<AutoLoader> vs. B<SelfLoader> The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm index 0be3ae6765..8640576cc7 100644 --- a/lib/AutoSplit.pm +++ b/lib/AutoSplit.pm @@ -6,6 +6,7 @@ use Config qw(%Config); use Carp qw(carp); use File::Basename (); use File::Path qw(mkpath); +use File::Spec::Functions qw(curdir catfile); use strict; our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen, $CheckForAutoloader, $CheckModTime); @@ -173,16 +174,23 @@ sub autosplit_lib_modules{ my(@modules) = @_; # list of Module names while(defined($_ = shift @modules)){ - s#::#/#g; # incase specified as ABC::XYZ + while (m#(.*?[^:])::([^:].*)#) { # in case specified as ABC::XYZ + $_ = catfile($1, $2); + } s|\\|/|g; # bug in ksh OS/2 s#^lib/##s; # incase specified as lib/*.pm + my($lib) = catfile(curdir(), "lib"); + if ($Is_VMS) { # may need to convert VMS-style filespecs + $lib =~ s#^\[\]#.\/#; + } + s#^$lib\W+##s; # incase specified as ./lib/*.pm if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs my ($dir,$name) = (/(.*])(.*)/s); $dir =~ s/.*lib[\.\]]//s; $dir =~ s#[\.\]]#/#g; $_ = $dir . $name; } - autosplit_file("lib/$_", "lib/auto", + autosplit_file(catfile($lib, $_), catfile($lib, "auto"), $Keep, $CheckForAutoloader, $CheckModTime); } 0; @@ -199,7 +207,7 @@ sub autosplit_file { local($/) = "\n"; # where to write output files - $autodir ||= "lib/auto"; + $autodir ||= catfile(curdir(), "lib", "auto"); if ($Is_VMS) { ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||; $filename = VMS::Filespec::unixify($filename); # may have dirs @@ -245,6 +253,9 @@ sub autosplit_file { $def_package or die "Can't find 'package Name;' in $filename\n"; my($modpname) = _modpname($def_package); + if ($Is_VMS) { + $modpname = VMS::Filespec::unixify($modpname); # may have dirs + } # this _has_ to match so we have a reasonable timestamp file die "Package $def_package ($modpname.pm) does not ". @@ -264,11 +275,12 @@ sub autosplit_file { } } - print "AutoSplitting $filename ($autodir/$modpname)\n" + my($modnamedir) = catfile($autodir, $modpname); + print "AutoSplitting $filename ($modnamedir)\n" if $Verbose; - unless (-d "$autodir/$modpname"){ - mkpath("$autodir/$modpname",0,0777); + unless (-d "$modnamedir"){ + mkpath("$modnamedir",0,0777); } # We must try to deal with some SVR3 systems with a limit of 14 @@ -311,9 +323,10 @@ sub autosplit_file { push(@subnames, $fq_subname); my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); $modpname = _modpname($this_package); - mkpath("$autodir/$modpname",0,0777); - my($lpath) = "$autodir/$modpname/$lname.al"; - my($spath) = "$autodir/$modpname/$sname.al"; + my($modnamedir) = catfile($autodir, $modpname); + mkpath("$modnamedir",0,0777); + my($lpath) = catfile($modnamedir, "$lname.al"); + my($spath) = catfile($modnamedir, "$sname.al"); my $path; if (!$Is83 and open(OUT, ">$lpath")){ $path=$lpath; @@ -379,7 +392,7 @@ EOT opendir(OUTDIR,$dir); foreach (sort readdir(OUTDIR)){ next unless /\.al\z/; - my($file) = "$dir/$_"; + my($file) = catfile($dir, $_); $file = lc $file if $Is83 or $Is_VMS; next if $outfiles{$file}; print " deleting $file\n" if ($Verbose>=2); @@ -418,7 +431,9 @@ sub _modpname ($) { if ($^O eq 'MSWin32') { $modpname =~ s#::#\\#g; } else { - $modpname =~ s#::#/#g; + while ($modpname =~ m#(.*?[^:])::([^:].*)#) { + $modpname = catfile($1, $2); + } } $modpname; } diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm index 0a5c48b6f3..cb6dd8a9e2 100644 --- a/lib/CGI/Util.pm +++ b/lib/CGI/Util.pm @@ -1,5 +1,13 @@ package CGI::Util; +=pod + +=head1 NAME + +CGI::Util - various utilities + +=cut + use strict; use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E'; require Exporter; diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 9a92829da5..d86428cdb8 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -70,7 +70,7 @@ kept up to date if all packages which use chdir import it from Cwd. use Carp; -$VERSION = '2.02'; +$VERSION = '2.03'; require Exporter; @ISA = qw(Exporter); @@ -200,63 +200,39 @@ sub chdir { 1; } -# Taken from Cwd.pm It is really getcwd with an optional -# parameter instead of '.' -# -sub abs_path -{ - my $start = @_ ? shift : '.'; - my($dotdots, $cwd, @pst, @cst, $dir, @tst); +# By Jeff "japhy" Pinyan (07/23/2000) +# usage: abs_path(PATHNAME) +# see the docs + +sub abs_path { + my $base = @_ ? $_[0] : "."; + my $path = ""; + my $file; + + do { + my @devino = (stat($base))[0,1] or + carp("stat($base): $!"), return; - unless (@cst = stat( $start )) - { - carp "stat($start): $!"; - return ''; + $base .= "/.."; + + opendir PREV, $base or carp("opendir($base): $!"), return; + while (defined($file = readdir PREV)) { + next if $file eq "." or $file eq ".."; + my @entry = (lstat("$base/$file"))[0,1] or + carp("lstat($base/$file): $!"), return; + last if $devino[0] == $entry[0] and $devino[1] == $entry[1]; } - $cwd = ''; - $dotdots = $start; - do - { - $dotdots .= '/..'; - @pst = @cst; - unless (opendir(PARENT, $dotdots)) - { - carp "opendir($dotdots): $!"; - return ''; - } - unless (@cst = stat($dotdots)) - { - carp "stat($dotdots): $!"; - closedir(PARENT); - return ''; - } - if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) - { - $dir = undef; - } - else - { - do - { - unless (defined ($dir = readdir(PARENT))) - { - carp "readdir($dotdots): $!"; - closedir(PARENT); - return ''; - } - $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) - } - while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || - $tst[1] != $pst[1]); - } - $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; - closedir(PARENT); - } while (defined $dir); - chop($cwd) unless $cwd eq '/'; # drop the trailing / - $cwd; + closedir PREV; + + $path = (defined $file and $file) . "/$path"; + } while defined $file; + + length($path) > 1 and chop $path; + return $path; } + # added function alias for those of us more # used to the libc function. --tchrist 27-Jan-00 *realpath = \&abs_path; diff --git a/lib/English.pm b/lib/English.pm index f38c313beb..1ebc3de11d 100644 --- a/lib/English.pm +++ b/lib/English.pm @@ -9,6 +9,7 @@ English - use nice English (or awk) names for ugly punctuation variables =head1 SYNOPSIS + use English qw( -no_match_vars ) ; # Avoids regex performance penalty use English; ... if ($ERRNO =~ /denied/) { ... } @@ -27,29 +28,52 @@ $INPUT_RECORD_SEPARATOR if you are using the English module. See L<perlvar> for a complete list of these. -=head1 BUGS +=head1 PERFORMANCE -This module provokes sizeable inefficiencies for regular expressions, -due to unfortunate implementation details. If performance matters, -consider avoiding English. +This module can provoke sizeable inefficiencies for regular expressions, +due to unfortunate implementation details. If performance matters in +your application and you don't need $PREMATCH, $MATCH, or $POSTMATCH, +try doing + + use English qw( -no_match_vars ) ; + +. B<It is especially important to do this in modules to avoid penalizing +all applications which use them.> =cut no warnings; +my $globbed_match ; + # Grandfather $NAME import sub import { my $this = shift; - my @list = @_; + my @list = grep { ! /^-no_match_vars$/ } @_ ; local $Exporter::ExportLevel = 1; + if ( @_ == @list ) { + *EXPORT = \@COMPLETE_EXPORT ; + $globbed_match ||= ( + eval q{ + *MATCH = *& ; + *PREMATCH = *` ; + *POSTMATCH = *' ; + 1 ; + } + || do { + require Carp ; + Carp::croak "Can't create English for match leftovers: $@" ; + } + ) ; + } + else { + *EXPORT = \@MINIMAL_EXPORT ; + } Exporter::import($this,grep {s/^\$/*/} @list); } -@EXPORT = qw( +@MINIMAL_EXPORT = qw( *ARG - *MATCH - *PREMATCH - *POSTMATCH *LAST_PAREN_MATCH *INPUT_LINE_NUMBER *NR @@ -102,15 +126,21 @@ sub import { @LAST_MATCH_END ); + +@MATCH_EXPORT = qw( + *MATCH + *PREMATCH + *POSTMATCH +); + +@COMPLETE_EXPORT = ( @MINIMAL_EXPORT, @MATCH_EXPORT ) ; + # The ground of all being. @ARG is deprecated (5.005 makes @_ lexical) *ARG = *_ ; # Matching. - *MATCH = *& ; - *PREMATCH = *` ; - *POSTMATCH = *' ; *LAST_PAREN_MATCH = *+ ; *LAST_MATCH_START = *-{ARRAY} ; *LAST_MATCH_END = *+{ARRAY} ; diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index da2255271f..8e337d97fa 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -457,7 +457,7 @@ EOT push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core core.*perl.*.? *perl.core so_locations pm_to_blib - *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe + *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp ]); @@ -1249,11 +1249,6 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' next; } my($dev,$ino,$mode) = stat FIXIN; - # If they override perm_rwx, we won't notice it during fixin, - # because fixin is run through a new instance of MakeMaker. - # That is why we must run another CHMOD later. - $mode = oct($self->perm_rwx) unless $dev; - chmod $mode, $file; # Print out the new #! line (or equivalent). local $\; @@ -1261,7 +1256,15 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' print FIXOUT $shb, <FIXIN>; close FIXIN; close FIXOUT; - # can't rename open files on some DOSISH platforms + + # can't rename/chmod open files on some DOSISH platforms + + # If they override perm_rwx, we won't notice it during fixin, + # because fixin is run through a new instance of MakeMaker. + # That is why we must run another CHMOD later. + $mode = oct($self->perm_rwx) unless $dev; + chmod $mode, $file; + unless ( rename($file, "$file.bak") ) { warn "Can't rename $file to $file.bak: $!"; next; @@ -1276,6 +1279,7 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' } unlink "$file.bak"; } continue { + close(FIXIN) if fileno(FIXIN); chmod oct($self->perm_rwx), $file or die "Can't reset permissions for $file: $!\n"; system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';; diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 1e6c61a4c8..d21a56acba 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -626,7 +626,7 @@ INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR} if ($self->has_link_code()) { push @m,' INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT) -INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)$(DLBASE).$(DLEXT) INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs '; } else { diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 9906fd5383..bef12b54da 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -82,7 +82,7 @@ if ($Is_OS2) { require ExtUtils::MM_OS2; } if ($Is_Mac) { - require ExtUtils::MM_Mac; + require ExtUtils::MM_MacOS; } if ($Is_Win32) { require ExtUtils::MM_Win32; diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index a34cd4f9ea..0260678570 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -1,4 +1,3 @@ -# $Header: /home/rmb1/misc/CVS/perl5.005_61/lib/ExtUtils/typemap,v 1.3 1999/09/13 09:46:43 rmb1 Exp $ # basic C types int T_IV unsigned T_UV diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 5a71e89636..1e9ff45cc9 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -288,7 +288,7 @@ $END = "!End!\n\n"; # "impossible" keyword (multiple newline) # Match an XS keyword $BLOCK_re= '\s*(' . join('|', qw( REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT - CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE + CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL )) . "|$END)\\s*:"; @@ -573,6 +573,15 @@ sub GetAliases if $line ; } +sub ATTRS_handler () +{ + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_) ; + push @Attributes, $_; + } +} + sub ALIAS_handler () { for (; !/^$BLOCK_re/o; $_ = shift(@line)) { @@ -847,7 +856,14 @@ EOM print("#line 1 \"$filename\"\n") if $WantLineNumbers; +firstmodule: while (<$FH>) { + if (/^=/) { + do { + next firstmodule if /^=cut\s*$/; + } while (<$FH>); + &Exit; + } last if ($Module, $Package, $Prefix) = /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; @@ -886,6 +902,16 @@ sub fetch_para { } for(;;) { + # Skip embedded PODs + while ($lastline =~ /^=/) { + while ($lastline = <$FH>) { + last if ($lastline =~ /^=cut\s*$/); + } + death ("Error: Unterminated pod") unless $lastline; + $lastline = <$FH>; + chomp $lastline; + $lastline =~ s/^\s+$//; + } if ($lastline !~ /^\s*#/ || # CPP directives: # ANSI: if ifdef ifndef elif else endif define undef @@ -1039,7 +1065,7 @@ while (fetch_para()) { last; } $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ; - %XsubAliases = %XsubAliasValues = %Interfaces = (); + %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = (); $DoSetMagic = 1; $orig_args =~ s/\\\s*/ /g; # process line continuations @@ -1210,7 +1236,7 @@ EOF $gotRETVAL = 0; INPUT_handler() ; - process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ; + process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE") ; print Q<<"EOF" if $ScopeThisXSUB; # ENTER; @@ -1252,7 +1278,7 @@ EOF } print $deferred; - process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; + process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; if (check_keyword("PPCODE")) { print_section(); @@ -1296,7 +1322,7 @@ EOF # $wantRETVAL set if 'RETVAL =' autogenerated ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return; undef %outargs ; - process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); + process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE"); # all OUTPUT done, so now push the return value on the stack if ($gotRETVAL && $RETVAL_code) { @@ -1341,7 +1367,7 @@ EOF generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out; # do cleanup - process_keyword("CLEANUP|ALIAS|PROTOTYPE") ; + process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE") ; print Q<<"EOF" if $ScopeThisXSUB; # ]] @@ -1431,6 +1457,12 @@ EOF EOF } } + elsif (@Attributes) { + push(@InitFileCode, Q<<"EOF"); +# cv = newXS(\"$pname\", XS_$Full_func_name, file); +# apply_attrs_string("$Package", cv, "@Attributes", 0); +EOF + } elsif ($interface) { while ( ($name, $value) = each %Interfaces) { $name = "$Package\::$name" unless $name =~ /::/; diff --git a/lib/File/Find.pm b/lib/File/Find.pm index ac73f1b5eb..a9f190c722 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -373,7 +373,7 @@ sub _find_opt { $name = $abs_dir . $_; - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } @@ -429,7 +429,7 @@ sub _find_dir($$$) { $_= ($no_chdir ? $dir_name : $dir_rel ); # prune may happen here $prune= 0; - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" next if $prune; } @@ -472,7 +472,7 @@ sub _find_dir($$$) { $name = $dir_pref . $FN; $_ = ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } @@ -496,13 +496,13 @@ sub _find_dir($$$) { else { $name = $dir_pref . $FN; $_= ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } else { $name = $dir_pref . $FN; $_= ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } } @@ -528,7 +528,7 @@ sub _find_dir($$$) { if ( substr($_,-2) eq '/.' ) { s|/\.$||; } - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } else { push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; last; @@ -584,13 +584,25 @@ sub _find_dir_symlnk($$$) { while (defined $SE) { unless ($bydepth) { + # change to parent directory + unless ($no_chdir) { + my $udir = $pdir_loc; + if ($untaint) { + $udir = $1 if $pdir_loc =~ m|$untaint_pat|; + } + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + next; + } + } $dir= $p_dir; $name= $dir_name; $_= ($no_chdir ? $dir_name : $dir_rel ); $fullname= $dir_loc; # prune may happen here $prune= 0; - &$wanted_callback; + lstat($_); # make sure file tests with '_' work + { &$wanted_callback }; # protect against wild "next" next if $prune; } @@ -640,7 +652,7 @@ sub _find_dir_symlnk($$$) { $fullname = $new_loc; $name = $dir_pref . $FN; $_ = ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } @@ -673,7 +685,8 @@ sub _find_dir_symlnk($$$) { s|/\.$||; } - &$wanted_callback; + lstat($_); # make sure file tests with '_' work + { &$wanted_callback }; # protect against wild "next" } else { push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1] if $bydepth; last; @@ -721,7 +734,8 @@ if ($^O eq 'VMS') { } $File::Find::dont_use_nlink = 1 - if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; + if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' || + $^O eq 'cygwin'; # Set dont_use_nlink in your hint file if your system's stat doesn't # report the number of links in a directory as an indication diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index ed26d76a56..40503c467f 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '0.81'; +$VERSION = 0.82 ; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index 5315d9220f..9ef55ec84a 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '1.1'; +$VERSION = '1.2'; @ISA = qw(File::Spec::Unix); @@ -192,12 +192,16 @@ folder named "HD" in the current working directory on a drive named "HD"), relative wins. Use ":" in the appropriate place in the path if you want to distinguish unambiguously. +As a special case, the file name '' is always considered to be absolute. + =cut sub file_name_is_absolute { my ($self,$file) = @_; if ($file =~ /:/) { return ($file !~ m/^:/s); + } elsif ( $file eq '' ) { + return 1 ; } else { return (! -e ":$file"); } @@ -307,6 +311,12 @@ sub catpath { =item abs2rel +See L<File::Spec::Unix/abs2rel> for general documentation. + +Unlike C<File::Spec::Unix->abs2rel()>, this function will make +checks against the local filesystem if necessary. See +L</file_name_is_absolute> for details. + =cut sub abs2rel { @@ -344,31 +354,15 @@ sub abs2rel { =item rel2abs -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L<cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()>. - -On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L</canonpath()>. - -Based on code written by Shigio Yamaguchi. +See L<File::Spec::Unix/rel2abs> for general documentation. -No checks against the filesystem are made. +Unlike C<File::Spec::Unix->rel2abs()>, this function will make +checks against the local filesystem if necessary. See +L</file_name_is_absolute> for details. =cut -sub rel2abs($;$;) { +sub rel2abs { my ($self,$path,$base ) = @_; if ( ! $self->file_name_is_absolute( $path ) ) { diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 6ca26d74ce..a81c533235 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '1.1'; +$VERSION = '1.2'; use Cwd; @@ -165,7 +165,12 @@ sub case_tolerant { =item file_name_is_absolute -Takes as argument a path and returns true, if it is an absolute path. +Takes as argument a path and returns true if it is an absolute path. + +This does not consult the local filesystem on Unix, Win32, or OS/2. It +does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>). +It does consult the working environment for VMS (see +L<File::Spec::VMS/file_name_is_absolute>). =cut @@ -311,8 +316,8 @@ sub catpath { Takes a destination path and an optional base path returns a relative path from the base path to the destination path: - $rel_path = File::Spec->abs2rel( $destination ) ; - $rel_path = File::Spec->abs2rel( $destination, $base ) ; + $rel_path = File::Spec->abs2rel( $path ) ; + $rel_path = File::Spec->abs2rel( $path, $base ) ; If $base is not present or '', then L<cwd()> is used. If $base is relative, then it is converted to absolute form using L</rel2abs()>. This means that it @@ -328,9 +333,13 @@ directories. If $path is relative, it is converted to absolute form using L</rel2abs()>. This means that it is taken to be relative to L<cwd()>. -Based on code written by Shigio Yamaguchi. +No checks against the filesystem are made on most systems. On MacOS, +the filesystem may be consulted (see +L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is +interaction with the working environment, as logicals and +macros are expanded. -No checks against the filesystem are made. +Based on code written by Shigio Yamaguchi. =cut @@ -388,15 +397,15 @@ sub abs2rel { Converts a relative path to an absolute path. - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; + $abs_path = File::Spec->rel2abs( $path ) ; + $abs_path = File::Spec->rel2abs( $path, $base ) ; If $base is not present or '', then L<cwd()> is used. If $base is relative, then it is converted to absolute form using L</rel2abs()>. This means that it is taken to be relative to L<cwd()>. On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $destination volume. +are on the $base volume, and ignores the $path volume. On systems that have a grammar that indicates filenames, this ignores the $base filename as well. Otherwise all path components are assumed to be @@ -404,13 +413,17 @@ directories. If $path is absolute, it is cleaned up and returned using L</canonpath()>. -Based on code written by Shigio Yamaguchi. +No checks against the filesystem are made on most systems. On MacOS, +the filesystem may be consulted (see +L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is +interaction with the working environment, as logicals and +macros are expanded. -No checks against the filesystem are made. +Based on code written by Shigio Yamaguchi. =cut -sub rel2abs($;$;) { +sub rel2abs { my ($self,$path,$base ) = @_; # Clean up $path diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index cc06ca636d..60b0ec8e50 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -265,7 +265,7 @@ sub rootdir { Returns a string representation of the first writable directory from the following list or '' if none are writable: - sys$scratch + sys$scratch: $ENV{TMPDIR} =cut @@ -273,7 +273,7 @@ from the following list or '' if none are writable: my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - foreach ('sys$scratch', $ENV{TMPDIR}) { + foreach ('sys$scratch:', $ENV{TMPDIR}) { next unless defined && -d && -w _; $tmpdir = $_; last; @@ -451,7 +451,7 @@ Use VMS syntax when converting filespecs. =cut -sub rel2abs($;$;) { +sub rel2abs { my $self = shift ; return vmspath(File::Spec::Unix::rel2abs( $self, @_ )) if ( join( '', @_ ) =~ m{/} ) ; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index b8fe37bbdb..f5d6cda2bc 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use Cwd; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '1.1'; +$VERSION = '1.2'; @ISA = qw(File::Spec::Unix); @@ -242,34 +242,6 @@ sub catpath { } -=item abs2rel - -Takes a destination path and an optional base path returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $destination ) ; - $rel_path = File::Spec->abs2rel( $destination, $base ) ; - -If $base is not present or '', then L</cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()>. - -On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is relative, it is converted to absolute form using L</rel2abs()>. -This means that it is taken to be relative to L</cwd()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - sub abs2rel { my($self,$path,$base) = @_; @@ -339,33 +311,8 @@ sub abs2rel { ) ; } -=item rel2abs - -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L<cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L</cwd()>. - -Assumes that both paths are on the $base volume, and ignores the -$destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L</canonpath()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut -sub rel2abs($;$;) { +sub rel2abs { my ($self,$path,$base ) = @_; if ( ! $self->file_name_is_absolute( $path ) ) { diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm index 736ef3fdb3..aac8b7a93c 100644 --- a/lib/File/Temp.pm +++ b/lib/File/Temp.pm @@ -92,6 +92,10 @@ use File::Path qw/ rmtree /; use Fcntl 1.03; use Errno qw( EEXIST ENOENT ENOTDIR EINVAL ); +# Need the Symbol package if we are running older perl +require Symbol if $] < 5.006; + + # use 'our' on v5.6.0 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG); @@ -99,8 +103,6 @@ $DEBUG = 0; # We are exporting functions -#require Exporter; -#@ISA = qw/Exporter/; use base qw/Exporter/; # Export list - to allow fine tuning of export table @@ -111,7 +113,7 @@ use base qw/Exporter/; tmpnam tmpfile mktemp - mkstemp + mkstemp mkstemps mkdtemp unlink0 @@ -129,13 +131,13 @@ Exporter::export_tags('POSIX','mktemp'); # Version number -$VERSION = '0.07'; +$VERSION = '0.09'; # This is a list of characters that can be used in random filenames my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z - 0 1 2 3 4 5 6 7 8 9 _ + 0 1 2 3 4 5 6 7 8 9 _ /); # Maximum number of tries to make a temp file before failing @@ -155,12 +157,25 @@ use constant STANDARD => 0; use constant MEDIUM => 1; use constant HIGH => 2; +# OPENFLAGS. If we defined the flag to use with Sysopen here this gives +# us an optimisation when many temporary files are requested + +my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR; + +for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) { + my ($bit, $func) = (0, "Fcntl::O_" . $oflag); + no strict 'refs'; + $OPENFLAGS |= $bit if eval { $bit = &$func(); 1 }; +} + + + # INTERNAL ROUTINES - not to be used outside of package # Generic routine for getting a temporary filename # modelled on OpenBSD _gettemp() in mktemp.c -# The template must contain X's that are to be replaced +# The template must contain X's that are to be replaced # with the random values # Arguments: @@ -216,7 +231,7 @@ sub _gettemp { # Read the options and merge with defaults %options = (%options, @_) if @_; - + # Can not open the file and make a directory in a single call if ($options{"open"} && $options{"mkdir"}) { carp "File::Temp::_gettemp: doopen and domkdir can not both be true\n"; @@ -268,11 +283,16 @@ sub _gettemp { $parent = File::Spec->curdir; } else { - # Put it back together without the last one - $parent = File::Spec->catdir(@dirs[0..$#dirs-1]); + if ($^O eq 'VMS') { # need volume to avoid relative dir spec + $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]); + } else { - # ...and attach the volume (no filename) - $parent = File::Spec->catpath($volume, $parent, ''); + # Put it back together without the last one + $parent = File::Spec->catdir(@dirs[0..$#dirs-1]); + + # ...and attach the volume (no filename) + $parent = File::Spec->catpath($volume, $parent, ''); + } } @@ -296,7 +316,7 @@ sub _gettemp { # that does not exist or is not writable unless (-d $parent && -w _) { - carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory" + carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory" . " or is not writable\n"; return (); } @@ -320,19 +340,18 @@ sub _gettemp { # Calculate the flags that we wish to use for the sysopen # Some of these are not always available - my $openflags; - if ($options{"open"}) { +# my $openflags; +# if ($options{"open"}) { # Default set - $openflags = O_CREAT | O_EXCL | O_RDWR; +# $openflags = O_CREAT | O_EXCL | O_RDWR; - for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) { - my ($bit, $func) = (0, "Fcntl::O_" . $oflag); - no strict 'refs'; - $openflags |= $bit if eval { $bit = &$func(); 1 }; - } +# for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) { +# my ($bit, $func) = (0, "Fcntl::O_" . $oflag); +# no strict 'refs'; +# $openflags |= $bit if eval { $bit = &$func(); 1 }; +# } - } - +# } # Now try MAX_TRIES time to open the file for (my $i = 0; $i < MAX_TRIES; $i++) { @@ -343,7 +362,6 @@ sub _gettemp { # If we are running before perl5.6.0 we can not auto-vivify if ($] < 5.006) { - require Symbol; $fh = &Symbol::gensym; } @@ -359,7 +377,7 @@ sub _gettemp { umask(066); # Attempt to open the file - if ( sysopen($fh, $path, $openflags, 0600) ) { + if ( sysopen($fh, $path, $OPENFLAGS, 0600) ) { # Reset umask umask($umask); @@ -419,10 +437,10 @@ sub _gettemp { return (undef, $path) unless -e $path; - # Try again until MAX_TRIES + # Try again until MAX_TRIES } - + # Did not successfully open the tempfile/dir # so try again with a different set of random letters # No point in trying to increment unless we have only @@ -449,7 +467,7 @@ sub _gettemp { # Check for out of control looping if ($counter > $MAX_GUESS) { - carp "Tried to get a new temp name different to the previous value$MAX_GUESS times.\nSomething wrong with template?? ($template)"; + carp "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)"; return (); } @@ -469,6 +487,10 @@ sub _gettemp { # No arguments. Return value is the random character +# No longer called since _replace_XX runs a few percent faster if +# I inline the code. This is important if we are creating thousands of +# temporary files. + sub _randchar { $CHARS[ int( rand( $#CHARS ) ) ]; @@ -497,18 +519,18 @@ sub _replace_XX { # Don't want to always use substr when not required though. if ($ignore) { - substr($path, 0, - $ignore) =~ s/X(?=X*\z)/_randchar()/ge; + substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge; } else { - $path =~ s/X(?=X*\z)/_randchar()/ge; + $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge; } return $path; } # internal routine to check to see if the directory is safe -# First checks to see if the directory is not owned by the +# First checks to see if the directory is not owned by the # current user or root. Then checks to see if anyone else -# can write to the directory and if so, checks to see if +# can write to the directory and if so, checks to see if # it has the sticky bit set # Will not work on systems that do not support sticky bit @@ -530,6 +552,7 @@ sub _is_safe { # Stat path my @info = stat($path); return 0 unless scalar(@info); + return 1 if $^O eq 'VMS'; # owner delete control at file level # Check to see whether owner is neither superuser (or a system uid) nor me # Use the real uid from the $< variable @@ -567,6 +590,7 @@ sub _is_verysafe { require POSIX; my $path = shift; + return 1 if $^O eq 'VMS'; # owner delete control at file level # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined # and If it is not there do the extensive test @@ -626,19 +650,48 @@ sub _is_verysafe { # platform for files that are currently open. # Returns true if we can, false otherwise. -# Currently WinNT can not unlink an opened file +# Currently WinNT, OS/2 and VMS can not unlink an opened file +# On VMS this is because the O_EXCL flag is used to open the +# temporary file. Currently I do not know enough about the issues +# on VMS to decide whether O_EXCL is a requirement. sub _can_unlink_opened_file { - - $^O ne 'MSWin32' ? 1 : 0; + if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS') { + return 0; + } else { + return 1; + } } +# internal routine to decide which security levels are allowed +# see safe_level() for more information on this + +# Controls whether the supplied security level is allowed + +# $cando = _can_do_level( $level ) + +sub _can_do_level { + + # Get security level + my $level = shift; + + # Always have to be able to do STANDARD + return 1 if $level == STANDARD; + + # Currently, the systems that can do HIGH or MEDIUM are identical + if ( $^O eq 'MSWin32' || $^O eq 'os2') { + return 0; + } else { + return 1; + } + +} # This routine sets up a deferred unlinking of a specified # filename and filehandle. It is used in the following cases: -# - Called by unlink0 if an opend file can not be unlinked +# - Called by unlink0 if an opened file can not be unlinked # - Called by tempfile() if files are to be removed on shutdown # - Called by tempdir() if directories are to be removed on shutdown @@ -650,71 +703,84 @@ sub _can_unlink_opened_file { # - isdir (flag to indicate that we are being given a directory) # [and hence no filehandle] -# Status is not referred since all the magic is done with END blocks +# Status is not referred to since all the magic is done with and END block -sub _deferred_unlink { +{ + # Will set up two lexical variables to contain all the files to be + # removed. One array for files, another for directories + # They will only exist in this block + # This means we only have to set up a single END block to remove all files + # @files_to_unlink contains an array ref with the filehandle and filename + my (@files_to_unlink, @dirs_to_unlink); + + # Set up an end block to use these arrays + END { + # Files + foreach my $file (@files_to_unlink) { + # close the filehandle without checking its state + # in order to make real sure that this is closed + # if its already closed then I dont care about the answer + # probably a better way to do this + close($file->[0]); # file handle is [0] + + if (-f $file->[1]) { # file name is [1] + unlink $file->[1] or warn "Error removing ".$file->[1]; + } + } + # Dirs + foreach my $dir (@dirs_to_unlink) { + if (-d $dir) { + rmtree($dir, $DEBUG, 1); + } + } - croak 'Usage: _deferred_unlink($fh, $fname, $isdir)' - unless scalar(@_) == 3; - my ($fh, $fname, $isdir) = @_; + } - warn "Setting up deferred removal of $fname\n" - if $DEBUG; + # This is the sub called to register a file for deferred unlinking + # This could simply store the input parameters and defer everything + # until the END block. For now we do a bit of checking at this + # point in order to make sure that (1) we have a file/dir to delete + # and (2) we have been called with the correct arguments. + sub _deferred_unlink { - # If we have a directory, check that it is a directory - if ($isdir) { + croak 'Usage: _deferred_unlink($fh, $fname, $isdir)' + unless scalar(@_) == 3; - if (-d $fname) { + my ($fh, $fname, $isdir) = @_; - # Directory exists so set up END block - # (quoted to preserve lexical variables) - eval q{ - END { - if (-d $fname) { - rmtree($fname, $DEBUG, 1); - } - } - 1; - } || die; + warn "Setting up deferred removal of $fname\n" + if $DEBUG; - } else { - carp "Request to remove directory $fname could not be completed since it does not exists!\n"; - } + # If we have a directory, check that it is a directory + if ($isdir) { + if (-d $fname) { - } else { + # Directory exists so store it + push (@dirs_to_unlink, $fname); - if (-f $fname) { - - # dile exists so set up END block - # (quoted to preserve lexical variables) - eval q{ - END { - # close the filehandle without checking its state - # in order to make real sure that this is closed - # if its already closed then I dont care about the answer - # probably a better way to do this - close($fh); - - if (-f $fname) { - unlink $fname - || warn "Error removing $fname"; - } - } - 1; - } || die; + } else { + carp "Request to remove directory $fname could not be completed since it does not exists!\n"; + } } else { - carp "Request to remove file $fname could not be completed since it is not there!\n"; - } + if (-f $fname) { + + # file exists so store handle and name for later removal + push(@files_to_unlink, [$fh, $fname]); + + } else { + carp "Request to remove file $fname could not be completed since it is not there!\n"; + } + + } - } -} +} =head1 FUNCTIONS @@ -807,7 +873,7 @@ sub tempfile { } - # Construct the template + # Construct the template # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc # functions or simply constructing a template and using _gettemp() @@ -829,11 +895,11 @@ sub tempfile { $template = File::Spec->catfile($options{"DIR"}, TEMPXXX); } else { - + $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX); } - + } # Now add a suffix @@ -846,13 +912,13 @@ sub tempfile { "open" => $options{'OPEN'}, "mkdir"=> 0 , "suffixlen" => length($options{'SUFFIX'}), - ) ); + ) ); # Set up an exit handler that can do whatever is right for the # system. Do not check return status since this is all done with # END blocks _deferred_unlink($fh, $path, 0) if $options{"UNLINK"}; - + # Return if (wantarray()) { @@ -867,7 +933,7 @@ sub tempfile { # Unlink the file. It is up to unlink0 to decide what to do with # this (whether to unlink now or to defer until later) unlink0($fh, $path) or croak "Error unlinking file $path using unlink0"; - + # Return just the filehandle. return $fh; } @@ -985,26 +1051,31 @@ sub tempdir { $template = File::Spec->catdir($options{"DIR"}, TEMPXXX); } else { - + $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX); } - + } # Create the directory my $tempdir; + my $suffixlen = 0; + if ($^O eq 'VMS') { # dir names can end in delimiters + $template =~ m/([\.\]:>]+)$/; + $suffixlen = length($1); + } croak "Error in tempdir() using $template" unless ((undef, $tempdir) = _gettemp($template, - "open" => 0, + "open" => 0, "mkdir"=> 1 , - "suffixlen" => 0, - ) ); - + "suffixlen" => $suffixlen, + ) ); + # Install exit handler; must be dynamic to get lexical - if ( $options{'CLEANUP'} && -d $tempdir) { + if ( $options{'CLEANUP'} && -d $tempdir) { _deferred_unlink(undef, $tempdir, 1); - } + } # Return the dir name return $tempdir; @@ -1046,8 +1117,8 @@ sub mkstemp { my ($fh, $path); croak "Error in mkstemp using $template" - unless (($fh, $path) = _gettemp($template, - "open" => 1, + unless (($fh, $path) = _gettemp($template, + "open" => 1, "mkdir"=> 0 , "suffixlen" => 0, ) ); @@ -1085,7 +1156,7 @@ sub mkstemps { my $suffix = shift; $template .= $suffix; - + my ($fh, $path); croak "Error in mkstemps using $template" unless (($fh, $path) = _gettemp($template, @@ -1122,15 +1193,19 @@ sub mkdtemp { croak "Usage: mkdtemp(template)" if scalar(@_) != 1; - - my $template = shift; + my $template = shift; + my $suffixlen = 0; + if ($^O eq 'VMS') { # dir names can end in delimiters + $template =~ m/([\.\]:>]+)$/; + $suffixlen = length($1); + } my ($junk, $tmpdir); croak "Error creating temp directory from template $template\n" unless (($junk, $tmpdir) = _gettemp($template, - "open" => 0, + "open" => 0, "mkdir"=> 1 , - "suffixlen" => 0, + "suffixlen" => $suffixlen, ) ); return $tmpdir; @@ -1158,7 +1233,7 @@ sub mktemp { my ($tmpname, $junk); croak "Error getting name to temp file from template $template\n" unless (($junk, $tmpname) = _gettemp($template, - "open" => 0, + "open" => 0, "mkdir"=> 0 , "suffixlen" => 0, ) ); @@ -1217,7 +1292,7 @@ sub tmpnam { # Use a ten character template and append to tmpdir my $template = File::Spec->catfile($tmpdir, TEMPXXX); - + if (wantarray() ) { return mkstemp($template); } else { @@ -1320,11 +1395,11 @@ occasions this is not required. On some platforms, for example Windows NT, it is not possible to unlink an open file (the file must be closed first). On those -platforms, the actual unlinking is deferred until the program ends -and good status is returned. A check is still performed to make sure that -the filehandle and filename are pointing to the same thing (but not at the time -the end block is executed since the deferred removal may not have access to -the filehandle). +platforms, the actual unlinking is deferred until the program ends and +good status is returned. A check is still performed to make sure that +the filehandle and filename are pointing to the same thing (but not at +the time the end block is executed since the deferred removal may not +have access to the filehandle). Additionally, on Windows NT not all the fields returned by stat() can be compared. For example, the C<dev> and C<rdev> fields seem to be different @@ -1334,6 +1409,10 @@ C<stat(filename)>, presumably because of caching issues even when using autoflush (this is usually overcome by waiting a while after writing to the tempfile before attempting to C<unlink0> it). +Finally, on NFS file systems the link count of the file handle does +not always go to zero immediately after unlinking. Currently, this +command is expected to fail on NFS disks. + =cut sub unlink0 { @@ -1352,7 +1431,7 @@ sub unlink0 { if ($fh[3] > 1 && $^W) { carp "unlink0: fstat found too many links; SB=@fh"; - } + } # Stat the path my @path = stat $path; @@ -1360,12 +1439,12 @@ sub unlink0 { unless (@path) { carp "unlink0: $path is gone already" if $^W; return; - } + } # this is no longer a file, but may be a directory, or worse unless (-f _) { confess "panic: $path is no longer a file: SB=@fh"; - } + } # Do comparison of each member of the array # On WinNT dev and rdev seem to be different @@ -1375,17 +1454,22 @@ sub unlink0 { my @okstat = (0..$#fh); # Use all by default if ($^O eq 'MSWin32') { @okstat = (1,2,3,4,5,7,8,9,10); + } elsif ($^O eq 'os2') { + @okstat = (0, 2..$#fh); } # Now compare each entry explicitly by number for (@okstat) { print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG; - unless ($fh[$_] == $path[$_]) { + # Use eq rather than == since rdev, blksize, and blocks (6, 11, + # and 12) will be '' on platforms that do not support them. This + # is fine since we are only comparing integers. + unless ($fh[$_] eq $path[$_]) { warn "Did not match $_ element of stat\n" if $DEBUG; return 0; } } - + # attempt remove the file (does not work on some platforms) if (_can_unlink_opened_file()) { # XXX: do *not* call this on a directory; possible race @@ -1468,7 +1552,21 @@ run with MEDIUM or HIGH security. This is simply because the safety tests use functions from L<Fcntl|Fcntl> that are not available in older versions of perl. The problem is that the version number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though -they are different versions..... +they are different versions. + +On systems that do not support the HIGH or MEDIUM safety levels +(for example Win NT or OS/2) any attempt to change the level will +be ignored. The decision to ignore rather than raise an exception +allows portable programs to be written with high security in mind +for the systems that can support this without those programs failing +on systems where the extra tests are irrelevant. + +If you really need to see whether the change has been accepted +simply examine the return value of C<safe_level>. + + $newlevel = File::Temp->safe_level( File::Temp::HIGH ); + die "Could not change to high security" + if $newlevel != File::Temp::HIGH; =cut @@ -1482,11 +1580,14 @@ they are different versions..... if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) { carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n"; } else { + # Dont allow this on perl 5.005 or earlier if ($] < 5.006 && $level != STANDARD) { # Cant do MEDIUM or HIGH checks croak "Currently requires perl 5.006 or newer to do the safe checks"; } - $LEVEL = $level; + # Check that we are allowed to change level + # Silently ignore if we can not. + $LEVEL = $level if _can_do_level($level); } } return $LEVEL; diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index 46ebd68cef..5c9c69ad02 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -44,6 +44,9 @@ by an autogenerated filehandle. If so, you must pass a valid lvalue in the parameter slot so it can be overwritten in the caller, or an exception will be raised. +The filehandles may also be integers, in which case they are understood +as file descriptors. + open3() returns the process ID of the child process. It doesn't return on failure: it just raises an exception matching C</^open3:/>. However, C<exec> failures in the child are not detected. You'll have to @@ -84,6 +87,7 @@ The order of arguments differs from that of open2(). # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com> # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career # fixed for autovivving FHs, tchrist again +# allow fd numbers to be used, by Frank Tobin # # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ # @@ -136,6 +140,15 @@ sub xclose { close $_[0] or croak "$Me: close($_[0]) failed: $!"; } +sub fh_is_fd { + return $_[0] =~ /\A=?(\d+)\z/; +} + +sub xfileno { + return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd + return fileno $_[0]; +} + my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _open3 { @@ -164,9 +177,9 @@ sub _open3 { $dup_err = ($dad_err =~ s/^[<>]&//); # force unqualified filehandles into caller's package - $dad_wtr = qualify $dad_wtr, $package; - $dad_rdr = qualify $dad_rdr, $package; - $dad_err = qualify $dad_err, $package; + $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr); + $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr); + $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err); my $kid_rdr = gensym; my $kid_wtr = gensym; @@ -181,20 +194,20 @@ sub _open3 { # If she wants to dup the kid's stderr onto her stdout I need to # save a copy of her stdout before I put something else there. if ($dad_rdr ne $dad_err && $dup_err - && fileno($dad_err) == fileno(STDOUT)) { + && xfileno($dad_err) == fileno(STDOUT)) { my $tmp = gensym; xopen($tmp, ">&$dad_err"); $dad_err = $tmp; } if ($dup_wtr) { - xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr); + xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); } else { xclose $dad_wtr; xopen \*STDIN, "<&=" . fileno $kid_rdr; } if ($dup_rdr) { - xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr); + xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); } else { xclose $dad_rdr; xopen \*STDOUT, ">&=" . fileno $kid_wtr; @@ -204,8 +217,8 @@ sub _open3 { # I have to use a fileno here because in this one case # I'm doing a dup but the filehandle might be a reference # (from the special case above). - xopen \*STDERR, ">&" . fileno $dad_err - if fileno(STDERR) != fileno($dad_err); + xopen \*STDERR, ">&" . xfileno($dad_err) + if fileno(STDERR) != xfileno($dad_err); } else { xclose $dad_err; xopen \*STDERR, ">&=" . fileno $kid_err; diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 2713383a00..40da9f3817 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -442,7 +442,11 @@ hosts on a network. A ping object is first created with optional parameters, a variable number of hosts may be pinged multiple times and then the connection is closed. -You may choose one of three different protocols to use for the ping. +You may choose one of three different protocols to use for the +ping. The "udp" protocol is the default. Note that a live remote host +may still fail to be pingable by one or more of these protocols. For +example, www.microsoft.com is generally alive but not pingable. + With the "tcp" protocol the ping() method attempts to establish a connection to the remote host's echo port. If the connection is successfully established, the remote host is considered reachable. No diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 89e3d0f432..346495f3de 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -1438,8 +1438,10 @@ sub process_text1($$;$$){ } elsif( $func eq 'E' ){ # E<x> - convert to character - $$rstr =~ s/^(\w+)>//; - $res = "&$1;"; + $$rstr =~ s/^([^>]*)>//; + my $escape = $1; + $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i; + $res = "&$escape;"; } elsif( $func eq 'F' ){ # F<filename> - italizice @@ -1940,7 +1942,7 @@ sub depod1($;$$){ $res .= $$rstr; } elsif( $func eq 'E' ){ # E<x> - convert to character - $$rstr =~ s/^(\w+)>//; + $$rstr =~ s/^([^>]*)>//; $res .= $E2c{$1} || ""; } elsif( $func eq 'X' ){ # X<> - ignore diff --git a/lib/Pod/LaTeX.pm b/lib/Pod/LaTeX.pm new file mode 100644 index 0000000000..8adb58921c --- /dev/null +++ b/lib/Pod/LaTeX.pm @@ -0,0 +1,1567 @@ +package Pod::LaTeX; + +# Copyright (C) 2000 by Tim Jenness <t.jenness@jach.hawaii.edu> +# All Rights Reserved. + +=head1 NAME + +Pod::LaTeX - Convert Pod data to formatted Latex + +=head1 SYNOPSIS + + use Pod::LaTeX; + my $parser = Pod::LaTeX->new ( ); + + $parser->parse_from_filehandle; + + $parser->parse_from_file ('file.pod', 'file.tex'); + +=head1 DESCRIPTION + +C<Pod::LaTeX> is a module to convert documentation in the Pod format +into Latex. The L<B<pod2latex>|pod2latex> X<pod2latex> command uses +this module for translation. + +C<Pod::LaTeX> is a derived class from L<Pod::Select|Pod::Select>. + +=cut + + +use strict; +require Pod::ParseUtils; +use base qw/ Pod::Select /; + +# use Data::Dumper; # for debugging +use Carp; + +use vars qw/ $VERSION %HTML_Escapes @LatexSections /; + +$VERSION = '0.52'; + +# Definitions of =headN -> latex mapping +@LatexSections = (qw/ + chapter + section + subsection + subsubsection + paragraph + subparagraph + /); + +# Standard escape sequences converted to Latex +# Up to "yuml" these are taken from the original pod2latex +# command written by Taro Kawagish (kawagish@imslab.co.jp) + +%HTML_Escapes = ( + 'amp' => '&', # ampersand + 'lt' => '$<$', # ' left chevron, less-than + 'gt' => '$>$', # ' right chevron, greater-than + 'quot' => '"', # double quote + + "Aacute" => "\\'{A}", # capital A, acute accent + "aacute" => "\\'{a}", # small a, acute accent + "Acirc" => "\\^{A}", # capital A, circumflex accent + "acirc" => "\\^{a}", # small a, circumflex accent + "AElig" => '\\AE', # capital AE diphthong (ligature) + "aelig" => '\\ae', # small ae diphthong (ligature) + "Agrave" => "\\`{A}", # capital A, grave accent + "agrave" => "\\`{a}", # small a, grave accent + "Aring" => '\\u{A}', # capital A, ring + "aring" => '\\u{a}', # small a, ring + "Atilde" => '\\~{A}', # capital A, tilde + "atilde" => '\\~{a}', # small a, tilde + "Auml" => '\\"{A}', # capital A, dieresis or umlaut mark + "auml" => '\\"{a}', # small a, dieresis or umlaut mark + "Ccedil" => '\\c{C}', # capital C, cedilla + "ccedil" => '\\c{c}', # small c, cedilla + "Eacute" => "\\'{E}", # capital E, acute accent + "eacute" => "\\'{e}", # small e, acute accent + "Ecirc" => "\\^{E}", # capital E, circumflex accent + "ecirc" => "\\^{e}", # small e, circumflex accent + "Egrave" => "\\`{E}", # capital E, grave accent + "egrave" => "\\`{e}", # small e, grave accent + "ETH" => '\\OE', # capital Eth, Icelandic + "eth" => '\\oe', # small eth, Icelandic + "Euml" => '\\"{E}', # capital E, dieresis or umlaut mark + "euml" => '\\"{e}', # small e, dieresis or umlaut mark + "Iacute" => "\\'{I}", # capital I, acute accent + "iacute" => "\\'{i}", # small i, acute accent + "Icirc" => "\\^{I}", # capital I, circumflex accent + "icirc" => "\\^{i}", # small i, circumflex accent + "Igrave" => "\\`{I}", # capital I, grave accent + "igrave" => "\\`{i}", # small i, grave accent + "Iuml" => '\\"{I}', # capital I, dieresis or umlaut mark + "iuml" => '\\"{i}', # small i, dieresis or umlaut mark + "Ntilde" => '\\~{N}', # capital N, tilde + "ntilde" => '\\~{n}', # small n, tilde + "Oacute" => "\\'{O}", # capital O, acute accent + "oacute" => "\\'{o}", # small o, acute accent + "Ocirc" => "\\^{O}", # capital O, circumflex accent + "ocirc" => "\\^{o}", # small o, circumflex accent + "Ograve" => "\\`{O}", # capital O, grave accent + "ograve" => "\\`{o}", # small o, grave accent + "Oslash" => "\\O", # capital O, slash + "oslash" => "\\o", # small o, slash + "Otilde" => "\\~{O}", # capital O, tilde + "otilde" => "\\~{o}", # small o, tilde + "Ouml" => '\\"{O}', # capital O, dieresis or umlaut mark + "ouml" => '\\"{o}', # small o, dieresis or umlaut mark + "szlig" => '\\ss{}', # small sharp s, German (sz ligature) + "THORN" => '\\L', # capital THORN, Icelandic + "thorn" => '\\l',, # small thorn, Icelandic + "Uacute" => "\\'{U}", # capital U, acute accent + "uacute" => "\\'{u}", # small u, acute accent + "Ucirc" => "\\^{U}", # capital U, circumflex accent + "ucirc" => "\\^{u}", # small u, circumflex accent + "Ugrave" => "\\`{U}", # capital U, grave accent + "ugrave" => "\\`{u}", # small u, grave accent + "Uuml" => '\\"{U}', # capital U, dieresis or umlaut mark + "uuml" => '\\"{u}', # small u, dieresis or umlaut mark + "Yacute" => "\\'{Y}", # capital Y, acute accent + "yacute" => "\\'{y}", # small y, acute accent + "yuml" => '\\"{y}', # small y, dieresis or umlaut mark + + # Added by TimJ + + "iexcl" => '!`', # inverted exclamation mark +# "cent" => ' ', # cent sign + "pound" => '\pounds', # (UK) pound sign +# "curren" => ' ', # currency sign +# "yen" => ' ', # yen sign +# "brvbar" => ' ', # broken vertical bar + "sect" => '\S', # section sign + "uml" => '\"{}', # diaresis + "copy" => '\copyright', # Copyright symbol +# "ordf" => ' ', # feminine ordinal indicator + "laquo" => '$\ll$', # ' # left pointing double angle quotation mark + "not" => '$\neg$', # ' # not sign + "shy" => '-', # soft hyphen +# "reg" => ' ', # registered trademark + "macr" => '$^-$', # ' # macron, overline + "deg" => '$^\circ$', # ' # degree sign + "plusmn" => '$\pm$', # ' # plus-minus sign + "sup2" => '$^2$', # ' # superscript 2 + "sup3" => '$^3$', # ' # superscript 3 + "acute" => "\\'{}", # acute accent + "micro" => '$\mu$', # micro sign + "para" => '\P', # pilcrow sign = paragraph sign + "middot" => '$\cdot$', # middle dot = Georgian comma + "cedil" => '\c{}', # cedilla + "sup1" => '$^1$', # ' # superscript 1 +# "ordm" => ' ', # masculine ordinal indicator + "raquo" => '$\gg$', # ' # right pointing double angle quotation mark + "frac14" => '$\frac{1}{4}$', # ' # vulgar fraction one quarter + "frac12" => '$\frac{1}{2}$', # ' # vulgar fraction one half + "frac34" => '$\frac{3}{4}$', # ' # vulgar fraction three quarters + "iquest" => "?'", # inverted question mark + "times" => '$\times$', # ' # multiplication sign + "divide" => '$\div$', # division sign + + # Greek letters using HTML codes + "alpha" => '$\alpha$', # ' + "beta" => '$\beta$', # ' + "gamma" => '$\gamma$', # ' + "delta" => '$\delta$', # ' + "epsilon"=> '$\epsilon$', # ' + "zeta" => '$\zeta$', # ' + "eta" => '$\eta$', # ' + "theta" => '$\theta$', # ' + "iota" => '$\iota$', # ' + "kappa" => '$\kappa$', # ' + "lambda" => '$\lambda$', # ' + "mu" => '$\mu$', # ' + "nu" => '$\nu$', # ' + "xi" => '$\xi$', # ' + "omicron"=> '$o$', # ' + "pi" => '$\pi$', # ' + "rho" => '$\rho$', # ' + "sigma" => '$\sigma$', # ' + "tau" => '$\tau$', # ' + "upsilon"=> '$\upsilon$', # ' + "phi" => '$\phi$', # ' + "chi" => '$\chi$', # ' + "psi" => '$\psi$', # ' + "omega" => '$\omega$', # ' + + "Alpha" => '$A$', # ' + "Beta" => '$B$', # ' + "Gamma" => '$\Gamma$', # ' + "Delta" => '$\Delta$', # ' + "Epsilon"=> '$E$', # ' + "Zeta" => '$Z$', # ' + "Eta" => '$H$', # ' + "Theta" => '$\Theta$', # ' + "Iota" => '$I$', # ' + "Kappa" => '$K$', # ' + "Lambda" => '$\Lambda$', # ' + "Mu" => '$M$', # ' + "Nu" => '$N$', # ' + "Xi" => '$\Xi$', # ' + "Omicron"=> '$O$', # ' + "Pi" => '$\Pi$', # ' + "Rho" => '$R$', # ' + "Sigma" => '$\Sigma$', # ' + "Tau" => '$T$', # ' + "Upsilon"=> '$\Upsilon$', # ' + "Phi" => '$\Phi$', # ' + "Chi" => '$X$', # ' + "Psi" => '$\Psi$', # ' + "Omega" => '$\Omega$', # ' + + +); + + +=head1 OBJECT METHODS + +The following methods are provided in this module. Methods inherited +from C<Pod::Select> are not described in the public interface. + +=over 4 + +=begin __PRIVATE__ + +=item C<initialize> + +Initialise the object. This method is subclassed from C<Pod::Parser>. +The base class method is invoked. This method defines the default +behaviour of the object unless overridden by supplying arguments to +the constructor. + +Internal settings are defaulted as well as the public instance data. +Internal hash values are accessed directly (rather than through +a method) and start with an underscore. + +This method should not be invoked by the user directly. + +=end __PRIVATE__ + +=cut + + + +# - An array for nested lists + +# Arguments have already been read by this point + +sub initialize { + my $self = shift; + + # print Dumper($self); + + # Internals + $self->{_Lists} = []; # For nested lists + $self->{_suppress_all_para} = 0; # For =begin blocks + $self->{_suppress_next_para} = 0; # For =for blocks + $self->{_dont_modify_any_para}=0; # For =begin blocks + $self->{_dont_modify_next_para}=0; # For =for blocks + $self->{_CURRENT_HEAD1} = ''; # Name of current HEAD1 section + + # Options - only initialise if not already set + + # Cause the '=head1 NAME' field to be treated specially + # The contents of the NAME paragraph will be converted + # to a section title. All subsequent =head1 will be converted + # to =head2 and down. Will not affect =head1's prior to NAME + # Assumes: 'Module - purpose' format + # Also creates a purpose field + # The name is used for Labeling of the subsequent subsections + $self->{ReplaceNAMEwithSection} = 0 + unless exists $self->{ReplaceNAMEwithSection}; + $self->{AddPreamble} = 1 # make full latex document + unless exists $self->{AddPreamble}; + $self->{StartWithNewPage} = 0 # Start new page for pod section + unless exists $self->{StartWithNewPage}; + $self->{TableOfContents} = 0 # Add table of contents + unless exists $self->{TableOfContents}; # only relevent if AddPreamble=1 + $self->{AddPostamble} = 1 # Add closing latex code at end + unless exists $self->{AddPostamble}; # effectively end{document} and index + $self->{MakeIndex} = 1 # Add index (only relevant AddPostamble + unless exists $self->{MakeIndex}; # and AddPreamble) + + $self->{UniqueLabels} = 1 # Use label unique for each pod + unless exists $self->{UniqueLabels}; # either based on the filename + # or supplied + + # Control the level of =head1. default is \section + # + $self->{Head1Level} = 1 # Offset in latex sections + unless exists $self->{Head1Level}; # 0 is chapter, 2 is subsection + + # Control at which level numbering of sections is turned off + # ie subsection becomes subsection* + # The numbering is relative to the latex sectioning commands + # and is independent of Pod heading level + # default is to number \section but not \subsection + $self->{LevelNoNum} = 2 + unless exists $self->{LevelNoNum}; + + # Label to be used as prefix to all internal section names + # If not defined will attempt to derive it from the filename + # This can not happen when running parse_from_filehandle though + # hence the ability to set the label externally + # The label could then be Pod::Parser_DESCRIPTION or somesuch + + $self->{Label} = undef # label to be used as prefix + unless exists $self->{Label}; # to all internal section names + + # These allow the caller to add arbritrary latex code to + # start and end of document. AddPreamble and AddPostamble are ignored + # if these are set. + # Also MakeIndex and TableOfContents are also ignored. + $self->{UserPreamble} = undef # User supplied start (AddPreamble =1) + unless exists $self->{Label}; + $self->{UserPostamble} = undef # Use supplied end (AddPostamble=1) + unless exists $self->{Label}; + + # Run base initialize + $self->SUPER::initialize; + +} + +=back + +=head2 Data Accessors + +The following methods are provided for accessing instance data. These +methods should be used for accessing configuration parameters rather +than assuming the object is a hash. + +Default values can be supplied by using these names as keys to a hash +of arguments when using the C<new()> constructor. + +=over 4 + +=item B<AddPreamble> + +Logical to control whether a C<latex> preamble is to be written. +If true, a valid C<latex> preamble is written before the pod data is written. +This is similar to: + + \documentclass{article} + \begin{document} + +but will be more complicated if table of contents and indexing are required. +Can be used to set or retrieve the current value. + + $add = $parser->AddPreamble(); + $parser->AddPreamble(1); + +If used in conjunction with C<AddPostamble> a full latex document will +be written that could be immediately processed by C<latex>. + +=cut + +sub AddPreamble { + my $self = shift; + if (@_) { + $self->{AddPreamble} = shift; + } + return $self->{AddPreamble}; +} + +=item B<AddPostamble> + +Logical to control whether a standard C<latex> ending is written to the output +file after the document has been processed. +In its simplest form this is simply: + + \end{document} + +but can be more complicated if a index is required. +Can be used to set or retrieve the current value. + + $add = $parser->AddPostamble(); + $parser->AddPostamble(1); + +If used in conjunction with C<AddPreaamble> a full latex document will +be written that could be immediately processed by C<latex>. + +=cut + +sub AddPostamble { + my $self = shift; + if (@_) { + $self->{AddPostamble} = shift; + } + return $self->{AddPostamble}; +} + +=item B<Head1Level> + +The C<latex> sectioning level that should be used to correspond to +a pod C<=head1> directive. This can be used, for example, to turn +a C<=head1> into a C<latex> C<subsection>. This should hold a number +corresponding to the required position in an array containing the +following elements: + + [0] chapter + [1] section + [2] subsection + [3] subsubsection + [4] paragraph + [5] subparagraph + +Can be used to set or retrieve the current value: + + $parser->Head1Level(2); + $sect = $parser->Head1Level; + +Setting this number too high can result in sections that may not be reproducible +in the expected way. For example, setting this to 4 would imply that C<=head3> +do not have a corresponding C<latex> section (C<=head1> would correspond to +a C<paragraph>). + +A check is made to ensure that the supplied value is an integer in the +range 0 to 5. + +Default is for a value of 1 (i.e. a C<section>). + +=cut + +sub Head1Level { + my $self = shift; + if (@_) { + my $arg = shift; + if ($arg =~ /^\d$/ && $arg <= $#LatexSections) { + $self->{Head1Level} = $arg; + } else { + carp "Head1Level supplied ($arg) must be integer in range 0 to ".$#LatexSections . "- Ignoring\n"; + } + } + return $self->{Head1Level}; +} + +=item B<Label> + +This is the label that is prefixed to all C<latex> label and index +entries to make them unique. In general, pods have similarly titled +sections (NAME, DESCRIPTION etc) and a C<latex> label will be multiply +defined if more than one pod document is to be included in a single +C<latex> file. To overcome this, this label is prefixed to a label +whenever a label is required (joined with an underscore) or to an +index entry (joined by an exclamation mark which is the normal index +separator). For example, C<\label{text}> becomes C<\label{Label_text}>. + +Can be used to set or retrieve the current value: + + $label = $parser->Label; + $parser->Label($label); + +This label is only used if C<UniqueLabels> is true. +Its value is set automatically from the C<NAME> field +if C<ReplaceNAMEwithSection> is true. If this is not the case +it must be set manually before starting the parse. + +Default value is C<undef>. + +=cut + +sub Label { + my $self = shift; + if (@_) { + $self->{Label} = shift; + } + return $self->{Label}; +} + +=item B<LevelNoNum> + +Control the point at which C<latex> section numbering is turned off. +For example, this can be used to make sure that C<latex> sections +are numbered but subsections are not. + +Can be used to set or retrieve the current value: + + $lev = $parser->LevelNoNum; + $parser->LevelNoNum(2); + +The argument must be an integer between 0 and 5 and is the same as the +number described in C<Head1Level> method description. The number has +nothing to do with the pod heading number, only the C<latex> sectioning. + +Default is 2. (i.e. C<latex> subsections are written as C<subsection*> +but sections are numbered). + +=cut + +sub LevelNoNum { + my $self = shift; + if (@_) { + $self->{LevelNoNum} = shift; + } + return $self->{LevelNoNum}; +} + +=item B<MakeIndex> + +Controls whether C<latex> commands for creating an index are to be inserted +into the preamble and postamble + + $makeindex = $parser->MakeIndex; + $parser->MakeIndex(0); + +Irrelevant if both C<AddPreamble> and C<AddPostamble> are false (or equivalently, +C<UserPreamble> and C<UserPostamble> are set). + +Default is for an index to be created. + +=cut + +sub MakeIndex { + my $self = shift; + if (@_) { + $self->{MakeIndex} = shift; + } + return $self->{MakeIndex}; +} + +=item B<ReplaceNAMEwithSection> + +This controls whether the C<NAME> section in the pod is to be translated +literally or converted to a slightly modified output where the section +name is the pod name rather than "NAME". + +If true, the pod segment + + =head1 NAME + + pod::name - purpose + + =head1 SYNOPSIS + +is converted to the C<latex> + + \section{pod::name\label{pod_name}\index{pod::name}} + + Purpose + + \subsection*{SYNOPSIS\label{pod_name_SYNOPSIS}% + \index{pod::name!SYNOPSIS}} + +(dependent on the value of C<Head1Level> and C<LevelNoNum>). Note that +subsequent C<head1> directives translate to subsections rather than +sections and that the labels and index now include the pod name (dependent +on the value of C<UniqueLabels>). + +The C<Label> is set from the pod name regardless of any current value +of C<Label>. + + $mod = $parser->ReplaceNAMEwithSection; + $parser->ReplaceNAMEwithSection(0); + +Default is to translate the pod literally. + +=cut + +sub ReplaceNAMEwithSection { + my $self = shift; + if (@_) { + $self->{ReplaceNAMEwithSection} = shift; + } + return $self->{ReplaceNAMEwithSection}; +} + +=item B<StartWithNewPage> + +If true, each pod translation will begin with a C<latex> +C<\clearpage>. + + $parser->StartWithNewPage(1); + $newpage = $parser->StartWithNewPage; + +Default is false. + +=cut + +sub StartWithNewPage { + my $self = shift; + if (@_) { + $self->{StartWithNewPage} = shift; + } + return $self->{StartWithNewPage}; +} + +=item B<TableOfContents> + +If true, a table of contents will be created. +Irrelevant if C<AddPreamble> is false or C<UserPreamble> +is set. + + $toc = $parser->TableOfContents; + $parser->TableOfContents(1); + +Default is false. + +=cut + +sub TableOfContents { + my $self = shift; + if (@_) { + $self->{TableOfContents} = shift; + } + return $self->{TableOfContents}; +} + +=item B<UniqueLabels> + +If true, the translator will attempt to make sure that +each C<latex> label or index entry will be uniquely identified +by prefixing the contents of C<Label>. This allows +multiple documents to be combined without clashing +common labels such as C<DESCRIPTION> and C<SYNOPSIS> + + $parser->UniqueLabels(1); + $unq = $parser->UniqueLabels; + +Default is true. + +=cut + +sub UniqueLabels { + my $self = shift; + if (@_) { + $self->{UniqueLabels} = shift; + } + return $self->{UniqueLabels}; +} + +=item B<UserPreamble> + +User supplied C<latex> preamble. Added before the pod translation +data. + +If set, the contents will be prepended to the output file before the translated +data regardless of the value of C<AddPreamble>. +C<MakeIndex> and C<TableOfContents> will also be ignored. + +=cut + +sub UserPreamble { + my $self = shift; + if (@_) { + $self->{UserPreamble} = shift; + } + return $self->{UserPreamble}; +} + +=item B<UserPostamble> + +User supplied C<latex> postamble. Added after the pod translation +data. + +If set, the contents will be prepended to the output file after the translated +data regardless of the value of C<AddPostamble>. +C<MakeIndex> will also be ignored. + +=cut + +sub UserPostamble { + my $self = shift; + if (@_) { + $self->{UserPostamble} = shift; + } + return $self->{UserPostamble}; +} + +=begin __PRIVATE__ + +=item B<Lists> + +Contains details of the currently active lists. + The array contains C<Pod::List> objects. A new C<Pod::List> +object is created each time a list is encountered and it is +pushed onto this stack. When the list context ends, it +is popped from the stack. The array will be empty if no +lists are active. + +Returns array of list information in array context +Returns array ref in scalar context + +=cut + + + +sub lists { + my $self = shift; + return @{ $self->{_Lists} } if wantarray(); + return $self->{_Lists}; +} + +=end __PRIVATE__ + +=back + +=begin __PRIVATE__ + +=head2 Subclassed methods + +The following methods override methods provided in the C<Pod::Select> +base class. See C<Pod::Parser> and C<Pod::Select> for more information +on what these methods require. + +=over 4 + +=cut + +######### END ACCESSORS ################### + +# Opening pod + +=item B<begin_pod> + +Writes the C<latex> preamble if requested. + +=cut + +sub begin_pod { + my $self = shift; + + # Get the pod identification + # This should really come from the '=head1 NAME' paragraph + + my $infile = $self->input_file; + my $class = ref($self); + my $date = gmtime(time); + + # Comment message to say where this came from + my $comment = << "__TEX_COMMENT__"; +%% Latex generated from POD in document $infile +%% Using the perl module $class +%% Converted on $date +__TEX_COMMENT__ + + # Write the preamble + # If the caller has supplied one then we just use that + + my $preamble = ''; + if (defined $self->UserPreamble) { + + $preamble = $self->UserPreamble; + + # Add the description of where this came from + $preamble .= "\n$comment"; + + + } elsif ($self->AddPreamble) { + # Write our own preamble + + # Code to initialise index making + # Use an array so that we can prepend comment if required + my @makeidx = ( + '\usepackage{makeidx}', + '\makeindex', + ); + + unless ($self->MakeIndex) { + foreach (@makeidx) { + $_ = '%% ' . $_; + } + } + my $makeindex = join("\n",@makeidx) . "\n"; + + + # Table of contents + my $tableofcontents = '\tableofcontents'; + + $tableofcontents = '%% ' . $tableofcontents + unless $self->TableOfContents; + + # Roll our own + $preamble = << "__TEX_HEADER__"; +\\documentclass{article} + +$comment + +$makeindex + +\\begin{document} + +$tableofcontents + +__TEX_HEADER__ + + } + + # Write the header (blank if none) + $self->_output($preamble); + + # Start on new page if requested + $self->_output("\\clearpage\n") if $self->StartWithNewPage; + +} + + +=item B<end_pod> + +Write the closing C<latex> code. + +=cut + +sub end_pod { + my $self = shift; + + # End string + my $end = ''; + + # Use the user version of the postamble if deinfed + if (defined $self->UserPostamble) { + $end = $self->UserPostamble; + + $self->_output($end); + + } elsif ($self->AddPostamble) { + + # Check for index + my $makeindex = '\printindex'; + + $makeindex = '%% '. $makeindex unless $self->MakeIndex; + + $end = "$makeindex\n\n\\end{document}\n"; + } + + + $self->_output($end); + +} + +=item B<command> + +Process basic pod commands. + +=cut + +sub command { + my $self = shift; + my ($command, $paragraph, $line_num, $parobj) = @_; + + # return if we dont care + return if $command eq 'pod'; + + $paragraph = $self->_replace_special_chars($paragraph); + + # Interpolate pod sequences in paragraph + $paragraph = $self->interpolate($paragraph, $line_num); + + $paragraph =~ s/\s+$//; + + # Now run the command + if ($command eq 'over') { + + $self->begin_list($paragraph, $line_num); + + } elsif ($command eq 'item') { + + $self->add_item($paragraph, $line_num); + + } elsif ($command eq 'back') { + + $self->end_list($line_num); + + } elsif ($command eq 'head1') { + + # Store the name of the section + $self->{_CURRENT_HEAD1} = $paragraph; + + # Print it + $self->head(1, $paragraph, $parobj); + + } elsif ($command eq 'head2') { + + $self->head(2, $paragraph, $parobj); + + } elsif ($command eq 'head3') { + + $self->head(3, $paragraph, $parobj); + + } elsif ($command eq 'head4') { + + $self->head(4, $paragraph, $parobj); + + } elsif ($command eq 'head5') { + + $self->head(5, $paragraph, $parobj); + + } elsif ($command eq 'head6') { + + $self->head(6, $paragraph, $parobj); + + } elsif ($command eq 'begin') { + + # pass through if latex + if ($paragraph =~ /^latex/i) { + # Make sure that subsequent paragraphs are not modfied before printing + $self->{_dont_modify_any_para} = 1; + + } else { + # Suppress all subsequent paragraphs unless + # it is explcitly intended for latex + $self->{_suppress_all_para} = 1; + } + + } elsif ($command eq 'for') { + + # pass through if latex + if ($paragraph =~ /^latex/i) { + # Make sure that next paragraph is not modfied before printing + $self->{_dont_modify_next_para} = 1; + + } else { + # Suppress the next paragraph unless it is latex + $self->{_suppress_next_para} = 1 + } + + } elsif ($command eq 'end') { + + # Reset suppression + $self->{_suppress_all_para} = 0; + $self->{_dont_modify_any_para} = 0; + + } elsif ($command eq 'pod') { + + # Do nothing + + } else { + carp "Command $command not recognised at line $line_num\n"; + } + +} + +=item B<verbatim> + +Verbatim text + +=cut + +sub verbatim { + my $self = shift; + my ($paragraph, $line_num, $parobj) = @_; + + # Expand paragraph unless in =for or =begin block + if ($self->{_dont_modify_any_para} || $self->{_dont_modify_next_para}) { + # Just print as is + $self->_output($paragraph); + + # Reset flag if in =for + $self->{_dont_modify_next_para} = 0; + + } else { + + return if $paragraph =~ /^\s+$/; + + # Clean trailing space + $paragraph =~ s/\s+$//; + + $self->_output('\begin{verbatim}' . "\n$paragraph\n". '\end{verbatim}'."\n"); + } +} + +=item B<textblock> + +Plain text paragraph. + +=cut + +sub textblock { + my $self = shift; + my ($paragraph, $line_num, $parobj) = @_; + + # print Dumper($self); + + # Expand paragraph unless in =for or =begin block + if ($self->{_dont_modify_any_para} || $self->{_dont_modify_next_para}) { + # Just print as is + $self->_output($paragraph); + + # Reset flag if in =for + $self->{_dont_modify_next_para} = 0; + + return; + } + + + # Escape latex special characters + $paragraph = $self->_replace_special_chars($paragraph); + + # Interpolate interior sequences + my $expansion = $self->interpolate($paragraph, $line_num); + $expansion =~ s/\s+$//; + + + # If we are replacing 'head1 NAME' with a section + # we need to look in the paragraph and rewrite things + # Need to make sure this is called only on the first paragraph + # following 'head1 NAME' and not on subsequent paragraphs that may be + # present. + if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection()) { + + # Strip white space from start and end + $paragraph =~ s/^\s+//; + $paragraph =~ s/\s$//; + + # Split the string into 2 parts + my ($name, $purpose) = split(/\s+-\s+/, $expansion,2); + + # Now prevent this from triggering until a new head1 NAME is set + $self->{_CURRENT_HEAD1} = '_NAME'; + + # Might want to clear the Label() before doing this (CHECK) + + # Print the heading + $self->head(1, $name, $parobj); + + # Set the labeling in case we want unique names later + $self->Label( $self->_create_label( $name, 1 ) ); + + # Raise the Head1Level by one so that subsequent =head1 appear + # as subsections of the main name section unless we are already + # at maximum [Head1Level() could check this itself - CHECK] + $self->Head1Level( $self->Head1Level() + 1) + unless $self->Head1Level == $#LatexSections; + + # Now write out the new latex paragraph + $purpose = ucfirst($purpose); + $self->_output("\n\n$purpose\n\n"); + + } else { + # Just write the output + $self->_output("\n\n$expansion\n\n"); + } + +} + +=item B<interior_sequence> + +Interior sequence expansion + +=cut + +sub interior_sequence { + my $self = shift; + + my ($seq_command, $seq_argument, $pod_seq) = @_; + + if ($seq_command eq 'B') { + return "\\textbf{$seq_argument}"; + + } elsif ($seq_command eq 'I') { + return "\\textit{$seq_argument}"; + + } elsif ($seq_command eq 'E') { + + # If it is simply a number + if ($seq_argument =~ /^\d+$/) { + return chr($seq_argument); + # Look up escape in hash table + } elsif (exists $HTML_Escapes{$seq_argument}) { + return $HTML_Escapes{$seq_argument}; + + } else { + my ($file, $line) = $pod_seq->file_line(); + warn "Escape sequence $seq_argument not recognised at line $line of file $file\n"; + return; + } + + } elsif ($seq_command eq 'Z') { + + # Zero width space + return '$\!$'; # ' + + } elsif ($seq_command eq 'C') { + return "\\texttt{$seq_argument}"; + + } elsif ($seq_command eq 'F') { + return "\\emph{$seq_argument}"; + + } elsif ($seq_command eq 'S') { + # non breakable spaces + my $nbsp = '$\:$'; #' + + $seq_argument =~ s/\s/$nbsp/g; + return $seq_argument; + + } elsif ($seq_command eq 'L') { + + my $link = new Pod::Hyperlink($seq_argument); + + # undef on failure + unless (defined $link) { + carp $@; + return; + } + + # Handle internal links differently + my $type = $link->type; + my $page = $link->page; + + if ($type eq 'section' && $page eq '') { + # Use internal latex reference + my $node = $link->node; + + # Convert to a label + $node = $self->_create_label($node); + + return "\\S\\ref{$node}"; + + } else { + # Use default markup for external references + # (although Starlink would use \xlabel) + my $markup = $link->markup; + + my ($file, $line) = $pod_seq->file_line(); + + return $self->interpolate($link->markup, $line); + } + + + + } elsif ($seq_command eq 'P') { + # Special markup for Pod::Hyperlink + # Replace :: with / + my $link = $seq_argument; + $link =~ s/::/\//g; + + my $ref = "\\emph{$seq_argument}"; + return $ref; + + } elsif ($seq_command eq 'Q') { + # Special markup for Pod::Hyperlink + return "\\textsf{$seq_argument}\n"; + + } elsif ($seq_command eq 'X') { + # Index entries + + # use \index command + # I will let '!' go through for now + # not sure how sub categories are handled in X<> + my $index = $self->_create_index($seq_argument); + return "\\index{$index}\n"; + + } else { + carp "Unknown sequence $seq_command<$seq_argument>"; + } + +} + +=back + +=head2 List Methods + +Methods used to handle lists. + +=over 4 + +=item B<begin_list> + +Called when a new list is found (via the C<over> directive). +Creates a new C<Pod::List> object and stores it on the +list stack. + + $parser->begin_list($indent, $line_num); + +=cut + +sub begin_list { + my $self = shift; + my $indent = shift; + my $line_num = shift; + + # Indicate that a list should be started for the next item + # need to do this to work out the type of list + push ( @{$self->lists}, new Pod::List(-indent => $indent, + -start => $line_num, + -file => $self->input_file, + ) + ); + +} + +=item B<end_list> + +Called when the end of a list is found (the C<back> directive). +Pops the C<Pod::List> object off the stack of lists and writes +the C<latex> code required to close a list. + + $parser->end_list($line_num); + +=cut + +sub end_list { + my $self = shift; + my $line_num = shift; + + unless (defined $self->lists->[-1]) { + my $file = $self->input_file; + warn "No list is active at line $line_num (file=$file). Missing =over?\n"; + return; + } + + # What to write depends on list type + my $type = $self->lists->[-1]->type; + + # Dont write anything if the list type is not set + # iomplying that a list was created but no entries were + # placed in it (eg because of a =begin/=end combination) + $self->_output("\\end{$type}\n") + if (defined $type && length($type) > 0); + + # Clear list + pop(@{ $self->lists}); + +} + +=item B<add_item> + +Add items to the list. The first time an item is encountered +(determined from the state of the current C<Pod::List> object) +the type of list is determined (ordered, unnumbered or description) +and the relevant latex code issued. + + $parser->add_item($paragraph, $line_num); + +=cut + +sub add_item { + my $self = shift; + my $paragraph = shift; + my $line_num = shift; + + unless (defined $self->lists->[-1]) { + my $file = $self->input_file; + warn "List has already ended by line $line_num of file $file. Missing =over?\n"; + # Replace special chars +# $paragraph = $self->_replace_special_chars($paragraph); + $self->_output("$paragraph\n\n"); + return; + } + + # If paragraphs printing is turned off via =begin/=end or whatver + # simply return immediately + return if ($self->{_suppress_all_para} || $self->{_suppress_next_para}); + + # Check to see whether we are starting a new lists + if (scalar($self->lists->[-1]->item) == 0) { + + # Examine the paragraph to determine what type of list + # we have + $paragraph =~ s/\s+$//; + $paragraph =~ s/^\s+//; + + my $type; + if ($paragraph eq '*') { + $type = 'itemize'; + } elsif ($paragraph =~ /^\d/) { + $type = 'enumerate'; + } else { + $type = 'description'; + } + $self->lists->[-1]->type($type); + + $self->_output("\\begin{$type}\n"); + + } + + my $type = $self->lists->[-1]->type; + + if ($type eq 'description') { + + $self->_output("\\item[$paragraph] \\mbox{}"); + } else { + $self->_output('\item '); + } + + # Store the item name in the object. Required so that + # we can tell if the list is new or not + $self->lists->[-1]->item($paragraph); + +} + +=back + +=head2 Methods for headings + +=over 4 + +=item B<head> + +Print a heading of the required level. + + $parser->head($level, $paragraph, $parobj); + +The first argument is the pod heading level. The second argument +is the contents of the heading. The 3rd argument is a Pod::Paragraph +object so that the line number can be extracted. + +=cut + +sub head { + my $self = shift; + my $num = shift; + my $paragraph = shift; + my $parobj = shift; + + # If we are replace 'head1 NAME' with a section + # we return immediately if we get it + return + if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection()); + + # Create a label + my $label = $self->_create_label($paragraph); + + # Create an index entry + my $index = $self->_create_index($paragraph); + + # Work out position in the above array taking into account + # that =head1 is equivalent to $self->Head1Level + + my $level = $self->Head1Level() - 1 + $num; + + # Warn if heading to large + if ($num > $#LatexSections) { + my $line = $parobj->file_line; + my $file = $self->input_file; + warn "Heading level too large ($level) for LaTeX at line $line of file $file\n"; + $level = $#LatexSections; + } + + # Check to see whether section should be unnumbered + my $star = ($level >= $self->LevelNoNum ? '*' : ''); + + # Section + $self->_output("\\" .$LatexSections[$level] .$star ."{$paragraph\\label{".$label ."}\\index{".$index."}}"); + +} + + +=back + +=end __PRIVATE__ + +=begin __PRIVATE__ + +=head2 Internal methods + +Internal routines are described in this section. They do not form part of the +public interface. All private methods start with an underscore. + +=over 4 + +=item B<_output> + +Output text to the output filehandle. This method must be always be called +to output parsed text. + + $parser->_output($text); + +Does not write anything if a =begin or =for is active that should be +ignored. + +=cut + +sub _output { + my $self = shift; + my $text = shift; + + print { $self->output_handle } $text + unless $self->{_suppress_all_para} || + $self->{_suppress_next_para}; + + # Reset pargraph stuff for =for + $self->{_suppress_next_para} = 0 + if $self->{_suppress_next_para}; +} + + +=item B<_replace_special_chars> + +Subroutine to replace characters that are special in C<latex> +with the escaped forms + + $escaped = $parser->_replace_special_chars($paragraph); + +Need to call this routine before interior_sequences are munged but +not if verbatim. + +Special characters and the C<latex> equivalents are: + + } \} + { \{ + _ \_ + $ \$ + % \% + & \& + \ $\backslash$ + ^ \^{} + +=cut + +sub _replace_special_chars { + my $self = shift; + my $paragraph = shift; + + # Replace a \ with $\backslash$ + # This is made more complicated because the dollars will be escaped + # by the subsequent replacement. Easiest to add \backslash + # now and then add the dollars + $paragraph =~ s/\\/\\backslash/g; + + # Must be done after escape of \ since this command adds latex escapes + # Replace characters that can be escaped + $paragraph =~ s/([\$\#&%_{}])/\\$1/g; + + # Replace ^ characters with \^{} so that $^F works okay + $paragraph =~ s/(\^)/\\$1\{\}/g; + + # Now add the dollars around each \backslash + $paragraph =~ s/(\\backslash)/\$$1\$/g; + + return $paragraph; +} + + +=item B<_create_label> + +Return a string that can be used as an internal reference +in a C<latex> document (i.e. accepted by the C<\label> command) + + $label = $parser->_create_label($string) + +If UniqueLabels is true returns a label prefixed by Label() +This can be suppressed with an optional second argument. + + $label = $parser->_create_label($string, $suppress); + +If a second argument is supplied (of any value including undef) +the Label() is never prefixed. This means that this routine can +be called to create a Label() without prefixing a previous setting. + +=cut + +sub _create_label { + my $self = shift; + my $paragraph = shift; + my $suppress = (@_ ? 1 : 0 ); + + # Remove latex commands + $paragraph = $self->_clean_latex_commands($paragraph); + + # Remove non alphanumerics from the label and replace with underscores + # want to protect '-' though so use negated character classes + $paragraph =~ s/[^-:\w]/_/g; + + # Multiple underscores will look unsightly so remove repeats + # This will also have the advantage of tidying up the end and + # start of string + $paragraph =~ s/_+/_/g; + + # If required need to make sure that the label is unique + # since it is possible to have multiple pods in a single + # document + if (!$suppress && $self->UniqueLabels() && defined $self->Label) { + $paragraph = $self->Label() .'_'. $paragraph; + } + + return $paragraph; +} + + +=item B<_create_index> + +Similar to C<_create_label> except an index entry is created. +If C<UniqueLabels> is true, the index entry is prefixed by +the current C<Label> and an exclamation mark. + + $ind = $parser->_create_index($paragraph); + +An exclamation mark is used by C<makeindex> to generate +sub-entries in an index. + +=cut + +sub _create_index { + my $self = shift; + my $paragraph = shift; + my $suppress = (@_ ? 1 : 0 ); + + # Remove latex commands + $paragraph = $self->_clean_latex_commands($paragraph); + + # If required need to make sure that the index entry is unique + # since it is possible to have multiple pods in a single + # document + if (!$suppress && $self->UniqueLabels() && defined $self->Label) { + $paragraph = $self->Label() .'!'. $paragraph; + } + + # Need to replace _ with space + $paragraph =~ s/_/ /g; + + return $paragraph; + +} + +=item B<_clean_latex_commands> + +Removes latex commands from text. The latex command is assumed to be of the +form C<\command{ text }>. "C<text>" is retained + + $clean = $parser->_clean_latex_commands($text); + +=cut + +sub _clean_latex_commands { + my $self = shift; + my $paragraph = shift; + + # Remove latex commands of the form \text{ } + # and replace with the contents of the { } + # need to make this non-greedy so that it can handle + # "\text{a} and \text2{b}" + # without converting it to + # "a} and \text2{b" + # This match will still get into trouble if \} is present + # This is not vital since the subsequent replacement of non-alphanumeric + # characters will tidy it up anyway + $paragraph =~ s/\\\w+{(.*?)}/$1/g; + + return $paragraph +} + +=back + +=end __PRIVATE__ + +=head1 NOTES + +Compatible with C<latex2e> only. Can not be used with C<latex> v2.09 +or earlier. + +A subclass of C<Pod::Select> so that specific pod sections can be +converted to C<latex> by using the C<select> method. + +Some HTML escapes are missing and many have not been tested. + +=head1 SEE ALSO + +L<Pod::Parser>, L<Pod::Select>, L<pod2latex> + +=head1 AUTHORS + +Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> + +=head1 COPYRIGHT + +Copyright (C) 2000 Tim Jenness. All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=begin __PRIVATE__ + +=head1 REVISION + +$Id: LaTeX.pm,v 1.4 2000/05/16 01:26:55 timj Exp $ + +=end __PRIVATE__ + +=cut diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm index 8673ba4795..439b22c35b 100644 --- a/lib/Pod/Man.pm +++ b/lib/Pod/Man.pm @@ -194,6 +194,8 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote + 'sol' => '/', # solidus + 'verbar' => '|', # vertical bar 'Aacute' => "A\\*'", # capital A, acute accent 'aacute' => "a\\*'", # small a, acute accent diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index f5c1e3d0cf..47dcee584f 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -53,6 +53,8 @@ $VERSION = 2.04; 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote + 'sol' => '/', # solidus + 'verbar' => '|', # vertical bar "Aacute" => "\xC1", # capital A, acute accent "aacute" => "\xE1", # small a, acute accent diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index aa8f712dcf..571588ebd2 100644 --- a/lib/Pod/Usage.pm +++ b/lib/Pod/Usage.pm @@ -211,7 +211,7 @@ convenient to use as an innocent looking error message handling function: ## Check for too many filenames pod2usage("$0: Too many files given.\n") if (@ARGV > 1); -Some user's however may feel that the above "economy of expression" is +Some users however may feel that the above "economy of expression" is not particularly readable nor consistent and may instead choose to do something more like the following: diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm index 99372f2630..3b9c52d912 100644 --- a/lib/SelfLoader.pm +++ b/lib/SelfLoader.pm @@ -3,7 +3,7 @@ package SelfLoader; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(AUTOLOAD); -$VERSION = "1.0901"; +$VERSION = "1.0902"; sub Version {$VERSION} $DEBUG = 0; @@ -20,6 +20,7 @@ sub croak { require Carp; goto &Carp::croak } AUTOLOAD { print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG; my $SL_code = $Cache{$AUTOLOAD}; + my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@ unless ($SL_code) { # Maybe this pack had stubs before __DATA__, and never initialized. # Or, this maybe an automatic DESTROY method call when none exists. @@ -31,11 +32,13 @@ AUTOLOAD { croak "Undefined subroutine $AUTOLOAD" unless $SL_code; } print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG; + eval $SL_code; if ($@) { $@ =~ s/ at .*\n//; croak $@; } + $@ = $save; defined(&$AUTOLOAD) || die "SelfLoader inconsistency error"; delete $Cache{$AUTOLOAD}; goto &$AUTOLOAD diff --git a/lib/Symbol.pm b/lib/Symbol.pm index a842c1cd7b..a95383a5d6 100644 --- a/lib/Symbol.pm +++ b/lib/Symbol.pm @@ -129,8 +129,15 @@ sub delete_package ($) { my $stem_symtab = *{$stem}{HASH}; return unless defined $stem_symtab and exists $stem_symtab->{$leaf}; - my $leaf_glob = $stem_symtab->{$leaf}; - my $leaf_symtab = *{$leaf_glob}{HASH}; + + # free all the symbols in the package + + my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; + foreach my $name (keys %$leaf_symtab) { + undef *{$pkg . $name}; + } + + # delete the symbol table %$leaf_symtab = (); delete $stem_symtab->{$leaf}; diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index f913478643..a17bdbfd72 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -8,7 +8,7 @@ use FileHandle; use strict; our($VERSION, $verbose, $switches, $have_devel_corestack, $curtest, - @ISA, @EXPORT, @EXPORT_OK); + $columns, @ISA, @EXPORT, @EXPORT_OK); $have_devel_corestack = 0; $VERSION = "1.1604"; @@ -27,36 +27,18 @@ my $subtests_skipped = 0; @EXPORT= qw(&runtests); @EXPORT_OK= qw($verbose $switches); -format STDOUT_TOP = -Failed Test Status Wstat Total Fail Failed List of failed -------------------------------------------------------------------------------- -. - -format STDOUT = -@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##% ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -{ $curtest->{name}, - $curtest->{estat}, - $curtest->{wstat}, - $curtest->{max}, - $curtest->{failed}, - $curtest->{percent}, - $curtest->{canon} -} -~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - $curtest->{canon} -. - - $verbose = 0; $switches = "-w"; +$columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f } sub runtests { my(@tests) = @_; local($|) = 1; - my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests); + my($test,$te,$ok,$next,$max,$pct,$totbonus,@failed,%failedtests); my $totmax = 0; + my $totok = 0; my $files = 0; my $bad = 0; my $good = 0; @@ -157,12 +139,12 @@ sub runtests { $bonus++, $totbonus++ if $todo{$this}; } if ($this > $next) { - # warn "Test output counter mismatch [test $this]\n"; + # print "Test output counter mismatch [test $this]\n"; # no need to warn probably push @failed, $next..$this-1; } elsif ($this < $next) { #we have seen more "ok" lines than the number suggests - warn "Confused test output: test $this answered after test ", $next-1, "\n"; + print "Confused test output: test $this answered after test ", $next-1, "\n"; $next = $this; } $next = $this + 1; @@ -229,7 +211,7 @@ sub runtests { } if (@failed) { my ($txt, $canon) = canonfailed($max,$skipped,@failed); - print $txt; + print "${ml}$txt"; $failedtests{$test} = { canon => $canon, max => $max, failed => scalar @failed, name => $test, percent => 100*(scalar @failed)/$max, @@ -303,7 +285,54 @@ sub runtests { $pct = sprintf("%.2f", $good / $total * 100); my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.", $totmax - $totok, $totmax, 100*$totok/$totmax; + # Create formats + # First, figure out max length of test names + my $failed_str = "Failed Test"; + my $middle_str = " Status Wstat Total Fail Failed "; + my $list_str = "List of Failed"; + my $max_namelen = length($failed_str); my $script; + foreach $script (keys %failedtests) { + $max_namelen = + (length $failedtests{$script}->{name} > $max_namelen) ? + length $failedtests{$script}->{name} : $max_namelen; + } + my $list_len = $columns - length($middle_str) - $max_namelen; + if ($list_len < length($list_str)) { + $list_len = length($list_str); + $max_namelen = $columns - length($middle_str) - $list_len; + if ($max_namelen < length($failed_str)) { + $max_namelen = length($failed_str); + $columns = $max_namelen + length($middle_str) + $list_len; + } + } + + my $fmt_top = "format STDOUT_TOP =\n" + . sprintf("%-${max_namelen}s", $failed_str) + . $middle_str + . $list_str . "\n" + . "-" x $columns + . "\n.\n"; + my $fmt = "format STDOUT =\n" + . "@" . "<" x ($max_namelen - 1) + . " @>> @>>>> @>>>> @>>> ^##.##% " + . "^" . "<" x ($list_len - 1) . "\n" + . '{ $curtest->{name}, $curtest->{estat},' + . ' $curtest->{wstat}, $curtest->{max},' + . ' $curtest->{failed}, $curtest->{percent},' + . ' $curtest->{canon}' + . "\n}\n" + . "~~" . " " x ($columns - $list_len - 2) . "^" + . "<" x ($list_len - 1) . "\n" + . '$curtest->{canon}' + . "\n.\n"; + + eval $fmt_top; + die $@ if $@; + eval $fmt; + die $@ if $@; + + # Now write to formats for $script (sort keys %failedtests) { $curtest = $failedtests{$script}; write; @@ -322,16 +351,9 @@ sub runtests { my $tried_devel_corestack; sub corestatus { my($st) = @_; - my($ret); eval {require 'wait.ph'}; - if ($@) { - SWITCH: { - $ret = ($st & 0200); # Tim says, this is for 90% - } - } else { - $ret = WCOREDUMP($st); - } + my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; eval { require Devel::CoreStack; $have_devel_corestack++ } unless $tried_devel_corestack++; @@ -515,6 +537,12 @@ switches used to invoke perl on each test. For example, setting C<HARNESS_PERL_SWITCHES> to "-W" will run all tests with all warnings enabled. +If C<HARNESS_COLUMNS> is set, then this value will be used for the +width of the terminal. If it is not set then it will default to +C<COLUMNS>. If this is not set, it will default to 80. Note that users +of Bourne-sh based shells will need to C<export COLUMNS> for this +module to use that variable. + Harness sets C<HARNESS_ACTIVE> before executing the individual tests. This allows the tests to determine if they are being executed through the harness or by any other means. diff --git a/lib/Text/Wrap.pm b/lib/Text/Wrap.pm index 5f95edb69c..04efe19296 100644 --- a/lib/Text/Wrap.pm +++ b/lib/Text/Wrap.pm @@ -6,7 +6,7 @@ require Exporter; @EXPORT = qw(wrap fill); @EXPORT_OK = qw($columns $break $huge); -$VERSION = 98.112902; +$VERSION = 2000.06292219; #GMT use vars qw($VERSION $columns $debug $break $huge); use strict; @@ -33,7 +33,7 @@ sub wrap my $remainder = ""; while ($t !~ /^\s*$/) { - if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//xm) { + if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//x) { $r .= unexpand($nl . $lead . $1); $remainder = $2; } elsif ($huge eq 'wrap' && $t =~ s/^([^\n]{$ll})//) { diff --git a/pod/Win32.pod b/lib/Win32.pod index bd1d06581e..bd1d06581e 100644 --- a/pod/Win32.pod +++ b/lib/Win32.pod diff --git a/lib/lib.pm b/lib/lib_pm.PL index 98e2f733cb..0d2a73b842 100644 --- a/lib/lib.pm +++ b/lib/lib_pm.PL @@ -1,12 +1,36 @@ +use Config; +use File::Basename qw(&basename &dirname); +use File::Spec; +use Cwd; + +my $origdir = cwd; +chdir dirname($0); +my $file = basename($0, '.PL'); +$file =~ s!_(pm)$!.$1!i; + +my $Config_archname = defined($Config{'archname'}) ? $Config{'archname'} : ''; +my $Config_ver = defined($Config{'version'}) ? $Config{'version'} : ''; +my @Config_inc_version_list = defined($Config{'inc_version_list'}) ? + reverse split / /, $Config{'inc_version_list'} : (); + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; package lib; use 5.005_64; -use Config; -my $archname = defined($Config{'archname'}) ? $Config{'archname'} : ''; -my $ver = defined($Config{'version'}) ? $Config{'version'} : ''; -my @inc_version_list = defined($Config{'inc_version_list'}) ? - reverse split / /, $Config{'inc_version_list'} : (); +my \$archname = "$Config_archname"; +my \$ver = "$Config_ver"; +my \@inc_version_list = qw(@Config_inc_version_list); + +!GROK!THIS! +print OUT <<'!NO!SUBS!'; our @ORIG_INC = @INC; # take a handy copy of 'original' value our $VERSION = '0.5564'; @@ -131,3 +155,7 @@ FindBin - optional module which deals with paths relative to the source file. Tim Bunce, 2nd June 1995. =cut +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chdir $origdir; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 41430ac188..cc6a405823 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -980,18 +980,18 @@ EOP next CMD; }; $cmd =~ /^<\s*(.*)/ && do { unless ($1) { - print OUT "All < actions cleared.\n"; + print $OUT "All < actions cleared.\n"; $pre = []; next CMD; } if ($1 eq '?') { unless (@$pre) { - print OUT "No pre-prompt Perl actions.\n"; + print $OUT "No pre-prompt Perl actions.\n"; next CMD; } - print OUT "Perl commands run before each prompt:\n"; + print $OUT "Perl commands run before each prompt:\n"; for my $action ( @$pre ) { - print "\t< -- $action\n"; + print $OUT "\t< -- $action\n"; } next CMD; } @@ -999,18 +999,18 @@ EOP next CMD; }; $cmd =~ /^>\s*(.*)/ && do { unless ($1) { - print OUT "All > actions cleared.\n"; + print $OUT "All > actions cleared.\n"; $post = []; next CMD; } if ($1 eq '?') { unless (@$post) { - print OUT "No post-prompt Perl actions.\n"; + print $OUT "No post-prompt Perl actions.\n"; next CMD; } - print OUT "Perl commands run after each prompt:\n"; + print $OUT "Perl commands run after each prompt:\n"; for my $action ( @$post ) { - print "\t> -- $action\n"; + print $OUT "\t> -- $action\n"; } next CMD; } @@ -1018,7 +1018,7 @@ EOP next CMD; }; $cmd =~ /^\{\{\s*(.*)/ && do { if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,2))) { - print OUT "{{ is now a debugger command\n", + print $OUT "{{ is now a debugger command\n", "use `;{{' if you mean Perl code\n"; $cmd = "h {{"; redo CMD; @@ -1027,23 +1027,23 @@ EOP next CMD; }; $cmd =~ /^\{\s*(.*)/ && do { unless ($1) { - print OUT "All { actions cleared.\n"; + print $OUT "All { actions cleared.\n"; $pretype = []; next CMD; } if ($1 eq '?') { unless (@$pretype) { - print OUT "No pre-prompt debugger actions.\n"; + print $OUT "No pre-prompt debugger actions.\n"; next CMD; } - print OUT "Debugger commands run before each prompt:\n"; + print $OUT "Debugger commands run before each prompt:\n"; for my $action ( @$pretype ) { - print "\t{ -- $action\n"; + print $OUT "\t{ -- $action\n"; } next CMD; } if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,1))) { - print OUT "{ is now a debugger command\n", + print $OUT "{ is now a debugger command\n", "use `;{' if you mean Perl code\n"; $cmd = "h {"; redo CMD; @@ -1814,7 +1814,7 @@ sub readline { local $frame = 0; local $doret = -2; if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) { - print $OUT @_; + $OUT->write(join('', @_)); my $stuff; $IN->recv( $stuff, 2048 ); # XXX: what's wrong with sysread? $stuff; diff --git a/lib/unicode/Is/BidiAL.pl b/lib/unicode/Is/BidiAL.pl new file mode 100644 index 0000000000..e04f2f562d --- /dev/null +++ b/lib/unicode/Is/BidiAL.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +061b +061f +0621 063a +0640 064a +066d +0671 06d5 +06e5 06e6 +06fa 06fe +0700 070d +0710 +0712 072c +0780 07a5 +fb50 fbb1 +fbd3 fd3d +fd50 fd8f +fd92 fdc7 +fdf0 fdfb +fe70 fe72 +fe74 +fe76 fefc +END diff --git a/lib/unicode/Is/BidiBN.pl b/lib/unicode/Is/BidiBN.pl new file mode 100644 index 0000000000..795a4a9f40 --- /dev/null +++ b/lib/unicode/Is/BidiBN.pl @@ -0,0 +1,15 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0000 0008 +000e 001b +007f 0084 +0086 009f +070f +180b 180e +200b 200d +206a 206f +feff +fff9 fffb +END diff --git a/lib/unicode/Is/BidiLRE.pl b/lib/unicode/Is/BidiLRE.pl new file mode 100644 index 0000000000..ef2a6e462f --- /dev/null +++ b/lib/unicode/Is/BidiLRE.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202a +END diff --git a/lib/unicode/Is/BidiLRO.pl b/lib/unicode/Is/BidiLRO.pl new file mode 100644 index 0000000000..e9958c4b81 --- /dev/null +++ b/lib/unicode/Is/BidiLRO.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202d +END diff --git a/lib/unicode/Is/BidiNSM.pl b/lib/unicode/Is/BidiNSM.pl new file mode 100644 index 0000000000..191bc052a9 --- /dev/null +++ b/lib/unicode/Is/BidiNSM.pl @@ -0,0 +1,97 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0300 034e +0360 0362 +0483 0486 +0488 0489 +0591 05a1 +05a3 05b9 +05bb 05bd +05bf +05c1 05c2 +05c4 +064b 0655 +0670 +06d6 06e4 +06e7 06e8 +06ea 06ed +0711 +0730 074a +07a6 07b0 +0901 0902 +093c +0941 0948 +094d +0951 0954 +0962 0963 +0981 +09bc +09c1 09c4 +09cd +09e2 09e3 +0a02 +0a3c +0a41 0a42 +0a47 0a48 +0a4b 0a4d +0a70 0a71 +0a81 0a82 +0abc +0ac1 0ac5 +0ac7 0ac8 +0acd +0b01 +0b3c +0b3f +0b41 0b43 +0b4d +0b56 +0b82 +0bc0 +0bcd +0c3e 0c40 +0c46 0c48 +0c4a 0c4d +0c55 0c56 +0cbf +0cc6 +0ccc 0ccd +0d41 0d43 +0d4d +0dca +0dd2 0dd4 +0dd6 +0e31 +0e34 0e3a +0e47 0e4e +0eb1 +0eb4 0eb9 +0ebb 0ebc +0ec8 0ecd +0f18 0f19 +0f35 +0f37 +0f39 +0f71 0f7e +0f80 0f84 +0f86 0f87 +0f90 0f97 +0f99 0fbc +0fc6 +102d 1030 +1032 +1036 1037 +1039 +1058 1059 +17b7 17bd +17c6 +17c9 17d3 +18a9 +20d0 20e3 +302a 302f +3099 309a +fb1e +fe20 fe23 +END diff --git a/lib/unicode/Is/BidiPDF.pl b/lib/unicode/Is/BidiPDF.pl new file mode 100644 index 0000000000..4a3eedd564 --- /dev/null +++ b/lib/unicode/Is/BidiPDF.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202c +END diff --git a/lib/unicode/Is/BidiRLE.pl b/lib/unicode/Is/BidiRLE.pl new file mode 100644 index 0000000000..d789246ddb --- /dev/null +++ b/lib/unicode/Is/BidiRLE.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202b +END diff --git a/lib/unicode/Is/BidiRLO.pl b/lib/unicode/Is/BidiRLO.pl new file mode 100644 index 0000000000..fcb81acc93 --- /dev/null +++ b/lib/unicode/Is/BidiRLO.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202e +END diff --git a/lib/unicode/Is/Cf.pl b/lib/unicode/Is/Cf.pl new file mode 100644 index 0000000000..896c3e6cd6 --- /dev/null +++ b/lib/unicode/Is/Cf.pl @@ -0,0 +1,12 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +070f +180b 180e +200c 200f +202a 202e +206a 206f +feff +fff9 fffb +END diff --git a/lib/unicode/Is/Cn.pl b/lib/unicode/Is/Cn.pl index ec287c456a..3c686154c1 100644 --- a/lib/unicode/Is/Cn.pl +++ b/lib/unicode/Is/Cn.pl @@ -2,4 +2,358 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +0220 0221 +0234 024f +02ae 02af +02ef 02ff +034f 035f +0363 0373 +0376 0379 +037b 037d +037f 0383 +038b +038d +03a2 +03cf +03d8 03d9 +03f4 03ff +0487 +048a 048b +04c5 04c6 +04c9 04ca +04cd 04cf +04f6 04f7 +04fa 0530 +0557 0558 +0560 +0588 +058b 0590 +05a2 +05ba +05c5 05cf +05eb 05ef +05f5 060b +060d 061a +061c 061e +0620 +063b 063f +0656 065f +066e 066f +06ee 06ef +06ff +070e +072d 072f +074b 077f +07b1 0900 +0904 +093a 093b +094e 094f +0955 0957 +0971 0980 +0984 +098d 098e +0991 0992 +09a9 +09b1 +09b3 09b5 +09ba 09bb +09bd +09c5 09c6 +09c9 09ca +09ce 09d6 +09d8 09db +09de +09e4 09e5 +09fb 0a01 +0a03 0a04 +0a0b 0a0e +0a11 0a12 +0a29 +0a31 +0a34 +0a37 +0a3a 0a3b +0a3d +0a43 0a46 +0a49 0a4a +0a4e 0a58 +0a5d +0a5f 0a65 +0a75 0a80 +0a84 +0a8c +0a8e +0a92 +0aa9 +0ab1 +0ab4 +0aba 0abb +0ac6 +0aca +0ace 0acf +0ad1 0adf +0ae1 0ae5 +0af0 0b00 +0b04 +0b0d 0b0e +0b11 0b12 +0b29 +0b31 +0b34 0b35 +0b3a 0b3b +0b44 0b46 +0b49 0b4a +0b4e 0b55 +0b58 0b5b +0b5e +0b62 0b65 +0b71 0b81 +0b84 +0b8b 0b8d +0b91 +0b96 0b98 +0b9b +0b9d +0ba0 0ba2 +0ba5 0ba7 +0bab 0bad +0bb6 +0bba 0bbd +0bc3 0bc5 +0bc9 +0bce 0bd6 +0bd8 0be6 +0bf3 0c00 +0c04 +0c0d +0c11 +0c29 +0c34 +0c3a 0c3d +0c45 +0c49 +0c4e 0c54 +0c57 0c5f +0c62 0c65 +0c70 0c81 +0c84 +0c8d +0c91 +0ca9 +0cb4 +0cba 0cbd +0cc5 +0cc9 +0cce 0cd4 +0cd7 0cdd +0cdf +0ce2 0ce5 +0cf0 0d01 +0d04 +0d0d +0d11 +0d29 +0d3a 0d3d +0d44 0d45 +0d49 +0d4e 0d56 +0d58 0d5f +0d62 0d65 +0d70 0d81 +0d84 +0d97 0d99 +0db2 +0dbc +0dbe 0dbf +0dc7 0dc9 +0dcb 0dce +0dd5 +0dd7 +0de0 0df1 +0df5 0e00 +0e3b 0e3e +0e5c 0e80 +0e83 +0e85 0e86 +0e89 +0e8b 0e8c +0e8e 0e93 +0e98 +0ea0 +0ea4 +0ea6 +0ea8 0ea9 +0eac +0eba +0ebe 0ebf +0ec5 +0ec7 +0ece 0ecf +0eda 0edb +0ede 0eff +0f48 +0f6b 0f70 +0f8c 0f8f +0f98 +0fbd +0fcd 0fce +0fd0 0fff +1022 +1028 +102b +1033 1035 +103a 103f +105a 109f +10c6 10cf +10f7 10fa +10fc 10ff +115a 115e +11a3 11a7 +11fa 11ff +1207 +1247 +1249 +124e 124f +1257 +1259 +125e 125f +1287 +1289 +128e 128f +12af +12b1 +12b6 12b7 +12bf +12c1 +12c6 12c7 +12cf +12d7 +12ef +130f +1311 +1316 1317 +131f +1347 +135b 1360 +137d 139f +13f5 1400 +1677 167f +169d 169f +16f1 177f +17dd 17df +17ea 17ff +180f +181a 181f +1878 187f +18aa 1dff +1e9c 1e9f +1efa 1eff +1f16 1f17 +1f1e 1f1f +1f46 1f47 +1f4e 1f4f +1f58 +1f5a +1f5c +1f5e +1f7e 1f7f +1fb5 +1fc5 +1fd4 1fd5 +1fdc +1ff0 1ff1 +1ff5 +1fff +2047 +204e 2069 +2071 2073 +208f 209f +20b0 20cf +20e4 20ff +213b 2152 +2184 218f +21f4 21ff +22f2 22ff +237c +239b 23ff +2427 243f +244b 245f +24eb 24ff +2596 259f +25f8 25ff +2614 2618 +2672 2700 +2705 +270a 270b +2728 +274c +274e +2753 2755 +2757 +275f 2760 +2768 2775 +2795 2797 +27b0 +27bf 27ff +2900 2e7f +2e9a +2ef4 2eff +2fd6 2fef +2ffc 2fff +303b 303d +3040 +3095 3098 +309f 30a0 +30ff 3104 +312d 3130 +318f +31b8 31ff +321d 321f +3244 325f +327c 327e +32b1 32bf +32cc 32cf +32ff +3377 337a +33de 33df +33ff +4db6 4dff +9fa6 9fff +a48d a48f +a4a2 a4a3 +a4b4 +a4c1 +a4c5 +a4c7 abff +d7a4 d7ff +fa2e faff +fb07 fb12 +fb18 fb1c +fb37 +fb3d +fb3f +fb42 +fb45 +fbb2 fbd2 +fd40 fd4f +fd90 fd91 +fdc8 fdef +fdfc fe1f +fe24 fe2f +fe45 fe48 +fe53 +fe67 +fe6c fe6f +fe73 +fe75 +fefd fefe +ff00 +ff5f ff60 +ffbf ffc1 +ffc8 ffc9 +ffd0 ffd1 +ffd8 ffd9 +ffdd ffdf +ffe7 +ffef fff8 END diff --git a/lib/unicode/Is/Cs.pl b/lib/unicode/Is/Cs.pl new file mode 100644 index 0000000000..8888fb5f3c --- /dev/null +++ b/lib/unicode/Is/Cs.pl @@ -0,0 +1,8 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +d800 db7f +db80 dbff +dc00 dfff +END diff --git a/lib/unicode/Is/DCfraction.pl b/lib/unicode/Is/DCfraction.pl new file mode 100644 index 0000000000..fc2dd6755d --- /dev/null +++ b/lib/unicode/Is/DCfraction.pl @@ -0,0 +1,7 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +00bc 00be +2153 215f +END diff --git a/lib/unicode/Is/Graph.pl b/lib/unicode/Is/Graph.pl index 9c94bb722c..156f1711af 100644 --- a/lib/unicode/Is/Graph.pl +++ b/lib/unicode/Is/Graph.pl @@ -265,7 +265,8 @@ return <<'END'; 1fdd 1fef 1ff2 1ff4 1ff6 1ffe -2000 200b +2000 2008 +200b 2010 2029 202f 2046 2048 204d diff --git a/lib/unicode/Is/Me.pl b/lib/unicode/Is/Me.pl new file mode 100644 index 0000000000..00f446d87d --- /dev/null +++ b/lib/unicode/Is/Me.pl @@ -0,0 +1,9 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0488 0489 +06dd 06de +20dd 20e0 +20e2 20e3 +END diff --git a/lib/unicode/Is/Nl.pl b/lib/unicode/Is/Nl.pl new file mode 100644 index 0000000000..8f1af469bb --- /dev/null +++ b/lib/unicode/Is/Nl.pl @@ -0,0 +1,9 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +2160 2183 +3007 +3021 3029 +3038 303a +END diff --git a/lib/unicode/Is/Pc.pl b/lib/unicode/Is/Pc.pl new file mode 100644 index 0000000000..342efac344 --- /dev/null +++ b/lib/unicode/Is/Pc.pl @@ -0,0 +1,12 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +005f +203f 2040 +30fb +fe33 fe34 +fe4d fe4f +ff3f +ff65 +END diff --git a/lib/unicode/Is/Pf.pl b/lib/unicode/Is/Pf.pl new file mode 100644 index 0000000000..166c64bbb6 --- /dev/null +++ b/lib/unicode/Is/Pf.pl @@ -0,0 +1,9 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +00bb +2019 +201d +203a +END diff --git a/lib/unicode/Is/Pi.pl b/lib/unicode/Is/Pi.pl new file mode 100644 index 0000000000..7f2243d5d8 --- /dev/null +++ b/lib/unicode/Is/Pi.pl @@ -0,0 +1,10 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +00ab +2018 +201b 201c +201f +2039 +END diff --git a/lib/unicode/Is/Punct.pl b/lib/unicode/Is/Punct.pl index 8fd1e8e183..9e8684d6fc 100644 --- a/lib/unicode/Is/Punct.pl +++ b/lib/unicode/Is/Punct.pl @@ -8,45 +8,45 @@ return <<'END'; 003a 003b 003f 0040 005b 005d -005f -007b -007d -00a1 -00ab -00ad -00b7 -00bb -00bf -037e -0387 +005f +007b +007d +00a1 +00ab +00ad +00b7 +00bb +00bf +037e +0387 055a 055f 0589 058a -05be -05c0 -05c3 +05be +05c0 +05c3 05f3 05f4 -060c -061b -061f +060c +061b +061f 066a 066d -06d4 +06d4 0700 070d 0964 0965 -0970 -0df4 -0e4f +0970 +0df4 +0e4f 0e5a 0e5b 0f04 0f12 0f3a 0f3d -0f85 +0f85 104a 104f -10fb +10fb 1361 1368 166d 166e 169b 169c 16eb 16ed 17d4 17da -17dc +17dc 1800 180a 2010 2027 2030 2043 @@ -58,14 +58,14 @@ return <<'END'; 3001 3003 3008 3011 3014 301f -3030 -30fb +3030 +30fb fd3e fd3f fe30 fe44 fe49 fe52 fe54 fe61 -fe63 -fe68 +fe63 +fe68 fe6a fe6b ff01 ff03 ff05 ff0a @@ -73,8 +73,8 @@ ff0c ff0f ff1a ff1b ff1f ff20 ff3b ff3d -ff3f -ff5b -ff5d +ff3f +ff5b +ff5d ff61 ff65 END diff --git a/lib/unicode/Is/Sk.pl b/lib/unicode/Is/Sk.pl new file mode 100644 index 0000000000..b5f6e591a7 --- /dev/null +++ b/lib/unicode/Is/Sk.pl @@ -0,0 +1,27 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +005e +0060 +00a8 +00af +00b4 +00b8 +02b9 02ba +02c2 02cf +02d2 02df +02e5 02ed +0374 0375 +0384 0385 +1fbd +1fbf 1fc1 +1fcd 1fcf +1fdd 1fdf +1fed 1fef +1ffd 1ffe +309b 309c +ff3e +ff40 +ffe3 +END diff --git a/lib/unicode/Is/Space.pl b/lib/unicode/Is/Space.pl index 4121ef49b8..701329ff82 100644 --- a/lib/unicode/Is/Space.pl +++ b/lib/unicode/Is/Space.pl @@ -2,13 +2,13 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; -0009 000a -000c 000d -0020 -00a0 -1680 +0009 000d +0020 +0085 +00a0 +1680 2000 200b 2028 2029 -202f -3000 +202f +3000 END diff --git a/lib/unicode/Is/SylA.pl b/lib/unicode/Is/SylA.pl index ec287c456a..be1107822d 100644 --- a/lib/unicode/Is/SylA.pl +++ b/lib/unicode/Is/SylA.pl @@ -2,4 +2,157 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1203 +120b +1213 +121b +1223 +122b +1233 +123b +1243 +1253 +1263 +126b +1273 +127b +1283 +1293 +129b +12a3 +12ab +12bb +12cb +12d3 +12db +12e3 +12eb +12f3 +12fb +1303 +130b +131b +1323 +132b +1333 +133b +1343 +134b +1353 +13a0 +13a6 13a7 +13ad +13b3 +13b9 +13be 13bf +13c6 +13cc +13d3 13d4 +13dc 13dd +13e3 +13e9 +13ef +140a +1438 +1455 +146a +1472 +1490 +14aa +14c7 +14da +14f4 +1515 +152d +154b +154d +1559 +1566 +156e +1573 +1579 +1583 +1589 +158d +1593 +159a +159e +15a4 +15ac +15b3 +15b7 +15bb +15bf +15c3 +15c9 +15cf +15d5 +15e1 +15e7 +15ed +15f4 +15fa +1600 +1607 +160d +1613 +161b +1621 +1627 +162d +1633 +1639 +163f +1645 +164d +1653 +1659 +1660 +1666 +166c +1675 +30a1 30a2 +30ab 30ac +30b5 30b6 +30bf 30c0 +30ca +30cf 30d1 +30de +30e3 30e4 +30e9 +30ee 30ef +30f5 +30f7 +32d0 +32d5 +32da +32df +32e4 +32e9 +32ee +32f3 +32f6 +32fb +ff67 +ff6c +ff71 +ff76 +ff7b +ff80 +ff85 +ff8a +ff8f +ff94 +ff97 +ff9c +3041 3042 +304b 304c +3055 3056 +305f 3060 +306a +306f 3071 +307e +3083 3084 +3089 +308e 308f END diff --git a/lib/unicode/Is/SylAA.pl b/lib/unicode/Is/SylAA.pl new file mode 100644 index 0000000000..45d6692de7 --- /dev/null +++ b/lib/unicode/Is/SylAA.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +140b +1439 +1456 +1473 +1491 +14ab +14c8 +14db +14f5 +1516 +152e +154c +155a +1567 +157a +1584 +1594 +15a5 +15ad +1676 +END diff --git a/lib/unicode/Is/SylAAI.pl b/lib/unicode/Is/SylAAI.pl new file mode 100644 index 0000000000..a8b03d4c6c --- /dev/null +++ b/lib/unicode/Is/SylAAI.pl @@ -0,0 +1,19 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1402 +1430 +144d +146c +148a +14a4 +14c1 +14d4 +14ee +1527 +1545 +1554 +157e +158e +END diff --git a/lib/unicode/Is/SylAI.pl b/lib/unicode/Is/SylAI.pl new file mode 100644 index 0000000000..b70d793bc6 --- /dev/null +++ b/lib/unicode/Is/SylAI.pl @@ -0,0 +1,7 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +141c +166f 1670 +END diff --git a/lib/unicode/Is/SylC.pl b/lib/unicode/Is/SylC.pl index ec287c456a..e2a1601dd3 100644 --- a/lib/unicode/Is/SylC.pl +++ b/lib/unicode/Is/SylC.pl @@ -2,4 +2,69 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1205 +120d +1215 +121d +1225 +122d +1235 +123d +1245 +1255 +1265 +126d +1275 +127d +1285 +1295 +129d +12a5 +12ad +12bd +12cd +12d5 +12dd +12e5 +12ed +12f5 +12fd +1305 +130d +131d +1325 +132d +1335 +133d +1345 +134d +1355 +13c0 +13cd +141d +142b 142e +1449 144b +1466 +1483 +1485 1488 +14a1 +14bb 14bf +14d0 14d2 +14ea 14ec +1505 1506 +1508 150b +1525 +153e 1540 +1550 1552 +155d +156a +156f +157b 157d +1585 +1595 1596 +159f +15a6 +15ae 15af +30f3 +ff9d END diff --git a/lib/unicode/Is/SylE.pl b/lib/unicode/Is/SylE.pl index ec287c456a..b3c3e60437 100644 --- a/lib/unicode/Is/SylE.pl +++ b/lib/unicode/Is/SylE.pl @@ -2,4 +2,146 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1204 +120c +1214 +121c +1224 +122c +1234 +123c +1244 +1254 +1264 +126c +1274 +127c +1284 +1294 +129c +12a4 +12ac +12bc +12cc +12d4 +12dc +12e4 +12ec +12f4 +12fc +1304 +130c +131c +1324 +132c +1334 +133c +1344 +134c +1354 +13a1 +13a8 +13ae +13b4 +13ba +13c1 +13c7 +13ce +13d5 13d6 +13de +13e4 +13ea +13f0 +1401 +142f +144c +1467 +146b +1489 +14a3 +14c0 +14d3 +14ed +1510 +1526 +1542 1544 +1553 +155e 155f +156b +1570 +1574 +1586 +158a +1597 +159b +15a7 +15b0 +15b4 +15b8 +15bc +15c0 +15c6 +15cc +15d2 +15de +15e4 +15ea +15f1 +15f7 +15fd +1604 +160a +1610 +1617 +161e +1624 +162a +1630 +1636 +163c +1642 +164a +1650 +1656 +165d +1663 +1669 +30a7 30a8 +30b1 30b2 +30bb 30bc +30c6 30c7 +30cd +30d8 30da +30e1 +30ec +30f1 +30f6 +30f9 +32d3 +32d8 +32dd +32e2 +32e7 +32ec +32f1 +32f9 +32fd +ff6a +ff74 +ff79 +ff7e +ff83 +ff88 +ff8d +ff92 +ff9a +3047 3048 +3051 3052 +305b 305c +3066 3067 +306d +3078 307a +3081 +308c +3091 END diff --git a/lib/unicode/Is/SylEE.pl b/lib/unicode/Is/SylEE.pl new file mode 100644 index 0000000000..0a22f78f65 --- /dev/null +++ b/lib/unicode/Is/SylEE.pl @@ -0,0 +1,34 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1408 +1436 +1453 +15c7 +15cd +15d3 +15df +15e5 +15eb +15f2 +15f8 +15fe +1605 +160b +1611 +1618 +161f +1625 +162b +1631 +1637 +163d +1643 +164b +1651 +1657 +165e +1664 +166a +END diff --git a/lib/unicode/Is/SylI.pl b/lib/unicode/Is/SylI.pl index ec287c456a..f80790ce44 100644 --- a/lib/unicode/Is/SylI.pl +++ b/lib/unicode/Is/SylI.pl @@ -2,4 +2,153 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1202 +120a +1212 +121a +1222 +122a +1232 +123a +1242 +1252 +1262 +126a +1272 +127a +1282 +1292 +129a +12a2 +12aa +12ba +12ca +12d2 +12da +12e2 +12ea +12f2 +12fa +1302 +130a +131a +1322 +132a +1332 +133a +1342 +134a +1352 +13a2 +13a9 +13af +13b5 +13bb +13c2 +13c8 +13cf +13d7 13d8 +13df +13e5 +13eb +13f1 +1403 +1409 +1431 +1437 +144e +1454 +1468 +146d +148b +14a5 +14c2 +14d5 +14ef +1511 +1528 +1541 +1546 +1555 +1560 1561 +156c +1571 +1575 +157f +1587 +158b +158f +1598 +159c +15a0 +15a8 +15b1 +15b5 +15b9 +15bd +15c1 +15c8 +15ce +15d4 +15e0 +15e6 +15ec +15f3 +15f9 +15ff +1606 +160c +1612 +1619 161a +1620 +1626 +162c +1632 +1638 +163e +1644 +164c +1652 +1658 +165f +1665 +166b +1671 +30a3 30a4 +30ad 30ae +30b7 30b8 +30c1 30c2 +30cb +30d2 30d4 +30df +30ea +30f0 +30f8 +32d1 +32d6 +32db +32e0 +32e5 +32ea +32ef +32f7 +32fc +ff68 +ff72 +ff77 +ff7c +ff81 +ff86 +ff8b +ff90 +ff98 +3043 3044 +304d 304e +3057 3058 +3061 3062 +306b +3072 3074 +307f +308a +3090 END diff --git a/lib/unicode/Is/SylII.pl b/lib/unicode/Is/SylII.pl new file mode 100644 index 0000000000..4516d7a32a --- /dev/null +++ b/lib/unicode/Is/SylII.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1404 +1432 +144f +146e +148c +14a6 +14c3 +14d6 +14f0 +1512 +1529 +1547 +1556 +1562 1563 +1576 +1580 +1590 +15a1 +15a9 +1672 +END diff --git a/lib/unicode/Is/SylN.pl b/lib/unicode/Is/SylN.pl new file mode 100644 index 0000000000..215463fb7f --- /dev/null +++ b/lib/unicode/Is/SylN.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +3093 +END diff --git a/lib/unicode/Is/SylO.pl b/lib/unicode/Is/SylO.pl index ec287c456a..a0a6f7dd01 100644 --- a/lib/unicode/Is/SylO.pl +++ b/lib/unicode/Is/SylO.pl @@ -2,4 +2,156 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1206 +120e +1216 +121e +1226 +122e +1236 +123e +1246 +1256 +1266 +126e +1276 +127e +1286 +1296 +129e +12a6 +12ae +12be +12ce +12d6 +12de +12e6 +12ee +12f6 +12fe +1306 +130e +131e +1326 +132e +1336 +133e +1346 +134e +1356 +13a3 +13aa +13b0 +13b6 +13bc +13c3 +13c9 +13d0 +13d9 +13e0 +13e6 +13ec +13f2 +1405 +1433 +1450 +1469 +146f +148d +14a7 +14c4 +14d7 +14f1 +1513 +152a +1548 +154a +1557 +1564 +156d +1572 +1577 +1581 +1588 +158c +1591 +1599 +159d +15a2 +15aa +15b2 +15b6 +15ba +15be +15c2 +15c5 +15cb +15d1 +15dd +15e3 +15e9 +15f0 +15f6 +15fc +1603 +1609 +160f +1616 +161d +1623 +1629 +162f +1635 +163b +1641 +1649 +164f +1655 +165c +1662 +1668 +1673 +30a9 30aa +30b3 30b4 +30bd 30be +30c8 30c9 +30ce +30db 30dd +30e2 +30e7 30e8 +30ed +30f2 +30fa +32d4 +32d9 +32de +32e3 +32e8 +32ed +32f2 +32f5 +32fa +32fe +ff66 +ff6b +ff6e +ff75 +ff7a +ff7f +ff84 +ff89 +ff8e +ff93 +ff96 +ff9b +3049 304a +3053 3054 +305d 305e +3068 3069 +306e +307b 307d +3082 +3087 3088 +308d +3092 END diff --git a/lib/unicode/Is/SylOO.pl b/lib/unicode/Is/SylOO.pl new file mode 100644 index 0000000000..12280534b1 --- /dev/null +++ b/lib/unicode/Is/SylOO.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1406 1407 +1434 1435 +1451 1452 +1470 1471 +148e 148f +14a8 14a9 +14c5 14c6 +14d8 14d9 +14f2 14f3 +1514 +152b 152c +1549 +1558 +1565 +1578 +1582 +1592 +15a3 +15ab +1674 +END diff --git a/lib/unicode/Is/SylU.pl b/lib/unicode/Is/SylU.pl index ec287c456a..c458382f25 100644 --- a/lib/unicode/Is/SylU.pl +++ b/lib/unicode/Is/SylU.pl @@ -2,4 +2,121 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1201 +1209 +1211 +1219 +1221 +1229 +1231 +1239 +1241 +1251 +1261 +1269 +1271 +1279 +1281 +1291 +1299 +12a1 +12a9 +12b9 +12c9 +12d1 +12d9 +12e1 +12e9 +12f1 +12f9 +1301 +1309 +1319 +1321 +1329 +1331 +1339 +1341 +1349 +1351 +13a4 +13ab +13b1 +13b7 +13bd +13c4 +13ca +13d1 +13da +13e1 +13e7 +13ed +13f3 +15c4 +15ca +15d0 +15dc +15e2 +15e8 +15ef +15f5 +15fb +1602 +1608 +160e +1614 1615 +161c +1622 +1628 +162e +1634 +163a +1640 +1648 +164e +1654 +165b +1661 +1667 +30a5 30a6 +30af 30b0 +30b9 30ba +30c3 30c5 +30cc +30d5 30d7 +30e0 +30e5 30e6 +30eb +30f4 +32d2 +32d7 +32dc +32e1 +32e6 +32eb +32f0 +32f4 +32f8 +ff69 +ff6d +ff6f +ff73 +ff78 +ff7d +ff82 +ff87 +ff8c +ff91 +ff95 +ff99 +3045 3046 +304f 3050 +3059 305a +3063 3065 +306c +3075 3077 +3080 +3085 3086 +308b +3094 END diff --git a/lib/unicode/Is/SylV.pl b/lib/unicode/Is/SylV.pl index ec287c456a..b6e76f81b9 100644 --- a/lib/unicode/Is/SylV.pl +++ b/lib/unicode/Is/SylV.pl @@ -2,4 +2,53 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1200 +1208 +1210 +1218 +1220 +1228 +1230 +1238 +1240 +1250 +1260 +1268 +1270 +1278 +1280 +1290 +1298 +12a0 +12a8 +12b8 +12c8 +12d0 +12d8 +12e0 +12e8 +12f0 +12f8 +1300 +1308 +1318 +1320 +1328 +1330 +1338 +1340 +1348 +1350 +13a5 +13ac +13b2 +13b8 +13c5 +13cb +13d2 +13db +13e2 +13e8 +13ee +13f4 END diff --git a/lib/unicode/Is/SylWA.pl b/lib/unicode/Is/SylWA.pl index ec287c456a..9bb529ed01 100644 --- a/lib/unicode/Is/SylWA.pl +++ b/lib/unicode/Is/SylWA.pl @@ -2,4 +2,48 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +120f +1217 +121f +1227 +122f +1237 +123f +124b +125b +1267 +126f +1277 +127f +128b +1297 +129f +12a7 +12b3 +12c3 +12df +12e7 +12f7 +12ff +1307 +1313 +1327 +132f +1337 +133f +134f +1357 +1417 1418 +1444 1445 +1461 1462 +147e 147f +149c 149d +14b6 14b7 +14cb 14cc +14e6 14e7 +1500 1501 +150c 150f +1521 1522 +1539 153a +15db END diff --git a/lib/unicode/Is/SylWAA.pl b/lib/unicode/Is/SylWAA.pl new file mode 100644 index 0000000000..5f3b784d0c --- /dev/null +++ b/lib/unicode/Is/SylWAA.pl @@ -0,0 +1,19 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1419 141b +1446 1448 +1463 1465 +1480 1482 +149e 14a0 +14b8 14ba +14cd 14cf +14e8 14e9 +1502 1504 +1523 1524 +153b 153d +154e 154f +155b 155c +1568 1569 +END diff --git a/lib/unicode/Is/SylWC.pl b/lib/unicode/Is/SylWC.pl index ec287c456a..3ad968c505 100644 --- a/lib/unicode/Is/SylWC.pl +++ b/lib/unicode/Is/SylWC.pl @@ -2,4 +2,12 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +124d +125d +128d +12b5 +12c5 +1315 +1484 +1507 END diff --git a/lib/unicode/Is/SylWE.pl b/lib/unicode/Is/SylWE.pl index ec287c456a..9e32c0e602 100644 --- a/lib/unicode/Is/SylWE.pl +++ b/lib/unicode/Is/SylWE.pl @@ -2,4 +2,22 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +124c +125c +128c +12b4 +12c4 +1314 +140c 140d +143a 143b +1457 1458 +1474 1475 +1492 1493 +14ac 14ad +14c9 14ca +14dc 14dd +14f6 14f7 +1517 1518 +152f 1530 +15d8 END diff --git a/lib/unicode/Is/SylWEE.pl b/lib/unicode/Is/SylWEE.pl new file mode 100644 index 0000000000..c4bccb5240 --- /dev/null +++ b/lib/unicode/Is/SylWEE.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +15d9 +END diff --git a/lib/unicode/Is/SylWI.pl b/lib/unicode/Is/SylWI.pl index ec287c456a..4cd6c6789c 100644 --- a/lib/unicode/Is/SylWI.pl +++ b/lib/unicode/Is/SylWI.pl @@ -2,4 +2,21 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +124a +125a +128a +12b2 +12c2 +1312 +140e 140f +143c 143d +1459 145a +1476 1477 +1494 1495 +14ae 14af +14de 14df +14f8 14f9 +1519 151a +1531 1532 +15da END diff --git a/lib/unicode/Is/SylWII.pl b/lib/unicode/Is/SylWII.pl new file mode 100644 index 0000000000..bd68aeadf5 --- /dev/null +++ b/lib/unicode/Is/SylWII.pl @@ -0,0 +1,15 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1410 1411 +143e 143f +145b 145c +1478 1479 +1496 1497 +14b0 14b1 +14e0 14e1 +14fa 14fb +151b 151c +1533 1534 +END diff --git a/lib/unicode/Is/SylWO.pl b/lib/unicode/Is/SylWO.pl new file mode 100644 index 0000000000..7676564130 --- /dev/null +++ b/lib/unicode/Is/SylWO.pl @@ -0,0 +1,16 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1412 1413 +1440 1441 +145d 145e +147a 147b +1498 1499 +14b2 14b3 +14e2 14e3 +14fc 14fd +151d 151e +1535 1536 +15d7 +END diff --git a/lib/unicode/Is/SylWOO.pl b/lib/unicode/Is/SylWOO.pl new file mode 100644 index 0000000000..0ab766a553 --- /dev/null +++ b/lib/unicode/Is/SylWOO.pl @@ -0,0 +1,15 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1414 1416 +1442 1443 +145f 1460 +147c 147d +149a 149b +14b4 14b5 +14e4 14e5 +14fe 14ff +151f 1520 +1537 1538 +END diff --git a/lib/unicode/Is/SylWU.pl b/lib/unicode/Is/SylWU.pl new file mode 100644 index 0000000000..76af7aefad --- /dev/null +++ b/lib/unicode/Is/SylWU.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +15d6 +END diff --git a/lib/unicode/Is/SylWV.pl b/lib/unicode/Is/SylWV.pl index ec287c456a..8bd8849042 100644 --- a/lib/unicode/Is/SylWV.pl +++ b/lib/unicode/Is/SylWV.pl @@ -2,4 +2,10 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1248 +1258 +1288 +12b0 +12c0 +1310 END diff --git a/lib/unicode/Is/Upper.pl b/lib/unicode/Is/Upper.pl index 8dde2742d0..4fda655dc4 100644 --- a/lib/unicode/Is/Upper.pl +++ b/lib/unicode/Is/Upper.pl @@ -86,9 +86,9 @@ return <<'END'; 01b5 01b7 01b8 01bc -01c4 -01c7 -01ca +01c4 01c5 +01c7 01c8 +01ca 01cb 01cd 01cf 01d1 @@ -106,7 +106,7 @@ return <<'END'; 01ea 01ec 01ee -01f1 +01f1 01f2 01f4 01f6 01f8 01fa @@ -355,11 +355,14 @@ return <<'END'; 1f5d 1f5f 1f68 1f6f -1fb8 1fbb -1fc8 1fcb +1f88 1f8f +1f98 1f9f +1fa8 1faf +1fb8 1fbc +1fc8 1fcc 1fd8 1fdb 1fe8 1fec -1ff8 1ffb +1ff8 1ffc 2102 2107 210b 210d diff --git a/lib/unicode/Makefile b/lib/unicode/Makefile index c68fa3af00..af5e77b47b 100644 --- a/lib/unicode/Makefile +++ b/lib/unicode/Makefile @@ -1,6 +1,5 @@ all: - ./mktables.PL - ./MakeEthiopicSyllables.PL + ../../miniperl -I../../lib ./mktables.PL clean: rm -f *.pl */*.pl diff --git a/lib/unicode/mktables.PL b/lib/unicode/mktables.PL index 4f705a4016..241d2e6bb3 100755 --- a/lib/unicode/mktables.PL +++ b/lib/unicode/mktables.PL @@ -1,6 +1,11 @@ #!../../miniperl +use bytes; + $UnicodeData = "Unicode.300"; +$SyllableData = "syllables.txt"; +$PropData = "Props.txt"; + # Note: we try to keep filenames unique within first 8 chars. Using # subdirectories for the following helps. @@ -14,16 +19,15 @@ mkdir "To", 0777; ['IsWord', '$cat =~ /^L[ulot]|^Nd/ or $code eq "005F"', ''], ['IsAlnum', '$cat =~ /^L[ulot]|^Nd/', ''], ['IsAlpha', '$cat =~ /^L[ulot]/', ''], - # XXX broken: recursive definition (/\s/ will look up IsSpace in future) - ['IsSpace', '$cat =~ /^Z/ or $code lt "0020" and chr(hex $code) =~ /^\s/', ''], + ['IsSpace', 'White space', $PropData], ['IsDigit', '$cat =~ /^Nd$/', ''], - ['IsUpper', '$cat =~ /^Lu$/', ''], + ['IsUpper', '$cat =~ /^L[ut]$/', ''], ['IsLower', '$cat =~ /^Ll$/', ''], ['IsASCII', 'hex $code <= 127', ''], ['IsCntrl', '$cat =~ /^C/', ''], - ['IsGraph', '$cat =~ /^[^C]/ and $code ne "0020"', ''], + ['IsGraph', '$cat =~ /^[^C]/ and ($cat !~ /^Z/ and $code ne "0020" or chr(hex $code) !~ /^\s/)', ''], ['IsPrint', '$cat =~ /^[^C]/', ''], - ['IsPunct', '$cat =~ /^P/', ''], + ['IsPunct', 'Punctuation', $PropData], ['IsXDigit', '$code =~ /^00(3[0-9]|[46][1-6])$/', ''], ['ToUpper', '$up', '$up'], ['ToLower', '$down', '$down'], @@ -43,12 +47,14 @@ mkdir "To", 0777; ['IsM', '$cat =~ /^M/', ''], # Mark ['IsMn', '$cat eq "Mn"', ''], # Mark, Non-Spacing ['IsMc', '$cat eq "Mc"', ''], # Mark, Combining + ['IsMe', '$cat eq "Me"', ''], # Mark, Enclosing ['IsN', '$cat =~ /^N/', ''], # Number ['IsNd', '$cat eq "Nd"', ''], # Number, Decimal Digit ['IsNo', '$cat eq "No"', ''], # Number, Other + ['IsNl', '$cat eq "Nl"', ''], # Number, Letter - ['IsZ', '$cat =~ /^Z/', ''], # Zeparator + ['IsZ', '$cat =~ /^Z/', ''], # Separator ['IsZs', '$cat eq "Zs"', ''], # Separator, Space ['IsZl', '$cat eq "Zl"', ''], # Separator, Line ['IsZp', '$cat eq "Zp"', ''], # Separator, Paragraph @@ -57,6 +63,9 @@ mkdir "To", 0777; ['IsCc', '$cat eq "Cc"', ''], # Other, Control or Format ['IsCo', '$cat eq "Co"', ''], # Other, Private Use ['IsCn', '$cat eq "Cn"', ''], # Other, Not Assigned + ['IsCf', '$cat eq "Cf"', ''], # Other, Format + ['IsCs', '$cat eq "Cs"', ''], # Other, Surrogate + ['IsCn', 'Unassigned Code Value',$PropData], # Other, Not Assigned # Informative @@ -72,9 +81,13 @@ mkdir "To", 0777; ['IsPs', '$cat eq "Ps"', ''], # Punctuation, Open ['IsPe', '$cat eq "Pe"', ''], # Punctuation, Close ['IsPo', '$cat eq "Po"', ''], # Punctuation, Other + ['IsPc', '$cat eq "Pc"', ''], # Punctuation, Connector + ['IsPi', '$cat eq "Pi"', ''], # Punctuation, Initial quote + ['IsPf', '$cat eq "Pf"', ''], # Punctuation, Final quote ['IsS', '$cat =~ /^S/', ''], # Symbol ['IsSm', '$cat eq "Sm"', ''], # Symbol, Math + ['IsSk', '$cat eq "Sk"', ''], # Symbol, Modifier ['IsSc', '$cat eq "Sc"', ''], # Symbol, Currency ['IsSo', '$cat eq "So"', ''], # Symbol, Other @@ -95,6 +108,15 @@ mkdir "To", 0777; # and punctuation specific to # those scripts + ['IsBidiLRE', '$bid eq "LRE"', ''], # Left-to-Right Embedding + ['IsBidiLRO', '$bid eq "LRO"', ''], # Left-to-Right Override + ['IsBidiAL', '$bid eq "AL"', ''], # Right-to-Left Arabic + ['IsBidiRLE', '$bid eq "RLE"', ''], # Right-to-Left Embedding + ['IsBidiRLO', '$bid eq "RLO"', ''], # Right-to-Left Override + ['IsBidiPDF', '$bid eq "PDF"', ''], # Pop Directional Format + ['IsBidiNSM', '$bid eq "NSM"', ''], # Non-Spacing Mark + ['IsBidiBN', '$bid eq "BN"', ''], # Boundary Neutral + # Weak types: ['IsBidiEN','$bid eq "EN"', ''], # European Number @@ -134,6 +156,7 @@ mkdir "To", 0777; ['IsDCnarrow', '$decomp =~ /^<narrow>/', ''], ['IsDCsmall', '$decomp =~ /^<small>/', ''], ['IsDCsquare', '$decomp =~ /^<square>/', ''], + ['IsDCfraction', '$decomp =~ /^<fraction>/', ''], ['IsDCcompat', '$decomp =~ /^<compat>/', ''], # Number @@ -155,19 +178,8 @@ mkdir "To", 0777; # Syllables - ['IsSylV', '$syl eq "V"', ''], - ['IsSylU', '$syl eq "U"', ''], - ['IsSylI', '$syl eq "I"', ''], - ['IsSylA', '$syl eq "A"', ''], - ['IsSylE', '$syl eq "E"', ''], - ['IsSylC', '$syl eq "C"', ''], - ['IsSylO', '$syl eq "O"', ''], - ['IsSylWV', '$syl eq "V"', ''], - ['IsSylWI', '$syl eq "I"', ''], - ['IsSylWA', '$syl eq "A"', ''], - ['IsSylWE', '$syl eq "E"', ''], - ['IsSylWC', '$syl eq "C"', ''], - + syllable_defs(), + # Line break properties - Normative ['IsLbrkBK','$brk eq "BK"', ''], # Mandatory Break @@ -232,8 +244,8 @@ END exit if @ARGV and not grep { $_ eq Block } @ARGV; print "Block\n"; -open(UD, 'Blocks.txt') or die "Can't open blocks.txt: $!\n"; -open(OUT, ">Block.pl") or die "Can't create $table.pl: $!\n"; +open(UD, 'Blocks.txt') or die "Can't open Blocks.txt: $!\n"; +open(OUT, ">Block.pl") or die "Can't create Block.pl: $!\n"; print OUT <<EOH; # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is built by $0 from e.g. $UnicodeData. @@ -277,6 +289,8 @@ sub proplist { my $out; my $split; + return listFromPropFile($wanted) if $val eq $PropData; + if ($table =~ /^Arab/) { open(UD, "ArabShap.txt") or warn "Can't open $table: $!"; @@ -288,7 +302,7 @@ sub proplist { $split = '($code, $short, $name) = split(/; */); $code =~ s/^U\+//;'; } elsif ($table =~ /^IsSyl/) { - open(UD, "syllables.txt") or warn "Can't open $table: $!"; + open(UD, $SyllableData) or warn "Can't open $table: $!"; $split = '($code, $short, $syl) = split(/; */); $code =~ s/^U\+//;'; } @@ -308,8 +322,8 @@ sub proplist { eval <<"END"; while (<UD>) { next if /^#/; - next if /^\s/; - chop; + next if /^\\s/; + s/\\s+\$//; $split if ($wanted) { push(\@wanted, [hex \$code, hex $val, \$name =~ /, First>\$/]); @@ -343,7 +357,7 @@ END eval <<"END"; while (<UD>) { next if /^#/; - next if /^\s*\$/; + next if /^\\s*\$/; chop; $split if ($wanted) { @@ -376,4 +390,44 @@ END $out; } +sub listFromPropFile { + my ($wanted) = @_; + my $out; + + open (UD, $PropData) or die "Can't open $PropData: $!\n"; + local($/) = "\n" . '*' x 43 . "\n\nProperty dump for:"; # not 42? + + <UD>; + while (<UD>) { + chomp; + if (s/0x[\d\w]+\s+\((.*?)\)// and $wanted eq $1) { + s/\(\d+ chars\)//g; + s/^\s+//mg; + s/\s+$//mg; + s/\.\./\t/g; + $out = lc $_; + last; + } + } + close (UD); + "$out\n"; +} + +sub syllable_defs { + my @defs; + my %seen; + + open (SD, $SyllableData) or die "Can't open $SyllableData: $!\n"; + while (<SD>) { + next if /^\s*(#|$)/; + s/\s+$//; + ($code, $name, $syl) = split /; */; + next unless $syl; + push (@defs, ["IsSyl$syl", qq{\$syl eq "$syl"}, '']) + unless $seen{$syl}++; + } + close (SD); + return (@defs); +} + # eof diff --git a/lib/warnings.pm b/lib/warnings.pm index 11558d50d4..ac6d919954 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -60,7 +60,7 @@ will be used. =back -See L<perlmod/Pragmatic Modules> and L<perllexwarn>. +See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>. =cut diff --git a/lib/warnings/register.pm b/lib/warnings/register.pm index da6be97952..f98075a5ee 100644 --- a/lib/warnings/register.pm +++ b/lib/warnings/register.pm @@ -1,5 +1,13 @@ package warnings::register ; +=pod + +=head1 NAME + +warnings::register - warnings import function + +=cut + require warnings ; sub mkMask diff --git a/makedef.pl b/makedef.pl index 6fae88be9e..a02a298213 100644 --- a/makedef.pl +++ b/makedef.pl @@ -157,7 +157,7 @@ elsif ($PLATFORM eq 'os2') { # print STDERR "'$dll' <= '$define{PERL_DLL}'\n"; print <<"---EOP---"; LIBRARY '$dll' INITINSTANCE TERMINSTANCE -DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $CONFIG_ARGS' +DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter' STACKSIZE 32768 CODE LOADONCALL DATA LOADONCALL NONSHARED MULTIPLE @@ -259,6 +259,7 @@ elsif ($PLATFORM eq 'aix') { Perl_safexrealloc Perl_same_dirent Perl_unlnk + Perl_sys_intern_clear Perl_sys_intern_dup Perl_sys_intern_init PL_cryptseen @@ -402,6 +403,8 @@ unless ($define{'USE_5005THREADS'}) { PL_svref_mutex PL_cred_mutex PL_eval_mutex + PL_fdpid_mutex + PL_sv_lock_mutex PL_eval_cond PL_eval_owner PL_threads_mutex @@ -418,6 +421,7 @@ unless ($define{'USE_5005THREADS'}) { Perl_find_threadsv Perl_unlock_condpair Perl_magic_mutexfree + Perl_sv_lock )]; } @@ -489,8 +489,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { char msg[256]; - sv_setnv(sv,(double)gLastMacOSErr); - sv_setpv(sv, gLastMacOSErr ? GetSysErrText(gLastMacOSErr, msg) : ""); + sv_setnv(sv,(double)gMacPerl_OSErr); + sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : ""); } #else #ifdef VMS @@ -614,6 +614,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { i = t1 - s1; s = rx->subbeg + s1; + if (!rx->subbeg) + break; + getrx: if (i >= 0) { bool was_tainted; @@ -950,6 +953,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) return 0; } +#ifndef PERL_MICRO int Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) { @@ -1066,6 +1070,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) } return 0; } +#endif /* !PERL_MICRO */ int Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) @@ -1670,7 +1675,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\005': /* ^E */ #ifdef MACOS_TRADITIONAL - gLastMacOSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); #else # ifdef VMS set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); @@ -1994,6 +1999,30 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; #ifndef MACOS_TRADITIONAL case '0': +#ifdef HAS_SETPROCTITLE + /* The BSDs don't show the argv[] in ps(1) output, they + * show a string from the process struct and provide + * the setproctitle() routine to manipulate that. */ + { + s = SvPV(sv, len); +# if __FreeBSD_version >= 410001 + /* The leading "-" removes the "perl: " prefix, + * but not the "(perl) suffix from the ps(1) + * output, because that's what ps(1) shows if the + * argv[] is modified. */ + setproctitle("-%s", s, len + 1); +# else /* old FreeBSDs, NetBSD, OpenBSD, anyBSD */ + /* This doesn't really work if you assume that + * $0 = 'foobar'; will wipe out 'perl' from the $0 + * because in ps(1) output the result will be like + * sprintf("perl: %s (perl)", s) + * I guess this is a security feature: + * one (a user process) cannot get rid of the original name. + * --jhi */ + setproctitle("%s", s); +# endif + } +#endif if (!PL_origalen) { s = PL_origargv[0]; s += strlen(s); diff --git a/mpeix/relink b/mpeix/relink index 625e2f03a5..a36e23c750 100755 --- a/mpeix/relink +++ b/mpeix/relink @@ -4,5 +4,10 @@ # libraries via gcc or ld. For now, re-run gcc without the external library # list, and then run the native linker with the list of dynamic libraries. -gcc -o perl perlmain.o lib/auto/DynaLoader/DynaLoader.a libperl.a `cat ext.libs` -L/BIND/PUB/lib -lbind -L/SYSLOG/PUB -lsyslog -callci 'linkedit "altprog ./perl;xl=/usr/lib/libcurses.sl,/lib/libsvipc.sl,/usr/lib/libsocket.sl,/lib/libm.sl,/lib/libc.sl"' +gcc -o perl perlmain.o \ + lib/auto/DynaLoader/DynaLoader.a \ + libperl.a \ + `cat ext.libs` \ + -L/BIND/PUB/lib -lbind \ + -L/SYSLOG/PUB -lsyslog +callci 'linkedit "altprog ./perl;xl=/usr/lib/libcurses.sl,/lib/libsvipc.sl,/usr/lib/libsocket.sl,/usr/lib/libstr.sl,/lib/libm.sl,/lib/libc.sl"' diff --git a/myconfig.SH b/myconfig.SH index 7861f5e0ed..a797e60781 100644 --- a/myconfig.SH +++ b/myconfig.SH @@ -37,7 +37,7 @@ Summary of my $package (revision $baserev version $PERL_VERSION subversion $PERL useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble usesocks=$usesocks Compiler: - cc='$cc', optimize='$optimize', gccversion=$gccversion + cc='$cc', optimize='$optimize', gccversion=$gccversion, gccosandvers=$gccosandvers cppflags='$cppflags' ccflags ='$ccflags' stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork @@ -35,6 +35,10 @@ #define Perl_Gv_AMupdate pPerl->Perl_Gv_AMupdate #undef Gv_AMupdate #define Gv_AMupdate Perl_Gv_AMupdate +#undef Perl_apply_attrs_string +#define Perl_apply_attrs_string pPerl->Perl_apply_attrs_string +#undef apply_attrs_string +#define apply_attrs_string Perl_apply_attrs_string #undef Perl_avhv_delete_ent #define Perl_avhv_delete_ent pPerl->Perl_avhv_delete_ent #undef avhv_delete_ent @@ -79,10 +83,6 @@ #define Perl_av_extend pPerl->Perl_av_extend #undef av_extend #define av_extend Perl_av_extend -#undef Perl_av_fake -#define Perl_av_fake pPerl->Perl_av_fake -#undef av_fake -#define av_fake Perl_av_fake #undef Perl_av_fetch #define Perl_av_fetch pPerl->Perl_av_fetch #undef av_fetch @@ -107,10 +107,6 @@ #define Perl_av_push pPerl->Perl_av_push #undef av_push #define av_push Perl_av_push -#undef Perl_av_reify -#define Perl_av_reify pPerl->Perl_av_reify -#undef av_reify -#define av_reify Perl_av_reify #undef Perl_av_shift #define Perl_av_shift pPerl->Perl_av_shift #undef av_shift @@ -427,6 +423,10 @@ #define Perl_gv_efullname3 pPerl->Perl_gv_efullname3 #undef gv_efullname3 #define gv_efullname3 Perl_gv_efullname3 +#undef Perl_gv_efullname4 +#define Perl_gv_efullname4 pPerl->Perl_gv_efullname4 +#undef gv_efullname4 +#define gv_efullname4 Perl_gv_efullname4 #undef Perl_gv_fetchfile #define Perl_gv_fetchfile pPerl->Perl_gv_fetchfile #undef gv_fetchfile @@ -455,6 +455,10 @@ #define Perl_gv_fullname3 pPerl->Perl_gv_fullname3 #undef gv_fullname3 #define gv_fullname3 Perl_gv_fullname3 +#undef Perl_gv_fullname4 +#define Perl_gv_fullname4 pPerl->Perl_gv_fullname4 +#undef gv_fullname4 +#define gv_fullname4 Perl_gv_fullname4 #undef Perl_gv_init #define Perl_gv_init pPerl->Perl_gv_init #undef gv_init @@ -707,6 +711,10 @@ #define Perl_is_utf8_char pPerl->Perl_is_utf8_char #undef is_utf8_char #define is_utf8_char Perl_is_utf8_char +#undef Perl_is_utf8_string +#define Perl_is_utf8_string pPerl->Perl_is_utf8_string +#undef is_utf8_string +#define is_utf8_string Perl_is_utf8_string #undef Perl_is_utf8_alnum #define Perl_is_utf8_alnum pPerl->Perl_is_utf8_alnum #undef is_utf8_alnum @@ -1345,6 +1353,10 @@ #define Perl_save_generic_svref pPerl->Perl_save_generic_svref #undef save_generic_svref #define save_generic_svref Perl_save_generic_svref +#undef Perl_save_generic_pvref +#define Perl_save_generic_pvref pPerl->Perl_save_generic_pvref +#undef save_generic_pvref +#define save_generic_pvref Perl_save_generic_pvref #undef Perl_save_gp #define Perl_save_gp pPerl->Perl_save_gp #undef save_gp @@ -1845,6 +1857,14 @@ #define Perl_utf8_hop pPerl->Perl_utf8_hop #undef utf8_hop #define utf8_hop Perl_utf8_hop +#undef Perl_utf8_to_bytes +#define Perl_utf8_to_bytes pPerl->Perl_utf8_to_bytes +#undef utf8_to_bytes +#define utf8_to_bytes Perl_utf8_to_bytes +#undef Perl_bytes_to_utf8 +#define Perl_bytes_to_utf8 pPerl->Perl_bytes_to_utf8 +#undef bytes_to_utf8 +#define bytes_to_utf8 Perl_bytes_to_utf8 #undef Perl_utf8_to_uv #define Perl_utf8_to_uv pPerl->Perl_utf8_to_uv #undef utf8_to_uv @@ -1934,6 +1954,12 @@ #define Perl_runops_debug pPerl->Perl_runops_debug #undef runops_debug #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#undef Perl_sv_lock +#define Perl_sv_lock pPerl->Perl_sv_lock +#undef sv_lock +#define sv_lock Perl_sv_lock +#endif #undef Perl_sv_catpvf_mg #define Perl_sv_catpvf_mg pPerl->Perl_sv_catpvf_mg #undef sv_catpvf_mg @@ -2185,6 +2211,10 @@ #define ptr_table_split Perl_ptr_table_split #endif #if defined(HAVE_INTERP_INTERN) +#undef Perl_sys_intern_clear +#define Perl_sys_intern_clear pPerl->Perl_sys_intern_clear +#undef sys_intern_clear +#define sys_intern_clear Perl_sys_intern_clear #undef Perl_sys_intern_init #define Perl_sys_intern_init pPerl->Perl_sys_intern_init #undef sys_intern_init @@ -162,6 +162,7 @@ Perl_pad_allocmy(pTHX_ char *name) do { if ((sv = svp[off]) && sv != &PL_sv_undef + && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash) && strEQ(name, SvPVX(sv))) { @@ -783,6 +784,7 @@ S_op_clear(pTHX_ OP *o) cSVOPo->op_sv = Nullsv; #endif break; + case OP_METHOD_NAMED: case OP_CONST: SvREFCNT_dec(cSVOPo->op_sv); cSVOPo->op_sv = Nullsv; @@ -842,8 +844,8 @@ S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); #ifdef USE_ITHREADS - Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */ - Safefree(CopSTASHPV(cop)); /* XXXXX share in a pvtable? */ + Safefree(CopFILE(cop)); /* XXX share in a pvtable? */ + Safefree(CopSTASHPV(cop)); /* XXX share in a pvtable? */ #else /* NOTE: COP.cop_stash is not refcounted */ SvREFCNT_dec(CopFILEGV(cop)); @@ -1163,7 +1165,6 @@ Perl_scalarvoid(pTHX_ OP *o) case OP_DBSTATE: case OP_ENTERTRY: case OP_ENTER: - case OP_SCALAR: if (!(o->op_flags & OPf_KIDS)) break; /* FALL THROUGH */ @@ -1182,6 +1183,8 @@ Perl_scalarvoid(pTHX_ OP *o) case OP_REQUIRE: /* all requires must return a boolean value */ o->op_flags &= ~OPf_WANT; + /* FALL THROUGH */ + case OP_SCALAR: return scalar(o); case OP_SPLIT: if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { @@ -1848,6 +1851,37 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) LEAVE; } +void +Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, + char *attrstr, STRLEN len) +{ + OP *attrs = Nullop; + + if (!len) { + len = strlen(attrstr); + } + + while (len) { + for (; isSPACE(*attrstr) && len; --len, ++attrstr) ; + if (len) { + char *sstr = attrstr; + for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ; + attrs = append_elem(OP_LIST, attrs, + newSVOP(OP_CONST, 0, + newSVpvn(sstr, attrstr-sstr))); + } + } + + Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, + newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1), + Nullsv, prepend_elem(OP_LIST, + newSVOP(OP_CONST, 0, newSVpv(stashpv,0)), + prepend_elem(OP_LIST, + newSVOP(OP_CONST, 0, + newRV((SV*)cv)), + attrs))); +} + STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs) { @@ -1949,11 +1983,14 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) desc, sample, sample); } - if (right->op_type == OP_MATCH || + if (!(right->op_flags & OPf_STACKED) && + (right->op_type == OP_MATCH || right->op_type == OP_SUBST || - right->op_type == OP_TRANS) { + right->op_type == OP_TRANS)) { right->op_flags |= OPf_STACKED; - if (right->op_type != OP_MATCH) + if (right->op_type != OP_MATCH && + ! (right->op_type == OP_TRANS && + right->op_private & OPpTRANS_IDENTICAL)) left = mod(left, right->op_type); if (right->op_type == OP_TRANS) o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); @@ -2571,6 +2608,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) complement = o->op_private & OPpTRANS_COMPLEMENT; del = o->op_private & OPpTRANS_DELETE; squash = o->op_private & OPpTRANS_SQUASH; + + if (SvUTF8(tstr)) + o->op_private |= OPpTRANS_FROM_UTF; + + if (SvUTF8(rstr)) + o->op_private |= OPpTRANS_TO_UTF; if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) { SV* listsv = newSVpvn("# comment\n",10); @@ -2642,15 +2685,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) r = t; rlen = tlen; rend = tend; } if (!squash) { - if (to_utf && from_utf) { /* only counting characters */ - if (t == r || (tlen == rlen && memEQ(t, r, tlen))) - o->op_private |= OPpTRANS_IDENTICAL; - } - else { /* straight latin-1 translation */ - if (tlen == 4 && memEQ(t, "\0\377\303\277", 4) && - rlen == 4 && memEQ(r, "\0\377\303\277", 4)) + if (t == r || + (tlen == rlen && memEQ((char *)t, (char *)r, tlen))) + { o->op_private |= OPpTRANS_IDENTICAL; - } + } } while (t < tend || tfirst <= tlast) { @@ -3496,9 +3535,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) PL_copline = NOLINE; } #ifdef USE_ITHREADS - CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */ + CopFILE_set(cop, CopFILE(PL_curcop)); /* XXX share in a pvtable? */ #else - CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop))); + CopFILEGV_set(cop, CopFILEGV(PL_curcop)); #endif CopSTASH_set(cop, PL_curstash); @@ -4427,9 +4466,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (!name || GvCVGEN(gv)) cv = Nullcv; else if ((cv = GvCV(gv))) { - cv_ckproto(cv, gv, ps); + bool exists = CvROOT(cv) || CvXSUB(cv); + /* if the subroutine doesn't exist and wasn't pre-declared + * with a prototype, assume it will be AUTOLOADed, + * skipping the prototype check + */ + if (exists || SvPOK(cv)) + cv_ckproto(cv, gv, ps); /* already defined (or promised)? */ - if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { + if (exists || GvASSUMECV(gv)) { SV* const_sv; bool const_changed = TRUE; if (!block && !attrs) { @@ -4444,7 +4489,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) goto withattrs; if ((const_sv = cv_const_sv(cv))) const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv)); - if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE)) + if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE)) { line_t oldline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, PL_copline); @@ -4647,8 +4692,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (!PL_beginav) PL_beginav = newAV(); DEBUG_x( dump_sub(gv) ); - av_push(PL_beginav, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_push(PL_beginav, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ call_list(oldscope, PL_beginav); PL_curcop = &PL_compiling; @@ -4660,8 +4705,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_endav = newAV(); DEBUG_x( dump_sub(gv) ); av_unshift(PL_endav, 1); - av_store(PL_endav, 0, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_store(PL_endav, 0, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } else if (strEQ(s, "CHECK") && !PL_error_count) { if (!PL_checkav) @@ -4670,8 +4715,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (PL_main_start && ckWARN(WARN_VOID)) Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block"); av_unshift(PL_checkav, 1); - av_store(PL_checkav, 0, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_store(PL_checkav, 0, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } else if (strEQ(s, "INIT") && !PL_error_count) { if (!PL_initav) @@ -4679,8 +4724,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) DEBUG_x( dump_sub(gv) ); if (PL_main_start && ckWARN(WARN_VOID)) Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block"); - av_push(PL_initav, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_push(PL_initav, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } } @@ -4706,10 +4751,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) dTHR; ENTER; - SAVECOPLINE(PL_curcop); - SAVEHINTS(); + SAVECOPLINE(PL_curcop); CopLINE_set(PL_curcop, PL_copline); + + SAVEHINTS(); PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) { @@ -4806,15 +4852,15 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) if (strEQ(s, "BEGIN")) { if (!PL_beginav) PL_beginav = newAV(); - av_push(PL_beginav, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_push(PL_beginav, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } else if (strEQ(s, "END")) { if (!PL_endav) PL_endav = newAV(); av_unshift(PL_endav, 1); - av_store(PL_endav, 0, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_store(PL_endav, 0, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } else if (strEQ(s, "CHECK")) { if (!PL_checkav) @@ -4822,16 +4868,16 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) if (PL_main_start && ckWARN(WARN_VOID)) Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block"); av_unshift(PL_checkav, 1); - av_store(PL_checkav, 0, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_store(PL_checkav, 0, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } else if (strEQ(s, "INIT")) { if (!PL_initav) PL_initav = newAV(); if (PL_main_start && ckWARN(WARN_VOID)) Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block"); - av_push(PL_initav, SvREFCNT_inc(cv)); - GvCV(gv) = 0; + av_push(PL_initav, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ } } else @@ -5335,6 +5381,7 @@ Perl_ck_rvconst(pTHX_ register OP *o) #ifdef USE_ITHREADS /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */ kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP); + SvREFCNT_dec(PL_curpad[kPADOP->op_padix]); GvIN_PAD_on(gv); PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv); #else @@ -6155,7 +6202,7 @@ Perl_ck_split(pTHX_ OP *o) cLISTOPo->op_last = kid; /* There was only one element previously */ } - if (kid->op_type != OP_MATCH) { + if (kid->op_type != OP_MATCH || kid->op_flags & OPf_STACKED) { OP *sibl = kid->op_sibling; kid->op_sibling = 0; kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop); @@ -94,7 +94,8 @@ Deprecated. Use C<GIMME_V> instead. /* On OP_EXISTS, treat av as av, not avhv. */ /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ /* On OP_ENTERITER, loop var is per-thread */ - /* On pushre, re is /\s+/ imp. by split " " */ + /* On pushre, re is /\s+/ imp. by split " " */ + /* On regcomp, "use re 'eval'" was in scope */ /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST @@ -439,7 +439,7 @@ EXT char *PL_op_desc[] = { "integer addition (+)", "subtraction (-)", "integer subtraction (-)", - "concatenation (.)", + "concatenation (.) or string", "string", "left bitshift (<<)", "right bitshift (>>)", @@ -513,7 +513,7 @@ EXT char *PL_op_desc[] = { "unpack", "pack", "split", - "join", + "join or string", "list", "list slice", "anonymous list ([])", @@ -193,6 +193,9 @@ END '}', 13, # loopexop ); +my %OP_IS_SOCKET; +my %OP_IS_FILETEST; + for (@ops) { $argsum = 0; $flags = $flags{$_}; @@ -210,7 +213,12 @@ for (@ops) { $argsum |= $opclass{$1} << 9; $mul = 0x2000; # 2 ^ OASHIFT for $arg (split(' ',$args{$_})) { + if ($arg =~ /^F/) { + $OP_IS_SOCKET{$_} = 1 if $arg =~ s/s//; + $OP_IS_FILETEST{$_} = 1 if $arg =~ s/-//; + } $argnum = ($arg =~ s/\?//) ? 8 : 0; + die "op = $_, arg = $arg\n" unless length($arg) == 1; $argnum += $argnum{$arg}; warn "# Conflicting bit 32 for '$_'.\n" if $argnum & 8 and $mul == 0x10000000; @@ -228,6 +236,20 @@ print <<END; END_EXTERN_C END +if (keys %OP_IS_SOCKET) { + print ON "\n#define OP_IS_SOCKET(op) \\\n\t("; + print ON join(" || \\\n\t ", + map { "(op) == OP_" . uc() } sort keys %OP_IS_SOCKET); + print ON ")\n\n"; +} + +if (keys %OP_IS_FILETEST) { + print ON "\n#define OP_IS_FILETEST(op) \\\n\t("; + print ON join(" || \\\n\t ", + map { "(op) == OP_" . uc() } sort keys %OP_IS_FILETEST); + print ON ")\n\n"; +} + close OC or die "Error closing opcode.h: $!"; close ON or die "Error closing opnames.h: $!"; @@ -434,7 +456,7 @@ add addition (+) ck_null IfsT2 S S i_add integer addition (+) ck_null ifsT2 S S subtract subtraction (-) ck_null IfsT2 S S i_subtract integer subtraction (-) ck_null ifsT2 S S -concat concatenation (.) ck_concat fsT2 S S +concat concatenation (.) or string ck_concat fsT2 S S stringify string ck_fun fsT@ S left_shift left bitshift (<<) ck_bitop fsT2 S S @@ -533,7 +555,7 @@ hslice hash slice ck_null m@ H L unpack unpack ck_fun @ S S pack pack ck_fun mst@ S L split split ck_split t@ S S S -join join ck_join mst@ S L +join join or string ck_join mst@ S L # List operators. @@ -635,8 +657,8 @@ sysseek sysseek ck_fun s@ F S S sysread sysread ck_fun imst@ F R S S? syswrite syswrite ck_fun imst@ F S S? S? -send send ck_fun imst@ F S S S? -recv recv ck_fun imst@ F R S S +send send ck_fun imst@ Fs S S S? +recv recv ck_fun imst@ Fs R S S eof eof ck_eof is% F? tell tell ck_fun st% F? @@ -650,52 +672,52 @@ flock flock ck_fun isT@ F S # Sockets. -socket socket ck_fun is@ F S S S -sockpair socketpair ck_fun is@ F F S S S +socket socket ck_fun is@ Fs S S S +sockpair socketpair ck_fun is@ Fs Fs S S S -bind bind ck_fun is@ F S -connect connect ck_fun is@ F S -listen listen ck_fun is@ F S -accept accept ck_fun ist@ F F -shutdown shutdown ck_fun ist@ F S +bind bind ck_fun is@ Fs S +connect connect ck_fun is@ Fs S +listen listen ck_fun is@ Fs S +accept accept ck_fun ist@ Fs Fs +shutdown shutdown ck_fun ist@ Fs S -gsockopt getsockopt ck_fun is@ F S S -ssockopt setsockopt ck_fun is@ F S S S +gsockopt getsockopt ck_fun is@ Fs S S +ssockopt setsockopt ck_fun is@ Fs S S S -getsockname getsockname ck_fun is% F -getpeername getpeername ck_fun is% F +getsockname getsockname ck_fun is% Fs +getpeername getpeername ck_fun is% Fs # Stat calls. lstat lstat ck_ftst u- F stat stat ck_ftst u- F -ftrread -R ck_ftst isu- F -ftrwrite -W ck_ftst isu- F -ftrexec -X ck_ftst isu- F -fteread -r ck_ftst isu- F -ftewrite -w ck_ftst isu- F -fteexec -x ck_ftst isu- F -ftis -e ck_ftst isu- F -fteowned -O ck_ftst isu- F -ftrowned -o ck_ftst isu- F -ftzero -z ck_ftst isu- F -ftsize -s ck_ftst istu- F -ftmtime -M ck_ftst stu- F -ftatime -A ck_ftst stu- F -ftctime -C ck_ftst stu- F -ftsock -S ck_ftst isu- F -ftchr -c ck_ftst isu- F -ftblk -b ck_ftst isu- F -ftfile -f ck_ftst isu- F -ftdir -d ck_ftst isu- F -ftpipe -p ck_ftst isu- F -ftlink -l ck_ftst isu- F -ftsuid -u ck_ftst isu- F -ftsgid -g ck_ftst isu- F -ftsvtx -k ck_ftst isu- F -fttty -t ck_ftst is- F -fttext -T ck_ftst isu- F -ftbinary -B ck_ftst isu- F +ftrread -R ck_ftst isu- F- +ftrwrite -W ck_ftst isu- F- +ftrexec -X ck_ftst isu- F- +fteread -r ck_ftst isu- F- +ftewrite -w ck_ftst isu- F- +fteexec -x ck_ftst isu- F- +ftis -e ck_ftst isu- F- +fteowned -O ck_ftst isu- F- +ftrowned -o ck_ftst isu- F- +ftzero -z ck_ftst isu- F- +ftsize -s ck_ftst istu- F- +ftmtime -M ck_ftst stu- F- +ftatime -A ck_ftst stu- F- +ftctime -C ck_ftst stu- F- +ftsock -S ck_ftst isu- F- +ftchr -c ck_ftst isu- F- +ftblk -b ck_ftst isu- F- +ftfile -f ck_ftst isu- F- +ftdir -d ck_ftst isu- F- +ftpipe -p ck_ftst isu- F- +ftlink -l ck_ftst isu- F- +ftsuid -u ck_ftst isu- F- +ftsgid -g ck_ftst isu- F- +ftsvtx -k ck_ftst isu- F- +fttty -t ck_ftst is- F- +fttext -T ck_ftst isu- F- +ftbinary -B ck_ftst isu- F- # File calls. @@ -360,3 +360,49 @@ typedef enum opcode { #define MAXO 351 + +#define OP_IS_SOCKET(op) \ + ((op) == OP_ACCEPT || \ + (op) == OP_BIND || \ + (op) == OP_CONNECT || \ + (op) == OP_GETPEERNAME || \ + (op) == OP_GETSOCKNAME || \ + (op) == OP_GSOCKOPT || \ + (op) == OP_LISTEN || \ + (op) == OP_RECV || \ + (op) == OP_SEND || \ + (op) == OP_SHUTDOWN || \ + (op) == OP_SOCKET || \ + (op) == OP_SOCKPAIR || \ + (op) == OP_SSOCKOPT) + + +#define OP_IS_FILETEST(op) \ + ((op) == OP_FTATIME || \ + (op) == OP_FTBINARY || \ + (op) == OP_FTBLK || \ + (op) == OP_FTCHR || \ + (op) == OP_FTCTIME || \ + (op) == OP_FTDIR || \ + (op) == OP_FTEEXEC || \ + (op) == OP_FTEOWNED || \ + (op) == OP_FTEREAD || \ + (op) == OP_FTEWRITE || \ + (op) == OP_FTFILE || \ + (op) == OP_FTIS || \ + (op) == OP_FTLINK || \ + (op) == OP_FTMTIME || \ + (op) == OP_FTPIPE || \ + (op) == OP_FTREXEC || \ + (op) == OP_FTROWNED || \ + (op) == OP_FTRREAD || \ + (op) == OP_FTRWRITE || \ + (op) == OP_FTSGID || \ + (op) == OP_FTSIZE || \ + (op) == OP_FTSOCK || \ + (op) == OP_FTSUID || \ + (op) == OP_FTSVTX || \ + (op) == OP_FTTEXT || \ + (op) == OP_FTTTY || \ + (op) == OP_FTZERO) + diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index 3a50dc737c..f5a0c15634 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -66,7 +66,7 @@ $(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT) perl5.olddef: perl.linkexp echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@ - echo DESCRIPTION "'Perl interpreter v$(PERL_FULLVERSION), export autogenerated, built with $(CONFIG_ARGS)'" >>$@ + echo DESCRIPTION "'Perl interpreter v$(PERL_FULLVERSION), export autogenerated'" >>$@ echo STACKSIZE 32768 >>$@ echo CODE LOADONCALL >>$@ echo DATA LOADONCALL NONSHARED MULTIPLE >>$@ diff --git a/os2/OS2/REXX/t/rx_dllld.t b/os2/OS2/REXX/t/rx_dllld.t index 15362d78e9..406bd63a33 100644 --- a/os2/OS2/REXX/t/rx_dllld.t +++ b/os2/OS2/REXX/t/rx_dllld.t @@ -12,11 +12,11 @@ use OS2::REXX; $path = $ENV{LIBPATH} || $ENV{PATH} or die; foreach $dir (split(';', $path)) { - next unless -f "$dir/YDBAUTIL.DLL"; - $found = "$dir/YDBAUTIL.DLL"; + next unless -f "$dir/RXU.DLL"; + $found = "$dir/RXU.DLL"; last; } -$found or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; +$found or print "1..0 # skipped: cannot find RXU.DLL\n" and exit; print "1..5\n"; diff --git a/os2/OS2/REXX/t/rx_objcall.t b/os2/OS2/REXX/t/rx_objcall.t index 8bdf90564d..b1154757d4 100644 --- a/os2/OS2/REXX/t/rx_objcall.t +++ b/os2/OS2/REXX/t/rx_objcall.t @@ -13,22 +13,21 @@ use OS2::REXX; # # DLL # -$ydba = load OS2::REXX "ydbautil" - or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; +$rxu = load OS2::REXX "rxu" + or print "1..0 # skipped: cannot find RXU.DLL\n" and exit; print "1..5\n", "ok 1\n"; # # function # -@pid = $ydba->RxProcId(); +@pid = $rxu->RxProcId(); @pid == 1 ? print "ok 2\n" : print "not ok 2\n"; @res = split " ", $pid[0]; print "ok 3\n" if $res[0] == $$; -@pid = $ydba->RxProcId(); +@pid = $rxu->RxProcId(); @res = split " ", $pid[0]; print "ok 4\n" if $res[0] == $$; print "# @pid\n"; -eval { $ydba->nixda(); }; +eval { $rxu->nixda(); }; print "ok 5\n" if $@ =~ /^Can't find entry 'nixda\'/; - diff --git a/os2/OS2/REXX/t/rx_tievar.t b/os2/OS2/REXX/t/rx_tievar.t index 5f43f4e5fc..9c9ea7d466 100644 --- a/os2/OS2/REXX/t/rx_tievar.t +++ b/os2/OS2/REXX/t/rx_tievar.t @@ -13,8 +13,8 @@ use OS2::REXX; # # DLL # -load OS2::REXX "ydbautil" - or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; +load OS2::REXX "rxu" + or print "1..0 # skipped: cannot find RXU.DLL\n" and exit; print "1..19\n"; diff --git a/os2/OS2/REXX/t/rx_tieydb.t b/os2/OS2/REXX/t/rx_tieydb.t index 1653a2081c..ec6bfca20e 100644 --- a/os2/OS2/REXX/t/rx_tieydb.t +++ b/os2/OS2/REXX/t/rx_tieydb.t @@ -9,8 +9,8 @@ BEGIN { } use OS2::REXX; -$rx = load OS2::REXX "ydbautil" # from RXU17.ZIP - or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; +$rx = load OS2::REXX "RXU" # from RXU1a.ZIP + or print "1..0 # skipped: cannot find RXU.DLL\n" and exit; print "1..7\n", "ok 1\n"; @@ -66,7 +66,7 @@ pthread_join(perl_os_thread tid, void **status) break; case pthreads_st_waited: MUTEX_UNLOCK(&start_thread_mutex); - croak("join with a thread with a waiter"); + Perl_croak_nocontext("join with a thread with a waiter"); break; case pthreads_st_run: thread_join_data[tid].state = pthreads_st_waited; @@ -79,7 +79,7 @@ pthread_join(perl_os_thread tid, void **status) break; default: MUTEX_UNLOCK(&start_thread_mutex); - croak("join: unknown thread state: '%s'", + Perl_croak_nocontext("join: unknown thread state: '%s'", pthreads_states[thread_join_data[tid].state]); break; } @@ -107,7 +107,7 @@ pthread_startit(void *arg) } } if (thread_join_data[tid].state != pthreads_st_none) - croak("attempt to reuse thread id %i", tid); + Perl_croak_nocontext("attempt to reuse thread id %i", tid); thread_join_data[tid].state = pthreads_st_run; /* Now that we copied/updated the guys, we may release the caller... */ MUTEX_UNLOCK(&start_thread_mutex); @@ -146,7 +146,7 @@ pthread_detach(perl_os_thread tid) switch (thread_join_data[tid].state) { case pthreads_st_waited: MUTEX_UNLOCK(&start_thread_mutex); - croak("detach on a thread with a waiter"); + Perl_croak_nocontext("detach on a thread with a waiter"); break; case pthreads_st_run: thread_join_data[tid].state = pthreads_st_detached; @@ -154,7 +154,7 @@ pthread_detach(perl_os_thread tid) break; default: MUTEX_UNLOCK(&start_thread_mutex); - croak("detach: unknown thread state: '%s'", + Perl_croak_nocontext("detach: unknown thread state: '%s'", pthreads_states[thread_join_data[tid].state]); break; } @@ -168,11 +168,11 @@ os2_cond_wait(perl_cond *c, perl_mutex *m) int rc; STRLEN n_a; if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET)) - croak("panic: COND_WAIT-reset: rc=%i", rc); + Perl_croak_nocontext("panic: COND_WAIT-reset: rc=%i", rc); if (m) MUTEX_UNLOCK(m); if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT)) && (rc != ERROR_INTERRUPT)) - croak("panic: COND_WAIT: rc=%i", rc); + Perl_croak_nocontext("panic: COND_WAIT: rc=%i", rc); if (rc == ERROR_INTERRUPT) errno = EINTR; if (m) MUTEX_LOCK(m); @@ -199,12 +199,12 @@ loadByOrd(char *modname, ULONG ord) if ((!hdosc && CheckOSError(DosLoadModule(buf, sizeof buf, modname, &hdosc))) || CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn))) - croak("This version of OS/2 does not support %s.%i", + Perl_croak_nocontext("This version of OS/2 does not support %s.%i", modname, loadOrd[ord]); ExtFCN[ord] = fcn; } if ((long)ExtFCN[ord] == -1) - croak("panic queryaddr"); + Perl_croak_nocontext("panic queryaddr"); } void @@ -227,11 +227,11 @@ init_PMWIN_entries(void) return; if (CheckOSError(DosLoadModule(buf, sizeof buf, "pmwin", &hpmwin))) - croak("This version of OS/2 does not support pmwin: error in %s", buf); + Perl_croak_nocontext("This version of OS/2 does not support pmwin: error in %s", buf); while (i <= 5) { if (CheckOSError(DosQueryProcAddr(hpmwin, ords[i], NULL, ((PFN*)&PMWIN_entries)+i))) - croak("This version of OS/2 does not support pmwin.%d", ords[i]); + Perl_croak_nocontext("This version of OS/2 does not support pmwin.%d", ords[i]); i++; } } @@ -277,7 +277,7 @@ sys_prio(pid) } if (pid != psi->procdata->pid) { Safefree(psi); - croak("panic: wrong pid in sysinfo"); + Perl_croak_nocontext("panic: wrong pid in sysinfo"); } prio = psi->procdata->threads->priority; Safefree(psi); @@ -373,8 +373,9 @@ spawn_sighandler(int sig) } static int -result(int flag, int pid) +result(pTHX_ int flag, int pid) { + dTHR; int r, status; Signal_t (*ihand)(); /* place to save signal during system() */ Signal_t (*qhand)(); /* place to save signal during system() */ @@ -441,7 +442,7 @@ file_type(char *path) ULONG apptype; if (!(_emx_env & 0x200)) - croak("file_type not implemented on DOS"); /* not OS/2. */ + Perl_croak_nocontext("file_type not implemented on DOS"); /* not OS/2. */ if (CheckOSError(DosQueryAppType(path, &apptype))) { switch (rc) { case ERROR_FILE_NOT_FOUND: @@ -464,12 +465,7 @@ static ULONG os2_mytype; /* global PL_Argv[] contains arguments. */ int -do_spawn_ve(really, flag, execf, inicmd, addflag) -SV *really; -U32 flag; -U32 execf; -char *inicmd; -U32 addflag; +do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) { dTHR; int trueflag = flag; @@ -541,7 +537,7 @@ U32 addflag; if (flag == P_NOWAIT) flag = P_PM; else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION) - warn("Starting PM process with flag=%d, mytype=%d", + Perl_warner(aTHX_ WARN_EXEC, "Starting PM process with flag=%d, mytype=%d", flag, os2_mytype); } } @@ -552,7 +548,7 @@ U32 addflag; if (flag == P_NOWAIT) flag = P_SESSION; else if ((flag & 7) != P_SESSION) - warn("Starting Full Screen process with flag=%d, mytype=%d", + Perl_warner(aTHX_ WARN_EXEC, "Starting Full Screen process with flag=%d, mytype=%d", flag, os2_mytype); } } @@ -584,7 +580,7 @@ U32 addflag; } #if 0 - rc = result(trueflag, spawnvp(flag,tmps,PL_Argv)); + rc = result(aTHX_ trueflag, spawnvp(flag,tmps,PL_Argv)); #else if (execf == EXECF_TRUEEXEC) rc = execvp(tmps,PL_Argv); @@ -593,7 +589,7 @@ U32 addflag; else if (execf == EXECF_SPAWN_NOWAIT) rc = spawnvp(flag,tmps,PL_Argv); else /* EXECF_SPAWN, EXECF_SPAWN_BYFLAG */ - rc = result(trueflag, + rc = result(aTHX_ trueflag, spawnvp(flag,tmps,PL_Argv)); #endif if (rc < 0 && pass == 1 @@ -618,7 +614,7 @@ U32 addflag; if (l >= sizeof scrbuf) { Safefree(scr); longbuf: - warn("Size of scriptname too big: %d", l); + Perl_warner(aTHX_ WARN_EXEC, "Size of scriptname too big: %d", l); rc = -1; goto finish; } @@ -654,7 +650,7 @@ U32 addflag; } if (fclose(file) != 0) { /* Failure */ panic_file: - warn("Error reading \"%s\": %s", + Perl_warner(aTHX_ WARN_EXEC, "Error reading \"%s\": %s", scr, Strerror(errno)); buf[0] = 0; /* Not #! */ goto doshell_args; @@ -698,7 +694,7 @@ U32 addflag; *s++ = 0; } if (nargs == -1) { - warn("Too many args on %.*s line of \"%s\"", + Perl_warner(aTHX_ WARN_EXEC, "Too many args on %.*s line of \"%s\"", s1 - buf, buf, scr); nargs = 4; argsp = fargs; @@ -820,8 +816,9 @@ U32 addflag; /* Try converting 1-arg form to (usually shell-less) multi-arg form. */ int -do_spawn3(char *cmd, int execf, int flag) +do_spawn3(pTHX_ char *cmd, int execf, int flag) { + dTHR; register char **a; register char *s; char flags[10]; @@ -905,7 +902,7 @@ do_spawn3(char *cmd, int execf, int flag) rc = spawnl(flag,shell,shell,copt,cmd,(char*)0); else { /* In the ak code internal P_NOWAIT is P_WAIT ??? */ - rc = result(P_WAIT, + rc = result(aTHX_ P_WAIT, spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); if (rc < 0 && ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", @@ -936,7 +933,7 @@ do_spawn3(char *cmd, int execf, int flag) } *a = Nullch; if (PL_Argv[0]) - rc = do_spawn_ve(NULL, flag, execf, cmd, mergestderr); + rc = do_spawn_ve(aTHX_ NULL, flag, execf, cmd, mergestderr); else rc = -1; if (news) @@ -947,10 +944,7 @@ do_spawn3(char *cmd, int execf, int flag) /* Array spawn. */ int -do_aspawn(really,mark,sp) -SV *really; -register SV **mark; -register SV **sp; +os2_do_aspawn(pTHX_ SV *really, register SV **mark, register SV **sp) { dTHR; register char **a; @@ -978,9 +972,9 @@ register SV **sp; *a = Nullch; if (flag_set && (a == PL_Argv + 1)) { /* One arg? */ - rc = do_spawn3(a[-1], EXECF_SPAWN_BYFLAG, flag); + rc = do_spawn3(aTHX_ a[-1], EXECF_SPAWN_BYFLAG, flag); } else - rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0); + rc = do_spawn_ve(aTHX_ really, flag, EXECF_SPAWN, NULL, 0); } else rc = -1; do_execfree(); @@ -988,38 +982,36 @@ register SV **sp; } int -do_spawn(cmd) -char *cmd; +os2_do_spawn(pTHX_ char *cmd) { - return do_spawn3(cmd, EXECF_SPAWN, 0); + dTHR; + return do_spawn3(aTHX_ cmd, EXECF_SPAWN, 0); } int -do_spawn_nowait(cmd) -char *cmd; +do_spawn_nowait(pTHX_ char *cmd) { - return do_spawn3(cmd, EXECF_SPAWN_NOWAIT,0); + dTHR; + return do_spawn3(aTHX_ cmd, EXECF_SPAWN_NOWAIT,0); } bool -do_exec(cmd) -char *cmd; +Perl_do_exec(pTHX_ char *cmd) { - do_spawn3(cmd, EXECF_EXEC, 0); + dTHR; + do_spawn3(aTHX_ cmd, EXECF_EXEC, 0); return FALSE; } bool -os2exec(cmd) -char *cmd; +os2exec(pTHX_ char *cmd) { - return do_spawn3(cmd, EXECF_TRUEEXEC, 0); + dTHR; + return do_spawn3(aTHX_ cmd, EXECF_TRUEEXEC, 0); } PerlIO * -my_syspopen(cmd,mode) -char *cmd; -char *mode; +my_syspopen(pTHX_ char *cmd, char *mode) { #ifndef USE_POPEN @@ -1069,7 +1061,7 @@ char *mode; fcntl(p[this], F_SETFD, FD_CLOEXEC); if (newfd != -1) fcntl(newfd, F_SETFD, FD_CLOEXEC); - pid = do_spawn_nowait(cmd); + pid = do_spawn_nowait(aTHX_ cmd); if (newfd == -1) close(*mode == 'r'); /* It was closed initially */ else if (newfd != (*mode == 'r')) { /* Probably this check is not needed */ @@ -1124,7 +1116,7 @@ char *mode; int fork(void) { - croak(PL_no_func, "Unsupported function fork"); + Perl_croak_nocontext(PL_no_func, "Unsupported function fork"); errno = EINVAL; return -1; } @@ -1150,7 +1142,7 @@ tcp0(char *name) static BYTE buf[20]; PFN fcn; - if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */ + if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */ if (!htcp) DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp); if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0) @@ -1164,7 +1156,7 @@ tcp1(char *name, int arg) static BYTE buf[20]; PFN fcn; - if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */ + if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */ if (!htcp) DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp); if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0) @@ -1230,7 +1222,7 @@ sys_alloc(int size) { if (rc == ERROR_NOT_ENOUGH_MEMORY) { return (void *) -1; } else if ( rc ) - croak("Got an error from DosAllocMem: %li", (long)rc); + Perl_croak_nocontext("Got an error from DosAllocMem: %li", (long)rc); return got; } @@ -1264,7 +1256,7 @@ XS(XS_File__Copy_syscopy) { dXSARGS; if (items < 2 || items > 3) - croak("Usage: File::Copy::syscopy(src,dst,flag=0)"); + Perl_croak_nocontext("Usage: File::Copy::syscopy(src,dst,flag=0)"); { STRLEN n_a; char * src = (char *)SvPV(ST(0),n_a); @@ -1288,8 +1280,7 @@ XS(XS_File__Copy_syscopy) #include "patchlevel.h" char * -mod2fname(sv) - SV *sv; +mod2fname(pTHX_ SV *sv) { static char fname[9]; int pos = 6, len, avlen; @@ -1299,14 +1290,14 @@ mod2fname(sv) char *s; STRLEN n_a; - if (!SvROK(sv)) croak("Not a reference given to mod2fname"); + if (!SvROK(sv)) Perl_croak_nocontext("Not a reference given to mod2fname"); sv = SvRV(sv); if (SvTYPE(sv) != SVt_PVAV) - croak("Not array reference given to mod2fname"); + Perl_croak_nocontext("Not array reference given to mod2fname"); avlen = av_len((AV*)sv); if (avlen < 0) - croak("Empty array reference given to mod2fname"); + Perl_croak_nocontext("Empty array reference given to mod2fname"); s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); strncpy(fname, s, 8); @@ -1338,12 +1329,12 @@ XS(XS_DynaLoader_mod2fname) { dXSARGS; if (items != 1) - croak("Usage: DynaLoader::mod2fname(sv)"); + Perl_croak_nocontext("Usage: DynaLoader::mod2fname(sv)"); { SV * sv = ST(0); char * RETVAL; - RETVAL = mod2fname(sv); + RETVAL = mod2fname(aTHX_ sv); ST(0) = sv_newmortal(); sv_setpv((SV*)ST(0), RETVAL); } @@ -1374,8 +1365,9 @@ os2error(int rc) } char * -os2_execname(void) +os2_execname(pTHX) { + dTHR; char buf[300], *p; if (_execname(buf, sizeof buf) != 0) @@ -1412,7 +1404,7 @@ perllib_mangle(char *s, unsigned int l) } newl = strlen(newp); if (newl == 0 || oldl == 0) { - croak("Malformed PERLLIB_PREFIX"); + Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); } strcpy(ret, newp); s = ret; @@ -1434,7 +1426,7 @@ perllib_mangle(char *s, unsigned int l) return s; } if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) { - croak("Malformed PERLLIB_PREFIX"); + Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); } strcpy(ret + newl, s + oldl); return ret; @@ -1467,7 +1459,7 @@ Perl_Register_MQ(int serve) static int cnt; if (cnt++) _exit(188); /* Panic can try to create a window. */ - croak("Cannot create a message queue, or morph to a PM application"); + Perl_croak_nocontext("Cannot create a message queue, or morph to a PM application"); } return Perl_hmq; } @@ -1481,11 +1473,11 @@ Perl_Serve_Messages(int force) if (Perl_hmq_servers && !force) return 0; if (!Perl_hmq_refcnt) - croak("No message queue"); + Perl_croak_nocontext("No message queue"); while ((*PMWIN_entries.PeekMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0, PM_REMOVE)) { cnt++; if (msg.msg == WM_QUIT) - croak("QUITing..."); + Perl_croak_nocontext("QUITing..."); (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); } return cnt; @@ -1499,7 +1491,7 @@ Perl_Process_Messages(int force, I32 *cntp) if (Perl_hmq_servers && !force) return 0; if (!Perl_hmq_refcnt) - croak("No message queue"); + Perl_croak_nocontext("No message queue"); while ((*PMWIN_entries.GetMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0)) { if (cntp) (*cntp)++; @@ -1509,7 +1501,7 @@ Perl_Process_Messages(int force, I32 *cntp) if (msg.msg == WM_CREATE) return +1; } - croak("QUITing..."); + Perl_croak_nocontext("QUITing..."); } void @@ -1525,7 +1517,7 @@ Perl_Deregister_MQ(int serve) if (pib->pib_ultype == 3) /* 3 is PM */ pib->pib_ultype = Perl_os2_initial_mode; else - warn("Unexpected program mode %d when morphing back from PM", + Perl_warn_nocontext("Unexpected program mode %d when morphing back from PM", pib->pib_ultype); } } @@ -1549,7 +1541,7 @@ XS(XS_OS2_Error) { dXSARGS; if (items != 2) - croak("Usage: OS2::Error(harderr, exception)"); + Perl_croak_nocontext("Usage: OS2::Error(harderr, exception)"); { int arg1 = SvIV(ST(0)); int arg2 = SvIV(ST(1)); @@ -1559,7 +1551,7 @@ XS(XS_OS2_Error) unsigned long rc; if (CheckOSError(DosError(a))) - croak("DosError(%d) failed", a); + Perl_croak_nocontext("DosError(%d) failed", a); ST(0) = sv_newmortal(); if (DOS_harderr_state >= 0) sv_setiv(ST(0), DOS_harderr_state); @@ -1574,7 +1566,7 @@ XS(XS_OS2_Errors2Drive) { dXSARGS; if (items != 1) - croak("Usage: OS2::Errors2Drive(drive)"); + Perl_croak_nocontext("Usage: OS2::Errors2Drive(drive)"); { STRLEN n_a; SV *sv = ST(0); @@ -1584,12 +1576,12 @@ XS(XS_OS2_Errors2Drive) unsigned long rc; if (suppress && !isALPHA(drive)) - croak("Non-char argument '%c' to OS2::Errors2Drive()", drive); + Perl_croak_nocontext("Non-char argument '%c' to OS2::Errors2Drive()", drive); if (CheckOSError(DosSuppressPopUps((suppress ? SPU_ENABLESUPPRESSION : SPU_DISABLESUPPRESSION), drive))) - croak("DosSuppressPopUps(%c) failed", drive); + Perl_croak_nocontext("DosSuppressPopUps(%c) failed", drive); ST(0) = sv_newmortal(); if (DOS_suppression_state > 0) sv_setpvn(ST(0), &DOS_suppression_state, 1); @@ -1632,7 +1624,7 @@ XS(XS_OS2_SysInfo) { dXSARGS; if (items != 0) - croak("Usage: OS2::SysInfo()"); + Perl_croak_nocontext("Usage: OS2::SysInfo()"); { ULONG si[QSV_MAX] = {0}; /* System Information Data Buffer */ APIRET rc = NO_ERROR; /* Return code */ @@ -1642,7 +1634,7 @@ XS(XS_OS2_SysInfo) QSV_MAX, /* information */ (PVOID)si, sizeof(si)))) - croak("DosQuerySysInfo() failed"); + Perl_croak_nocontext("DosQuerySysInfo() failed"); EXTEND(SP,2*QSV_MAX); while (i < QSV_MAX) { ST(j) = sv_newmortal(); @@ -1659,7 +1651,7 @@ XS(XS_OS2_BootDrive) { dXSARGS; if (items != 0) - croak("Usage: OS2::BootDrive()"); + Perl_croak_nocontext("Usage: OS2::BootDrive()"); { ULONG si[1] = {0}; /* System Information Data Buffer */ APIRET rc = NO_ERROR; /* Return code */ @@ -1667,7 +1659,7 @@ XS(XS_OS2_BootDrive) if (CheckOSError(DosQuerySysInfo(QSV_BOOT_DRIVE, QSV_BOOT_DRIVE, (PVOID)si, sizeof(si)))) - croak("DosQuerySysInfo() failed"); + Perl_croak_nocontext("DosQuerySysInfo() failed"); ST(0) = sv_newmortal(); c = 'a' - 1 + si[0]; sv_setpvn(ST(0), &c, 1); @@ -1679,7 +1671,7 @@ XS(XS_OS2_MorphPM) { dXSARGS; if (items != 1) - croak("Usage: OS2::MorphPM(serve)"); + Perl_croak_nocontext("Usage: OS2::MorphPM(serve)"); { bool serve = SvOK(ST(0)); unsigned long pmq = perl_hmq_GET(serve); @@ -1694,7 +1686,7 @@ XS(XS_OS2_UnMorphPM) { dXSARGS; if (items != 1) - croak("Usage: OS2::UnMorphPM(serve)"); + Perl_croak_nocontext("Usage: OS2::UnMorphPM(serve)"); { bool serve = SvOK(ST(0)); @@ -1707,7 +1699,7 @@ XS(XS_OS2_Serve_Messages) { dXSARGS; if (items != 1) - croak("Usage: OS2::Serve_Messages(force)"); + Perl_croak_nocontext("Usage: OS2::Serve_Messages(force)"); { bool force = SvOK(ST(0)); unsigned long cnt = Perl_Serve_Messages(force); @@ -1722,7 +1714,7 @@ XS(XS_OS2_Process_Messages) { dXSARGS; if (items < 1 || items > 2) - croak("Usage: OS2::Process_Messages(force [, cnt])"); + Perl_croak_nocontext("Usage: OS2::Process_Messages(force [, cnt])"); { bool force = SvOK(ST(0)); unsigned long cnt; @@ -1733,7 +1725,7 @@ XS(XS_OS2_Process_Messages) int fake = SvIV(sv); /* Force SvIVX */ if (!SvIOK(sv)) - croak("Can't upgrade count to IV"); + Perl_croak_nocontext("Can't upgrade count to IV"); cntp = &SvIVX(sv); } cnt = Perl_Process_Messages(force, cntp); @@ -1747,7 +1739,7 @@ XS(XS_Cwd_current_drive) { dXSARGS; if (items != 0) - croak("Usage: Cwd::current_drive()"); + Perl_croak_nocontext("Usage: Cwd::current_drive()"); { char RETVAL; @@ -1762,7 +1754,7 @@ XS(XS_Cwd_sys_chdir) { dXSARGS; if (items != 1) - croak("Usage: Cwd::sys_chdir(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_chdir(path)"); { STRLEN n_a; char * path = (char *)SvPV(ST(0),n_a); @@ -1779,7 +1771,7 @@ XS(XS_Cwd_change_drive) { dXSARGS; if (items != 1) - croak("Usage: Cwd::change_drive(d)"); + Perl_croak_nocontext("Usage: Cwd::change_drive(d)"); { STRLEN n_a; char d = (char)*SvPV(ST(0),n_a); @@ -1796,7 +1788,7 @@ XS(XS_Cwd_sys_is_absolute) { dXSARGS; if (items != 1) - croak("Usage: Cwd::sys_is_absolute(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_is_absolute(path)"); { STRLEN n_a; char * path = (char *)SvPV(ST(0),n_a); @@ -1813,7 +1805,7 @@ XS(XS_Cwd_sys_is_rooted) { dXSARGS; if (items != 1) - croak("Usage: Cwd::sys_is_rooted(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_is_rooted(path)"); { STRLEN n_a; char * path = (char *)SvPV(ST(0),n_a); @@ -1830,7 +1822,7 @@ XS(XS_Cwd_sys_is_relative) { dXSARGS; if (items != 1) - croak("Usage: Cwd::sys_is_relative(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_is_relative(path)"); { STRLEN n_a; char * path = (char *)SvPV(ST(0),n_a); @@ -1847,7 +1839,7 @@ XS(XS_Cwd_sys_cwd) { dXSARGS; if (items != 0) - croak("Usage: Cwd::sys_cwd()"); + Perl_croak_nocontext("Usage: Cwd::sys_cwd()"); { char p[MAXPATHLEN]; char * RETVAL; @@ -1862,7 +1854,7 @@ XS(XS_Cwd_sys_abspath) { dXSARGS; if (items < 1 || items > 2) - croak("Usage: Cwd::sys_abspath(path, dir = NULL)"); + Perl_croak_nocontext("Usage: Cwd::sys_abspath(path, dir = NULL)"); { STRLEN n_a; char * path = (char *)SvPV(ST(0),n_a); @@ -1987,7 +1979,7 @@ XS(XS_Cwd_extLibpath) { dXSARGS; if (items < 0 || items > 1) - croak("Usage: Cwd::extLibpath(type = 0)"); + Perl_croak_nocontext("Usage: Cwd::extLibpath(type = 0)"); { bool type; char to[1024]; @@ -2011,7 +2003,7 @@ XS(XS_Cwd_extLibpath_set) { dXSARGS; if (items < 1 || items > 2) - croak("Usage: Cwd::extLibpath_set(s, type = 0)"); + Perl_croak_nocontext("Usage: Cwd::extLibpath_set(s, type = 0)"); { STRLEN n_a; char * s = (char *)SvPV(ST(0),n_a); @@ -2033,7 +2025,7 @@ XS(XS_Cwd_extLibpath_set) } int -Xs_OS2_init() +Xs_OS2_init(pTHX) { char *file = __FILE__; { diff --git a/os2/os2ish.h b/os2/os2ish.h index 76d1b8c4f3..23857ac532 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -82,6 +82,9 @@ #ifdef USE_THREADS +#define do_spawn(a) os2_do_spawn(aTHX_ (a)) +#define do_aspawn(a,b,c) os2_do_aspawn(aTHX_ (a),(b),(c)) + #define OS2_ERROR_ALREADY_POSTED 299 /* Avoid os2.h */ extern int rc; @@ -90,49 +93,49 @@ extern int rc; STMT_START { \ int rc; \ if ((rc = _rmutex_create(m,0))) \ - croak("panic: MUTEX_INIT: rc=%i", rc); \ + Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc); \ } STMT_END #define MUTEX_LOCK(m) \ STMT_START { \ int rc; \ if ((rc = _rmutex_request(m,_FMR_IGNINT))) \ - croak("panic: MUTEX_LOCK: rc=%i", rc); \ + Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \ } STMT_END #define MUTEX_UNLOCK(m) \ STMT_START { \ int rc; \ if ((rc = _rmutex_release(m))) \ - croak("panic: MUTEX_UNLOCK: rc=%i", rc); \ + Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \ } STMT_END #define MUTEX_DESTROY(m) \ STMT_START { \ int rc; \ if ((rc = _rmutex_close(m))) \ - croak("panic: MUTEX_DESTROY: rc=%i", rc); \ + Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc); \ } STMT_END #define COND_INIT(c) \ STMT_START { \ int rc; \ if ((rc = DosCreateEventSem(NULL,c,0,0))) \ - croak("panic: COND_INIT: rc=%i", rc); \ + Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc); \ } STMT_END #define COND_SIGNAL(c) \ STMT_START { \ int rc; \ - if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED) \ - croak("panic: COND_SIGNAL, rc=%ld", rc); \ + if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\ + Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc); \ } STMT_END #define COND_BROADCAST(c) \ STMT_START { \ int rc; \ if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\ - croak("panic: COND_BROADCAST, rc=%i", rc); \ + Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \ } STMT_END /* #define COND_WAIT(c, m) \ STMT_START { \ if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \ - croak("panic: COND_WAIT"); \ + Perl_croak_nocontext("panic: COND_WAIT"); \ } STMT_END */ #define COND_WAIT(c, m) os2_cond_wait(c,m) @@ -140,8 +143,8 @@ extern int rc; #define COND_WAIT_win32(c, m) \ STMT_START { \ int rc; \ - if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE)))\ - croak("panic: COND_WAIT"); \ + if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \ + Perl_croak_nocontext("panic: COND_WAIT"); \ else \ MUTEX_LOCK(m); \ } STMT_END @@ -149,7 +152,7 @@ extern int rc; STMT_START { \ int rc; \ if ((rc = DosCloseEventSem(*(c)))) \ - croak("panic: COND_DESTROY, rc=%i", rc); \ + Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \ } STMT_END /*#define THR ((struct thread *) TlsGetValue(PL_thr_key)) #define dTHR struct thread *thr = THR @@ -159,11 +162,15 @@ extern int rc; # define pthread_getspecific(k) (*_threadstore()) # define pthread_setspecific(k,v) (*_threadstore()=v,0) # define pthread_key_create(keyp,flag) (*keyp=_gettid(),0) -#else +#else /* USE_SLOW_THREAD_SPECIFIC */ # define pthread_getspecific(k) (*(k)) # define pthread_setspecific(k,v) (*(k)=(v),0) -# define pthread_key_create(keyp,flag) (DosAllocThreadLocalMemory(1,(U32*)keyp) ? croak("LocalMemory"),1 : 0) -#endif +# define pthread_key_create(keyp,flag) \ + ( DosAllocThreadLocalMemory(1,(U32*)keyp) \ + ? Perl_croak_nocontext("LocalMemory"),1 \ + : 0 \ + ) +#endif /* USE_SLOW_THREAD_SPECIFIC */ #define pthread_key_delete(keyp) #define pthread_self() _gettid() #define YIELD DosSleep(0) @@ -173,11 +180,16 @@ int pthread_join(pthread_t tid, void **status); int pthread_detach(pthread_t tid); int pthread_create(pthread_t *tid, const pthread_attr_t *attr, void *(*start_routine)(void*), void *arg); -#endif +#endif /* PTHREAD_INCLUDED */ #define THREADS_ELSEWHERE -#endif +#else /* USE_THREADS */ + +#define do_spawn(a) os2_do_spawn(a) +#define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c)) + +#endif /* USE_THREADS */ void Perl_OS2_init(char **); @@ -231,9 +243,21 @@ void *sys_alloc(int size); # define PerlIO FILE #endif +/* os2ish is used from a2p/a2p.h without pTHX/pTHX_ first being + * defined. Hack around this to get us to compile. +*/ +#ifdef PTHX_UNUSED +# ifndef pTHX +# define pTHX +# endif +# ifndef pTHX_ +# define pTHX_ +# endif +#endif + #define TMPPATH1 "plXXXXXX" extern char *tmppath; -PerlIO *my_syspopen(char *cmd, char *mode); +PerlIO *my_syspopen(pTHX_ char *cmd, char *mode); /* Cannot prototype with I32 at this point. */ int my_syspclose(PerlIO *f); FILE *my_tmpfile (void); @@ -352,7 +376,7 @@ void Perl_Deregister_MQ(int serve); int Perl_Serve_Messages(int force); /* Cannot prototype with I32 at this point. */ int Perl_Process_Messages(int force, long *cntp); -char *os2_execname(void); +char *os2_execname(pTHX); struct _QMSG; struct PMWIN_entries_t { @@ -373,7 +397,7 @@ void init_PMWIN_entries(void); #define perl_hmq_GET(serve) Perl_Register_MQ(serve) #define perl_hmq_UNSET(serve) Perl_Deregister_MQ(serve) -#define OS2_XS_init() (*OS2_Perl_data.xs_init)() +#define OS2_XS_init() (*OS2_Perl_data.xs_init)(aTHX) #if _EMX_CRT_REV_ >= 60 # define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2_set, \ @@ -180,6 +180,8 @@ perl_construct(pTHXx) # endif /* EMULATE_ATOMIC_REFCOUNTS */ MUTEX_INIT(&PL_cred_mutex); + MUTEX_INIT(&PL_sv_lock_mutex); + MUTEX_INIT(&PL_fdpid_mutex); thr = init_main_thread(); #endif /* USE_THREADS */ @@ -600,9 +602,14 @@ perl_destruct(pTHXx) if (!specialWARN(PL_compiling.cop_warnings)) SvREFCNT_dec(PL_compiling.cop_warnings); PL_compiling.cop_warnings = Nullsv; -#ifndef USE_ITHREADS +#ifdef USE_ITHREADS + Safefree(CopFILE(&PL_compiling)); + CopFILE(&PL_compiling) = Nullch; + Safefree(CopSTASHPV(&PL_compiling)); +#else SvREFCNT_dec(CopFILEGV(&PL_compiling)); - CopFILEGV_set(&PL_compiling, Nullgv); + CopFILEGV(&PL_compiling) = Nullgv; + /* cop_stash is not refcounted */ #endif /* Prepare to destruct main symbol table. */ @@ -652,6 +659,10 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_fdpid); /* needed in io_close() */ PL_fdpid = Nullav; +#ifdef HAVE_INTERP_INTERN + sys_intern_clear(); +#endif + /* Destruct the global string table. */ { /* Yell and reset the HeVAL() slots that are still holding refcounts, @@ -701,9 +712,6 @@ perl_destruct(pTHXx) if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count); - sv_free_arenas(); - - /* No SVs have survived, need to clean out */ Safefree(PL_origfilename); Safefree(PL_reg_start_tmp); if (PL_reg_curpm) @@ -711,6 +719,8 @@ perl_destruct(pTHXx) Safefree(PL_reg_poscache); Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh)); Safefree(PL_op_mask); + Safefree(PL_psig_ptr); + Safefree(PL_psig_name); nuke_stacks(); PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */ @@ -720,6 +730,7 @@ perl_destruct(pTHXx) MUTEX_DESTROY(&PL_sv_mutex); MUTEX_DESTROY(&PL_eval_mutex); MUTEX_DESTROY(&PL_cred_mutex); + MUTEX_DESTROY(&PL_fdpid_mutex); COND_DESTROY(&PL_eval_cond); #ifdef EMULATE_ATOMIC_REFCOUNTS MUTEX_DESTROY(&PL_svref_mutex); @@ -732,6 +743,8 @@ perl_destruct(pTHXx) PL_thrsv = Nullsv; #endif /* USE_THREADS */ + sv_free_arenas(); + /* As the absolutely last thing, free the non-arena SV for mess() */ if (PL_mess_sv) { @@ -969,6 +982,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) goto reswitch; case 'e': +#ifdef MACOS_TRADITIONAL + /* ignore -e for Dev:Pseudo argument */ + if (argv[1] && !strcmp(argv[1], "Dev:Pseudo")) + break; +#endif if (PL_euid != PL_uid || PL_egid != PL_gid) Perl_croak(aTHX_ "No -e allowed in setuid scripts"); if (!PL_e_script) { @@ -1175,6 +1193,7 @@ print \" \\@INC:\\n @INC\\n\";"); validate_suid(validarg, scriptname,fdscript); +#ifndef PERL_MICRO #if defined(SIGCHLD) || defined(SIGCLD) { #ifndef SIGCHLD @@ -1189,8 +1208,13 @@ print \" \\@INC:\\n @INC\\n\";"); } } #endif +#endif +#ifdef MACOS_TRADITIONAL + if (PL_doextract || gMacPerl_AlwaysExtract) { +#else if (PL_doextract) { +#endif find_beginning(); if (cddir && PerlDir_chdir(cddir) < 0) Perl_croak(aTHX_ "Can't chdir to %s",cddir); @@ -1230,9 +1254,11 @@ print \" \\@INC:\\n @INC\\n\";"); if (xsinit) (*xsinit)(aTHXo); /* in case linked C routines want magical variables */ +#ifndef PERL_MICRO #if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) init_os_extras(); #endif +#endif #ifdef USE_SOCKS SOCKSinit(argv[0]); @@ -1251,6 +1277,16 @@ print \" \\@INC:\\n @INC\\n\";"); SETERRNO(0,SS$_NORMAL); PL_error_count = 0; +#ifdef MACOS_TRADITIONAL + if (gMacPerl_SyntaxError = (yyparse() || PL_error_count)) { + if (PL_minus_c) + Perl_croak(aTHX_ "%s had compilation errors.\n", MacPerl_MPWFileName(PL_origfilename)); + else { + Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n", + MacPerl_MPWFileName(PL_origfilename)); + } + } +#else if (yyparse() || PL_error_count) { if (PL_minus_c) Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename); @@ -1259,6 +1295,7 @@ print \" \\@INC:\\n @INC\\n\";"); PL_origfilename); } } +#endif CopLINE_set(PL_curcop, 0); PL_curstash = PL_defstash; PL_preprocess = FALSE; @@ -1384,7 +1421,11 @@ S_run_body(pTHX_ I32 oldscope) PTR2UV(thr))); if (PL_minus_c) { +#ifdef MACOS_TRADITIONAL + PerlIO_printf(Perl_error_log, "%s syntax OK\n", MacPerl_MPWFileName(PL_origfilename)); +#else PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename); +#endif my_exit(0); } if (PERLDB_SINGLE && PL_DBsingle) @@ -1570,18 +1611,7 @@ Perl_call_method(pTHX_ const char *methname, I32 flags) /* name of the subroutine */ /* See G_* flags in cop.h */ { - dSP; - OP myop; - if (!PL_op) { - Zero(&myop, 1, OP); - PL_op = &myop; - } - XPUSHs(sv_2mortal(newSVpv(methname,0))); - PUTBACK; - pp_method(); - if (PL_op == &myop) - PL_op = Nullop; - return call_sv(*PL_stack_sp--, flags); + return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD); } /* May be called with any of a CV, a GV, or an SV containing the name. */ @@ -1596,11 +1626,11 @@ L<perlcall>. I32 Perl_call_sv(pTHX_ SV *sv, I32 flags) - /* See G_* flags in cop.h */ { dSP; LOGOP myop; /* fake syntax tree node */ + UNOP method_op; I32 oldmark; I32 retval; I32 oldscope; @@ -1638,6 +1668,14 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) && !(flags & G_NODEBUG)) PL_op->op_private |= OPpENTERSUB_DB; + if (flags & G_METHOD) { + Zero(&method_op, 1, UNOP); + method_op.op_next = PL_op; + method_op.op_ppaddr = PL_ppaddr[OP_METHOD]; + myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB]; + PL_op = (OP*)&method_op; + } + if (!(flags & G_EVAL)) { CATCH_SET(TRUE); call_body((OP*)&myop, FALSE); @@ -1645,7 +1683,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) CATCH_SET(oldcatch); } else { - cLOGOP->op_other = PL_op; + myop.op_other = (OP*)&myop; PL_markstack_ptr--; /* we're trying to emulate pp_entertry() here */ { @@ -1655,7 +1693,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) ENTER; SAVETMPS; - push_return(PL_op->op_next); + push_return(Nullop); PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp); PUSHEVAL(cx, 0, 0); PL_eval_root = PL_op; /* Only needed so that goto works right. */ @@ -1758,9 +1796,9 @@ S_call_body(pTHX_ OP *myop, int is_eval) if (PL_op == myop) { if (is_eval) - PL_op = Perl_pp_entereval(aTHX); + PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */ else - PL_op = Perl_pp_entersub(aTHX); + PL_op = Perl_pp_entersub(aTHX); /* this does */ } if (PL_op) CALLRUNOPS(aTHX); @@ -1882,7 +1920,6 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error) dSP; SV* sv = newSVpv(p, 0); - PUSHMARK(SP); eval_sv(sv, G_SCALAR); SvREFCNT_dec(sv); @@ -2179,6 +2216,9 @@ Perl_moreswitches(pTHX_ char *s) s++; return s; case 'u': +#ifdef MACOS_TRADITIONAL + Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh"); +#endif PL_do_undump = TRUE; s++; return s; @@ -2201,6 +2241,10 @@ Perl_moreswitches(pTHX_ char *s) PerlIO_printf(PerlIO_stdout(), "\n\nCopyright 1987-2000, Larry Wall\n"); +#ifdef MACOS_TRADITIONAL + PerlIO_printf(PerlIO_stdout(), + "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n"); +#endif #ifdef MSDOS PerlIO_printf(PerlIO_stdout(), "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); @@ -2487,6 +2531,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) } } +#ifdef USE_ITHREADS + Safefree(CopFILE(PL_curcop)); +#else + SvREFCNT_dec(CopFILEGV(PL_curcop)); +#endif CopFILE_set(PL_curcop, PL_origfilename); if (strEQ(PL_origfilename,"-")) scriptname = ""; @@ -2984,9 +3033,30 @@ S_find_beginning(pTHX) /* skip forward in input to the real script? */ forbid_setid("-x"); +#ifdef MACOS_TRADITIONAL + /* Since the Mac OS does not honor !# arguments for us, we do it ourselves */ + + while (PL_doextract || gMacPerl_AlwaysExtract) { + if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) { + if (!gMacPerl_AlwaysExtract) + Perl_croak(aTHX_ "No Perl script found in input\n"); + + if (PL_doextract) /* require explicit override ? */ + if (!OverrideExtract(PL_origfilename)) + Perl_croak(aTHX_ "User aborted script\n"); + else + PL_doextract = FALSE; + + /* Pater peccavi, file does not have #! */ + PerlIO_rewind(PL_rsfp); + + break; + } +#else while (PL_doextract) { if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) Perl_croak(aTHX_ "No Perl script found in input\n"); +#endif if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) { PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */ PL_doextract = FALSE; @@ -3168,8 +3238,9 @@ S_init_predump_symbols(pTHX) PL_statname = NEWSV(66,0); /* last filename we did stat on */ - if (!PL_osname) - PL_osname = savepv(OSNAME); + if (PL_osname) + Safefree(PL_osname); + PL_osname = savepv(OSNAME); } STATIC void @@ -3207,12 +3278,17 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register TAINT; if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) { +#ifdef MACOS_TRADITIONAL + /* $0 is not majick on a Mac */ + sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename)); +#else sv_setpv(GvSV(tmpgv),PL_origfilename); magicname("0", "0", 1); +#endif } if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) #ifdef OS2 - sv_setpv(GvSV(tmpgv), os2_execname()); + sv_setpv(GvSV(tmpgv), os2_execname(aTHX)); #else sv_setpv(GvSV(tmpgv),PL_origargv[0]); #endif @@ -3232,7 +3308,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); hv_magic(hv, PL_envgv, 'E'); -#if !defined( VMS) && !defined(EPOC) /* VMS doesn't have environ array */ +#if !defined( VMS) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) /* VMS doesn't have environ array */ /* Note that if the supplied env parameter is actually a copy of the global environ then it may now point to free'd memory if the environment has been modified since. To avoid this @@ -3302,6 +3378,27 @@ S_init_perllib(pTHX) #ifdef ARCHLIB_EXP incpush(ARCHLIB_EXP, FALSE, FALSE); #endif +#ifdef MACOS_TRADITIONAL + { + struct stat tmpstatbuf; + SV * privdir = NEWSV(55, 0); + char * macperl = PerlEnv_getenv("MACPERL"); + + if (!macperl) + macperl = ""; + + Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl); + if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) + incpush(SvPVX(privdir), TRUE, FALSE); + Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl); + if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) + incpush(SvPVX(privdir), TRUE, FALSE); + + SvREFCNT_dec(privdir); + } + if (!PL_tainting) + incpush(":", FALSE, FALSE); +#else #ifndef PRIVLIB_EXP # define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" #endif @@ -3357,6 +3454,7 @@ S_init_perllib(pTHX) if (!PL_tainting) incpush(".", FALSE, FALSE); +#endif /* MACOS_TRADITIONAL */ } #if defined(DOSISH) @@ -3365,7 +3463,11 @@ S_init_perllib(pTHX) # if defined(VMS) # define PERLLIB_SEP '|' # else -# define PERLLIB_SEP ':' +# if defined(MACOS_TRADITIONAL) +# define PERLLIB_SEP ',' +# else +# define PERLLIB_SEP ':' +# endif # endif #endif #ifndef PERLLIB_MANGLE @@ -3405,6 +3507,12 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) sv_setpv(libdir, PERLLIB_MANGLE(p, 0)); p = Nullch; /* break out */ } +#ifdef MACOS_TRADITIONAL + if (!strchr(SvPVX(libdir), ':')) + sv_insert(libdir, 0, 0, ":", 1); + if (SvPVX(libdir)[SvCUR(libdir)-1] != ':') + sv_catpv(libdir, ":"); +#endif /* * BEFORE pushing libdir onto @INC we may first push version- and @@ -3432,8 +3540,15 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) SvPV(libdir,len)); #endif if (addsubdirs) { +#ifdef MACOS_TRADITIONAL +#define PERL_AV_SUFFIX_FMT "" +#define PERL_ARCH_FMT ":%s" +#else +#define PERL_AV_SUFFIX_FMT "/" +#define PERL_ARCH_FMT "/%s" +#endif /* .../version/archname if -d .../version/archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT PERL_ARCH_FMT, libdir, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION, ARCHNAME); @@ -3442,7 +3557,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) av_push(GvAVn(PL_incgv), newSVsv(subdir)); /* .../version if -d .../version */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir, + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT, libdir, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && @@ -3450,7 +3565,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) av_push(GvAVn(PL_incgv), newSVsv(subdir)); /* .../archname if -d .../archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME); + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, ARCHNAME); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), newSVsv(subdir)); @@ -3460,7 +3575,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) if (addoldvers) { for (incver = incverlist; *incver; incver++) { /* .../xxx if -d .../xxx */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver); + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, *incver); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), newSVsv(subdir)); @@ -21,7 +21,11 @@ #endif /* PERL_FOR_X2P */ #define VOIDUSED 1 -#include "config.h" +#ifdef PERL_MICRO +# include "uconfig.h" +#else +# include "config.h" +#endif #if defined(USE_ITHREADS) && defined(USE_5005THREADS) # include "error: USE_ITHREADS and USE_5005THREADS are incompatible" @@ -164,8 +168,8 @@ class CPerlObj; #define aTHXo_ this, #define PERL_OBJECT_THIS aTHXo #define PERL_OBJECT_THIS_ aTHXo_ -#define dTHXoa(a) pTHXo = a -#define dTHXo dTHXoa(PERL_GET_THX) +#define dTHXoa(a) pTHXo = (CPerlObj*)a +#define dTHXo pTHXo = PERL_GET_THX #define pTHXx void #define pTHXx_ @@ -180,15 +184,16 @@ struct perl_thread; # define pTHX register struct perl_thread *thr # define aTHX thr # define dTHR dNOOP +# define dTHXa(a) pTHX = (struct perl_thread*)a # else # ifndef MULTIPLICITY # define MULTIPLICITY # endif # define pTHX register PerlInterpreter *my_perl # define aTHX my_perl +# define dTHXa(a) pTHX = (PerlInterpreter*)a # endif -# define dTHXa(a) pTHX = a -# define dTHX dTHXa(PERL_GET_THX) +# define dTHX pTHX = PERL_GET_THX # define pTHX_ pTHX, # define aTHX_ aTHX, # define pTHX_1 2 @@ -460,6 +465,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #undef METHOD #endif +#ifdef PERL_MICRO +# define NO_LOCALE +#endif + #ifdef I_LOCALE # include <locale.h> #endif @@ -593,6 +602,7 @@ struct perl_mstats { # endif # endif #else +# undef memset # define memset(d,c,l) my_memset(d,c,l) #endif /* HAS_MEMSET */ @@ -812,6 +822,12 @@ struct perl_mstats { # endif #endif +#ifdef PERL_MICRO +# ifndef DIR +# define DIR void +# endif +#endif + #ifdef FPUTS_BOTCH /* work around botch in SunOS 4.0.1 and 4.0.2 */ # ifndef fputs @@ -1145,6 +1161,9 @@ typedef NVTYPE NV; # include <sunmath.h> # endif # define NV_DIG LDBL_DIG +# ifdef LDBL_MANT_DIG +# define NV_MANT_DIG LDBL_MANT_DIG +# endif # ifdef HAS_SQRTL # define Perl_cos cosl # define Perl_sin sinl @@ -1178,6 +1197,9 @@ typedef NVTYPE NV; # endif #else # define NV_DIG DBL_DIG +# ifdef DBL_MANT_DIG +# define NV_MANT_DIG DBL_MANT_DIG +# endif # define Perl_cos cos # define Perl_sin sin # define Perl_sqrt sqrt @@ -1379,25 +1401,10 @@ typedef NVTYPE NV; #ifdef UV_IS_QUAD -# ifdef UQUAD_MAX -# define PERL_UQUAD_MAX ((UV)UQUAD_MAX) -# else # define PERL_UQUAD_MAX (~(UV)0) -# endif - -# define PERL_UQUAD_MIN ((UV)0) - -# ifdef QUAD_MAX -# define PERL_QUAD_MAX ((IV)QUAD_MAX) -# else +# define PERL_UQUAD_MIN ((UV)0) # define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) -# endif - -# ifdef QUAD_MIN -# define PERL_QUAD_MIN ((IV)QUAD_MIN) -# else # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) -# endif #endif @@ -2788,10 +2795,14 @@ EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), 0, MEMBER_TO_FPTR(Perl_magic_clearenv), 0}; EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; +#ifdef PERL_MICRO +EXT MGVTBL PL_vtbl_sigelem = {0, 0, 0, 0, 0}; +#else EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig), MEMBER_TO_FPTR(Perl_magic_setsig), 0, MEMBER_TO_FPTR(Perl_magic_clearsig), 0}; +#endif EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack), 0}; EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), @@ -3313,6 +3324,10 @@ typedef struct am_table_short AMTS; #endif /* IAMSUID */ +#ifdef I_LIBUTIL +# include <libutil.h> /* setproctitle() in some FreeBSDs */ +#endif + /* and finally... */ #define PERL_PATCHLEVEL_H_IMPLICIT #include "patchlevel.h" @@ -41,6 +41,9 @@ START_EXTERN_C { return &(PL_##v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ { return &(PL_##v); } +#undef PERLVARIC +#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHXo) \ + { return (const t *)&(PL_##v); } #include "perlvars.h" #undef PERLVAR @@ -82,6 +85,13 @@ Perl_Gv_AMupdate(pTHXo_ HV* stash) return ((CPerlObj*)pPerl)->Perl_Gv_AMupdate(stash); } +#undef Perl_apply_attrs_string +void +Perl_apply_attrs_string(pTHXo_ char *stashpv, CV *cv, char *attrstr, STRLEN len) +{ + ((CPerlObj*)pPerl)->Perl_apply_attrs_string(stashpv, cv, attrstr, len); +} + #undef Perl_avhv_delete_ent SV* Perl_avhv_delete_ent(pTHXo_ AV *ar, SV* keysv, I32 flags, U32 hash) @@ -159,13 +169,6 @@ Perl_av_extend(pTHXo_ AV* ar, I32 key) ((CPerlObj*)pPerl)->Perl_av_extend(ar, key); } -#undef Perl_av_fake -AV* -Perl_av_fake(pTHXo_ I32 size, SV** svp) -{ - return ((CPerlObj*)pPerl)->Perl_av_fake(size, svp); -} - #undef Perl_av_fetch SV** Perl_av_fetch(pTHXo_ AV* ar, I32 key, I32 lval) @@ -208,13 +211,6 @@ Perl_av_push(pTHXo_ AV* ar, SV* val) ((CPerlObj*)pPerl)->Perl_av_push(ar, val); } -#undef Perl_av_reify -void -Perl_av_reify(pTHXo_ AV* ar) -{ - ((CPerlObj*)pPerl)->Perl_av_reify(ar); -} - #undef Perl_av_shift SV* Perl_av_shift(pTHXo_ AV* ar) @@ -1323,6 +1319,13 @@ Perl_is_utf8_char(pTHXo_ U8 *p) return ((CPerlObj*)pPerl)->Perl_is_utf8_char(p); } +#undef Perl_is_utf8_string +bool +Perl_is_utf8_string(pTHXo_ U8 *s, STRLEN len) +{ + return ((CPerlObj*)pPerl)->Perl_is_utf8_string(s, len); +} + #undef Perl_is_utf8_alnum bool Perl_is_utf8_alnum(pTHXo_ U8 *p) @@ -2458,6 +2461,13 @@ Perl_save_generic_svref(pTHXo_ SV** sptr) ((CPerlObj*)pPerl)->Perl_save_generic_svref(sptr); } +#undef Perl_save_generic_pvref +void +Perl_save_generic_pvref(pTHXo_ char** str) +{ + ((CPerlObj*)pPerl)->Perl_save_generic_pvref(str); +} + #undef Perl_save_gp void Perl_save_gp(pTHXo_ GV* gv, I32 empty) @@ -3307,16 +3317,16 @@ Perl_unsharepvn(pTHXo_ const char* sv, I32 len, U32 hash) #undef Perl_utf16_to_utf8 U8* -Perl_utf16_to_utf8(pTHXo_ U16* p, U8 *d, I32 bytelen) +Perl_utf16_to_utf8(pTHXo_ U8* p, U8 *d, I32 bytelen, I32 *newlen) { - return ((CPerlObj*)pPerl)->Perl_utf16_to_utf8(p, d, bytelen); + return ((CPerlObj*)pPerl)->Perl_utf16_to_utf8(p, d, bytelen, newlen); } #undef Perl_utf16_to_utf8_reversed U8* -Perl_utf16_to_utf8_reversed(pTHXo_ U16* p, U8 *d, I32 bytelen) +Perl_utf16_to_utf8_reversed(pTHXo_ U8* p, U8 *d, I32 bytelen, I32 *newlen) { - return ((CPerlObj*)pPerl)->Perl_utf16_to_utf8_reversed(p, d, bytelen); + return ((CPerlObj*)pPerl)->Perl_utf16_to_utf8_reversed(p, d, bytelen, newlen); } #undef Perl_utf8_distance @@ -3333,6 +3343,20 @@ Perl_utf8_hop(pTHXo_ U8 *s, I32 off) return ((CPerlObj*)pPerl)->Perl_utf8_hop(s, off); } +#undef Perl_utf8_to_bytes +U8* +Perl_utf8_to_bytes(pTHXo_ U8 *s, STRLEN len) +{ + return ((CPerlObj*)pPerl)->Perl_utf8_to_bytes(s, len); +} + +#undef Perl_bytes_to_utf8 +U8* +Perl_bytes_to_utf8(pTHXo_ U8 *s, STRLEN *len) +{ + return ((CPerlObj*)pPerl)->Perl_bytes_to_utf8(s, len); +} + #undef Perl_utf8_to_uv UV Perl_utf8_to_uv(pTHXo_ U8 *s, I32* retlen) @@ -3495,6 +3519,15 @@ Perl_runops_debug(pTHXo) { return ((CPerlObj*)pPerl)->Perl_runops_debug(); } +#if defined(USE_THREADS) + +#undef Perl_sv_lock +SV* +Perl_sv_lock(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_lock(sv); +} +#endif #undef Perl_sv_catpvf_mg void @@ -3945,6 +3978,13 @@ Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl) #endif #if defined(HAVE_INTERP_INTERN) +#undef Perl_sys_intern_clear +void +Perl_sys_intern_clear(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_sys_intern_clear(); +} + #undef Perl_sys_intern_init void Perl_sys_intern_init(pTHXo) @@ -230,6 +230,8 @@ START_EXTERN_C #define PL_expect (*Perl_Iexpect_ptr(aTHXo)) #undef PL_fdpid #define PL_fdpid (*Perl_Ifdpid_ptr(aTHXo)) +#undef PL_fdpid_mutex +#define PL_fdpid_mutex (*Perl_Ifdpid_mutex_ptr(aTHXo)) #undef PL_filemode #define PL_filemode (*Perl_Ifilemode_ptr(aTHXo)) #undef PL_forkprocess @@ -246,6 +248,8 @@ START_EXTERN_C #define PL_glob_index (*Perl_Iglob_index_ptr(aTHXo)) #undef PL_globalstash #define PL_globalstash (*Perl_Iglobalstash_ptr(aTHXo)) +#undef PL_he_arenaroot +#define PL_he_arenaroot (*Perl_Ihe_arenaroot_ptr(aTHXo)) #undef PL_he_root #define PL_he_root (*Perl_Ihe_root_ptr(aTHXo)) #undef PL_hintgv @@ -492,6 +496,8 @@ START_EXTERN_C #define PL_sv_arenaroot (*Perl_Isv_arenaroot_ptr(aTHXo)) #undef PL_sv_count #define PL_sv_count (*Perl_Isv_count_ptr(aTHXo)) +#undef PL_sv_lock_mutex +#define PL_sv_lock_mutex (*Perl_Isv_lock_mutex_ptr(aTHXo)) #undef PL_sv_mutex #define PL_sv_mutex (*Perl_Isv_mutex_ptr(aTHXo)) #undef PL_sv_no @@ -568,26 +574,48 @@ START_EXTERN_C #define PL_xiv_arenaroot (*Perl_Ixiv_arenaroot_ptr(aTHXo)) #undef PL_xiv_root #define PL_xiv_root (*Perl_Ixiv_root_ptr(aTHXo)) +#undef PL_xnv_arenaroot +#define PL_xnv_arenaroot (*Perl_Ixnv_arenaroot_ptr(aTHXo)) #undef PL_xnv_root #define PL_xnv_root (*Perl_Ixnv_root_ptr(aTHXo)) +#undef PL_xpv_arenaroot +#define PL_xpv_arenaroot (*Perl_Ixpv_arenaroot_ptr(aTHXo)) #undef PL_xpv_root #define PL_xpv_root (*Perl_Ixpv_root_ptr(aTHXo)) +#undef PL_xpvav_arenaroot +#define PL_xpvav_arenaroot (*Perl_Ixpvav_arenaroot_ptr(aTHXo)) #undef PL_xpvav_root #define PL_xpvav_root (*Perl_Ixpvav_root_ptr(aTHXo)) +#undef PL_xpvbm_arenaroot +#define PL_xpvbm_arenaroot (*Perl_Ixpvbm_arenaroot_ptr(aTHXo)) #undef PL_xpvbm_root #define PL_xpvbm_root (*Perl_Ixpvbm_root_ptr(aTHXo)) +#undef PL_xpvcv_arenaroot +#define PL_xpvcv_arenaroot (*Perl_Ixpvcv_arenaroot_ptr(aTHXo)) #undef PL_xpvcv_root #define PL_xpvcv_root (*Perl_Ixpvcv_root_ptr(aTHXo)) +#undef PL_xpvhv_arenaroot +#define PL_xpvhv_arenaroot (*Perl_Ixpvhv_arenaroot_ptr(aTHXo)) #undef PL_xpvhv_root #define PL_xpvhv_root (*Perl_Ixpvhv_root_ptr(aTHXo)) +#undef PL_xpviv_arenaroot +#define PL_xpviv_arenaroot (*Perl_Ixpviv_arenaroot_ptr(aTHXo)) #undef PL_xpviv_root #define PL_xpviv_root (*Perl_Ixpviv_root_ptr(aTHXo)) +#undef PL_xpvlv_arenaroot +#define PL_xpvlv_arenaroot (*Perl_Ixpvlv_arenaroot_ptr(aTHXo)) #undef PL_xpvlv_root #define PL_xpvlv_root (*Perl_Ixpvlv_root_ptr(aTHXo)) +#undef PL_xpvmg_arenaroot +#define PL_xpvmg_arenaroot (*Perl_Ixpvmg_arenaroot_ptr(aTHXo)) #undef PL_xpvmg_root #define PL_xpvmg_root (*Perl_Ixpvmg_root_ptr(aTHXo)) +#undef PL_xpvnv_arenaroot +#define PL_xpvnv_arenaroot (*Perl_Ixpvnv_arenaroot_ptr(aTHXo)) #undef PL_xpvnv_root #define PL_xpvnv_root (*Perl_Ixpvnv_root_ptr(aTHXo)) +#undef PL_xrv_arenaroot +#define PL_xrv_arenaroot (*Perl_Ixrv_arenaroot_ptr(aTHXo)) #undef PL_xrv_root #define PL_xrv_root (*Perl_Ixrv_root_ptr(aTHXo)) #undef PL_yychar @@ -9,7 +9,11 @@ #define VOIDUSED 1 -#include "config.h" +#ifdef PERL_MICRO +# include "uconfig.h" +#else +# include "config.h" +#endif #define PERLIO_NOT_STDIO 0 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO) diff --git a/perlsfio.h b/perlsfio.h index c4ed5c7650..00568d1d59 100644 --- a/perlsfio.h +++ b/perlsfio.h @@ -49,7 +49,7 @@ extern int _stdprintf _ARG_((const char*, ...)); #define PerlIO_get_cnt(f) ((f)->endr - (f)->next) #define PerlIO_canset_cnt(f) 1 #define PerlIO_fast_gets(f) 1 -#define PerlIO_set_ptrcnt(f,p,c) ((f)->next = (p)) +#define PerlIO_set_ptrcnt(f,p,c) ((f)->next = (unsigned char *)(p)) #define PerlIO_set_cnt(f,c) 1 #define PerlIO_has_base(f) 1 @@ -1386,6 +1386,9 @@ yyparse() #endif struct ysv *ysave; +#ifdef USE_ITHREADS + ENTER; /* force yydestruct() before we return */ +#endif New(73, ysave, 1, struct ysv); SAVEDESTRUCTOR_X(yydestruct, ysave); ysave->oldyydebug = yydebug; @@ -2477,6 +2480,9 @@ yyoverflow: yyabort: retval = 1; yyaccept: +#ifdef USE_ITHREADS + LEAVE; /* force yydestruct() before we return */ +#endif return retval; } diff --git a/perly_c.diff b/perly_c.diff index 0b73880c4e..0cfe10f8d7 100644 --- a/perly_c.diff +++ b/perly_c.diff @@ -12,7 +12,7 @@ if (yys = getenv("YYDEBUG")) { yyn = *yys; ---- 1447,1473 ---- +--- 1447,1476 ---- yyparse() { register int yym, yyn, yystate; @@ -27,6 +27,9 @@ ! #endif + struct ysv *ysave; ++ #ifdef USE_ITHREADS ++ ENTER; /* force yydestruct() before we return */ ++ #endif + New(73, ysave, 1, struct ysv); + SAVEDESTRUCTOR_X(yydestruct, ysave); + ysave->oldyydebug = yydebug; @@ -42,7 +45,7 @@ yyn = *yys; *************** *** 1463,1468 **** ---- 1480,1495 ---- +--- 1483,1498 ---- yyerrflag = 0; yychar = (-1); @@ -68,7 +71,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1520,1538 ---- +--- 1523,1541 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -97,7 +100,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1573,1591 ---- +--- 1576,1594 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -134,7 +137,7 @@ yyaccept: ! return (0); } ---- 2524,2569 ---- +--- 2527,2575 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -160,6 +163,9 @@ yyabort: ! retval = 1; yyaccept: +! #ifdef USE_ITHREADS +! LEAVE; /* force yydestruct() before we return */ +! #endif ! return retval; ! } ! diff --git a/pod/Makefile b/pod/Makefile deleted file mode 100644 index bd2e148c42..0000000000 --- a/pod/Makefile +++ /dev/null @@ -1,364 +0,0 @@ -CONVERTERS = pod2html pod2latex pod2man pod2text checkpods \ - pod2usage podchecker podselect - -HTMLROOT = / # Change this to fix cross-references in HTML -POD2HTML = pod2html \ - --htmlroot=$(HTMLROOT) \ - --podroot=.. --podpath=pod:lib:ext:vms \ - --libpods=perlfunc:perlguts:perlvar:perlrun:perlop - -all: $(CONVERTERS) man - -converters: $(CONVERTERS) - -PERL = ../miniperl -REALPERL = ../perl - -POD = \ - perl.pod \ - perldelta.pod \ - perl5004delta.pod \ - perl5005delta.pod \ - perldata.pod \ - perlsyn.pod \ - perlop.pod \ - perlre.pod \ - perlrun.pod \ - perlfunc.pod \ - perlopentut.pod \ - perlvar.pod \ - perlsub.pod \ - perlmod.pod \ - perlmodlib.pod \ - perlmodinstall.pod \ - perlfork.pod \ - perlform.pod \ - perllocale.pod \ - perlref.pod \ - perlreftut.pod \ - perldsc.pod \ - perllol.pod \ - perlboot.pod \ - perltoot.pod \ - perltootc.pod \ - perlobj.pod \ - perltie.pod \ - perlbot.pod \ - perlipc.pod \ - perlthrtut.pod \ - perldbmfilter.pod \ - perldebguts.pod \ - perldebug.pod \ - perlnumber.pod \ - perldiag.pod \ - perlsec.pod \ - perltrap.pod \ - perlport.pod \ - perlstyle.pod \ - perlpod.pod \ - perlbook.pod \ - perlembed.pod \ - perlapio.pod \ - perlxs.pod \ - perlxstut.pod \ - perlguts.pod \ - perlcall.pod \ - perlcompile.pod \ - perltodo.pod \ - perlapi.pod \ - perlintern.pod \ - perlhack.pod \ - perlhist.pod \ - perlfaq.pod \ - perlfaq1.pod \ - perlfaq2.pod \ - perlfaq3.pod \ - perlfaq4.pod \ - perlfaq5.pod \ - perlfaq6.pod \ - perlfaq7.pod \ - perlfaq8.pod \ - perlfaq9.pod \ - perltoc.pod - -MAN = \ - perl.man \ - perldelta.man \ - perl5004delta.man \ - perl5005delta.man \ - perldata.man \ - perlsyn.man \ - perlop.man \ - perlre.man \ - perlrun.man \ - perlfunc.man \ - perlopentut.man \ - perlvar.man \ - perlsub.man \ - perlmod.man \ - perlmodlib.man \ - perlmodinstall.man \ - perlfork.man \ - perlform.man \ - perllocale.man \ - perlref.man \ - perlreftut.man \ - perldsc.man \ - perllol.man \ - perlboot.man \ - perltoot.man \ - perltootc.man \ - perlobj.man \ - perltie.man \ - perlbot.man \ - perlipc.man \ - perlthrtut.man \ - perldbmfilter.man \ - perldebguts.man \ - perldebug.man \ - perlnumber.man \ - perldiag.man \ - perlsec.man \ - perltrap.man \ - perlport.man \ - perlstyle.man \ - perlpod.man \ - perlbook.man \ - perlembed.man \ - perlapio.man \ - perlxs.man \ - perlxstut.man \ - perlguts.man \ - perlcall.man \ - perlcompile.man \ - perltodo.man \ - perlapi.man \ - perlintern.man \ - perlhack.man \ - perlhist.man \ - perlfaq.man \ - perlfaq1.man \ - perlfaq2.man \ - perlfaq3.man \ - perlfaq4.man \ - perlfaq5.man \ - perlfaq6.man \ - perlfaq7.man \ - perlfaq8.man \ - perlfaq9.man \ - perltoc.man - -HTML = \ - perl.html \ - perldelta.html \ - perl5004delta.html \ - perl5005delta.html \ - perldata.html \ - perlsyn.html \ - perlop.html \ - perlre.html \ - perlrun.html \ - perlfunc.html \ - perlopentut.html \ - perlvar.html \ - perlsub.html \ - perlmod.html \ - perlmodlib.html \ - perlmodinstall.html \ - perlfork.html \ - perlform.html \ - perllocale.html \ - perlref.html \ - perlreftut.html \ - perldsc.html \ - perllol.html \ - perlboot.html \ - perltoot.html \ - perltootc.html \ - perlobj.html \ - perltie.html \ - perlbot.html \ - perlipc.html \ - perlthrtut.html \ - perldbmfilter.html \ - perldebguts.html \ - perldebug.html \ - perlnumber.html \ - perldiag.html \ - perlsec.html \ - perltrap.html \ - perlport.html \ - perlstyle.html \ - perlpod.html \ - perlbook.html \ - perlembed.html \ - perlapio.html \ - perlxs.html \ - perlxstut.html \ - perlguts.html \ - perlcall.html \ - perlcompile.html \ - perltodo.html \ - perlapi.html \ - perlintern.html \ - perlhack.html \ - perlhist.html \ - perlfaq.html \ - perlfaq1.html \ - perlfaq2.html \ - perlfaq3.html \ - perlfaq4.html \ - perlfaq5.html \ - perlfaq6.html \ - perlfaq7.html \ - perlfaq8.html \ - perlfaq9.html -# not perltoc.html - -TEX = \ - perl.tex \ - perldelta.tex \ - perl5004delta.tex \ - perl5005delta.tex \ - perldata.tex \ - perlsyn.tex \ - perlop.tex \ - perlre.tex \ - perlrun.tex \ - perlfunc.tex \ - perlopentut.tex \ - perlvar.tex \ - perlsub.tex \ - perlmod.tex \ - perlmodlib.tex \ - perlmodinstall.tex \ - perlfork.tex \ - perlform.tex \ - perllocale.tex \ - perlref.tex \ - perlreftut.tex \ - perldsc.tex \ - perllol.tex \ - perlboot.tex \ - perltoot.tex \ - perltootc.tex \ - perlobj.tex \ - perltie.tex \ - perlbot.tex \ - perlipc.tex \ - perlthrtut.tex \ - perldbmfilter.tex \ - perldebguts.tex \ - perldebug.tex \ - perlnumber.tex \ - perldiag.tex \ - perlsec.tex \ - perltrap.tex \ - perlport.tex \ - perlstyle.tex \ - perlpod.tex \ - perlbook.tex \ - perlembed.tex \ - perlapio.tex \ - perlxs.tex \ - perlxstut.tex \ - perlguts.tex \ - perlcall.tex \ - perlcompile.tex \ - perltodo.tex \ - perlapi.tex \ - perlintern.tex \ - perlhack.tex \ - perlhist.tex \ - perlfaq.tex \ - perlfaq1.tex \ - perlfaq2.tex \ - perlfaq3.tex \ - perlfaq4.tex \ - perlfaq5.tex \ - perlfaq6.tex \ - perlfaq7.tex \ - perlfaq8.tex \ - perlfaq9.tex \ - perltoc.tex - -man: pod2man $(MAN) - -html: pod2html $(HTML) - -tex: pod2latex $(TEX) - -toc: - $(PERL) -I../lib buildtoc >perltoc.pod - -.SUFFIXES: .pm .pod - -.SUFFIXES: .man - -.pm.man: pod2man - $(PERL) -I../lib pod2man $*.pm >$*.man - -.pod.man: pod2man - $(PERL) -I../lib pod2man $*.pod >$*.man - -.SUFFIXES: .html - -.pm.html: pod2html - $(PERL) -I../lib $(POD2HTML) --infile=$*.pm --outfile=$*.html - -.pod.html: pod2html - $(PERL) -I../lib $(POD2HTML) --infile=$*.pod --outfile=$*.html - -.SUFFIXES: .tex - -.pm.tex: pod2latex - $(PERL) -I../lib pod2latex $*.pm - -.pod.tex: pod2latex - $(PERL) -I../lib pod2latex $*.pod - -clean: - rm -f $(MAN) - rm -f $(HTML) - rm -f $(TEX) - rm -f pod2html-*cache - rm -f *.aux *.log *.exe - -realclean: clean - rm -f $(CONVERTERS) - -distclean: realclean - -check: checkpods - @echo "checking..."; \ - $(PERL) -I../lib checkpods $(POD) - -# Dependencies. -pod2latex: pod2latex.PL ../lib/Config.pm - $(PERL) -I../lib pod2latex.PL - -pod2html: pod2html.PL ../lib/Config.pm - $(PERL) -I ../lib pod2html.PL - -pod2man: pod2man.PL ../lib/Config.pm - $(PERL) -I ../lib pod2man.PL - -pod2text: pod2text.PL ../lib/Config.pm - $(PERL) -I ../lib pod2text.PL - -checkpods: checkpods.PL ../lib/Config.pm - $(PERL) -I ../lib checkpods.PL - -pod2usage: pod2usage.PL ../lib/Config.pm - $(PERL) -I ../lib pod2usage.PL - -podchecker: podchecker.PL ../lib/Config.pm - $(PERL) -I ../lib podchecker.PL - -podselect: podselect.PL ../lib/Config.pm - $(PERL) -I ../lib podselect.PL - -compile: all - $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog; - - diff --git a/pod/Makefile.SH b/pod/Makefile.SH new file mode 100644 index 0000000000..45f18567fb --- /dev/null +++ b/pod/Makefile.SH @@ -0,0 +1,162 @@ +case $CONFIG in +'') + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh."; exit 1 + fi + . $TOP/config.sh + ;; +esac +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -d pod; then + cd pod || exit 1 +fi +POD=`echo *.pod` +MAN=`echo $POD|sed 's/\.pod/\.man/g'` +HTML=`echo $POD|sed 's/perltoc.pod//'|sed 's/\.pod/\.man/g'` +TEX=`echo $POD|sed 's/\.pod/\.tex/g'` + +echo "Extracting pod/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. + +$spitshell >Makefile <<!GROK!THIS! +# pod/Makefile +# This file is derived from pod/Makefile.SH. Any changes made here will +# be lost the next time you run Configure. + +POD = $POD + +MAN = $MAN + +# no perltoc.html +HTML = $HTML + +TEX = $TEX + +# The following is used to include the current directory in +# the dynamic loader path you are building a shared libperl. +LDLIBPTH = $ldlibpth + +!GROK!THIS! + +## In the following dollars and backticks do not need the extra backslash. +$spitshell >>Makefile <<'!NO!SUBS!' + +CONVERTERS = pod2html pod2latex pod2man pod2text checkpods \ + pod2usage podchecker podselect + +HTMLROOT = / # Change this to fix cross-references in HTML +POD2HTML = pod2html \ + --htmlroot=$(HTMLROOT) \ + --podroot=.. --podpath=pod:lib:ext:vms \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop + +PERL = ../miniperl +REALPERL = ../perl + +all: $(CONVERTERS) man + +converters: $(CONVERTERS) + +regen_pods: perlmodlib.pod toc + +buildtoc: buildtoc.PL perl.pod ../MANIFEST + $(PERL) -I ../lib buildtoc.PL + +man: pod2man $(MAN) + +html: pod2html $(HTML) + +tex: pod2latex $(TEX) + +toc: buildtoc + $(PERL) -I../lib buildtoc + +.SUFFIXES: .pm .pod + +.SUFFIXES: .man + +.pm.man: pod2man + $(PERL) -I../lib pod2man $*.pm >$*.man + +.pod.man: pod2man + $(PERL) -I../lib pod2man $*.pod >$*.man + +.SUFFIXES: .html + +.pm.html: pod2html + $(PERL) -I../lib $(POD2HTML) --infile=$*.pm --outfile=$*.html + +.pod.html: pod2html + $(PERL) -I../lib $(POD2HTML) --infile=$*.pod --outfile=$*.html + +.SUFFIXES: .tex + +.pm.tex: pod2latex + $(PERL) -I../lib pod2latex $*.pm + +.pod.tex: pod2latex + $(PERL) -I../lib pod2latex $*.pod + +clean: + rm -f $(MAN) + rm -f $(HTML) + rm -f $(TEX) + rm -f pod2html-*cache + rm -f *.aux *.log *.exe + +realclean: clean + rm -f $(CONVERTERS) + +distclean: realclean + +check: checkpods + @echo "checking..."; \ + $(PERL) -I../lib checkpods $(POD) + +# Dependencies. +pod2latex: pod2latex.PL ../lib/Config.pm + $(LDLIBPTH) $(PERL) -I../lib pod2latex.PL + +pod2html: pod2html.PL ../lib/Config.pm + $(LDLIBPTH) $(PERL) -I ../lib pod2html.PL + +pod2man: pod2man.PL ../lib/Config.pm + $(LDLIBPTH) $(PERL) -I ../lib pod2man.PL + +pod2text: pod2text.PL ../lib/Config.pm + $(LDLIBPTH) $(PERL) -I ../lib pod2text.PL + +checkpods: checkpods.PL ../lib/Config.pm + $(LDLIBPTH) $(PERL) -I ../lib checkpods.PL + +pod2usage: pod2usage.PL ../lib/Config.pm + $(PERL) -I ../lib pod2usage.PL + +podchecker: podchecker.PL ../lib/Config.pm + $(PERL) -I ../lib podchecker.PL + +podselect: podselect.PL ../lib/Config.pm + $(PERL) -I ../lib podselect.PL + +perlmodlib.pod: $(PERL) perlmodlib.PL ../mv-if-diff + rm -f perlmodlib.tmp + $(PERL) -I ../lib perlmodlib.PL + sh ../mv-if-diff perlmodlib.tmp perlmodlib.pod + +compile: all + $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog; + +!NO!SUBS! diff --git a/pod/buildtoc b/pod/buildtoc deleted file mode 100644 index 58bfc54fd7..0000000000 --- a/pod/buildtoc +++ /dev/null @@ -1,259 +0,0 @@ -use File::Find; -use Cwd; -use Text::Wrap; - -sub output ($); - -@pods = qw( - perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 - perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata - perlsyn perlop perlre perlrun perlfunc perlvar perlsub - perlmod perlmodlib perlmodinstall perlfork perlform perllocale - perlref perlreftut perldsc - perllol perlboot perltoot perltootc perlobj perltie perlbot perlipc - perldbmfilter perldebug perlnumber perldebguts - perldiag perlsec perltrap perlport perlstyle perlpod perlbook - perlembed perlapio perlxs perlxstut perlguts perlcall perlcompile - perlapi perlintern perlhist - ); - -for (@pods) { s/$/.pod/ } - -$/ = ''; -@ARGV = @pods; - -($_= <<EOPOD2B) =~ s/^\t//gm && output($_); - - =head1 NAME - - perltoc - perl documentation table of contents - - =head1 DESCRIPTION - - This page provides a brief table of contents for the rest of the Perl - documentation set. It is meant to be scanned quickly or grepped - through to locate the proper section you're looking for. - - =head1 BASIC DOCUMENTATION - -EOPOD2B -#' make emacs happy - -podset(@pods); - -find \&getpods => qw(../lib ../ext); - -sub getpods { - if (/\.p(od|m)$/) { - # Skip .pm files that have corresponding .pod files, and Functions.pm. - return if /(.*)\.pm$/ && -f "$1.pod"; - my $file = $File::Find::name; - return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself - - die "tut $name" if $file =~ /TUT/; - unless (open (F, "< $_\0")) { - warn "bogus <$file>: $!"; - system "ls", "-l", $file; - } - else { - my $line; - while ($line = <F>) { - if ($line =~ /^=head1\s+NAME\b/) { - push @modpods, $file; - #warn "GOOD $file\n"; - return; - } - } - warn "EVIL $file\n"; - } - } -} - -die "no pods" unless @modpods; - -for (@modpods) { - #($name) = /(\w+)\.p(m|od)$/; - $name = path2modname($_); - if ($name =~ /^[a-z]/) { - push @pragmata, $_; - } else { - if ($done{$name}++) { - # warn "already did $_\n"; - next; - } - push @modules, $_; - push @modname, $name; - } -} - -($_= <<EOPOD2B) =~ s/^\t//gm && output($_); - - - - =head1 PRAGMA DOCUMENTATION - -EOPOD2B - -podset(sort @pragmata); - -($_= <<EOPOD2B) =~ s/^\t//gm && output($_); - - - - =head1 MODULE DOCUMENTATION - -EOPOD2B - -podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] ); - -($_= <<EOPOD2B) =~ s/^\t//gm; - - - =head1 AUXILIARY DOCUMENTATION - - Here should be listed all the extra programs' documentation, but they - don't all have manual pages yet: - - =over - - =item a2p - - =item s2p - - =item find2perl - - =item h2ph - - =item c2ph - - =item h2xs - - =item xsubpp - - =item pod2man - - =item wrapsuid - - =back - - =head1 AUTHOR - - Larry Wall <F<larry\@wall.org>>, with the help of oodles - of other folks. - - -EOPOD2B -output $_; -output "\n"; # flush $LINE -exit; - -sub podset { - local @ARGV = @_; - - while(<>) { - if (s/^=head1 (NAME)\s*/=head2 /) { - $pod = path2modname($ARGV); - unhead1(); - output "\n \n\n=head2 "; - $_ = <>; - if ( /^\s*$pod\b/ ) { - s/$pod\.pm/$pod/; # '.pm' in NAME !? - output $_; - } else { - s/^/$pod, /; - output $_; - } - next; - } - if (s/^=head1 (.*)/=item $1/) { - unhead2(); - output "=over\n\n" unless $inhead1; - $inhead1 = 1; - output $_; nl(); next; - } - if (s/^=head2 (.*)/=item $1/) { - unitem(); - output "=over\n\n" unless $inhead2; - $inhead2 = 1; - output $_; nl(); next; - } - if (s/^=item ([^=].*)/$1/) { - next if $pod eq 'perldiag'; - s/^\s*\*\s*$// && next; - s/^\s*\*\s*//; - s/\n/ /g; - s/\s+$//; - next if /^[\d.]+$/; - next if $pod eq 'perlmodlib' && /^ftp:/; - ##print "=over\n\n" unless $initem; - output ", " if $initem; - $initem = 1; - s/\.$//; - s/^-X\b/-I<X>/; - output $_; next; - } - if (s/^=cut\s*\n//) { - unhead1(); - next; - } - } -} - -sub path2modname { - local $_ = shift; - s/\.p(m|od)$//; - s-.*?/(lib|ext)/--; - s-/-::-g; - s/(\w+)::\1/$1/; - return $_; -} - -sub unhead1 { - unhead2(); - if ($inhead1) { - output "\n\n=back\n\n"; - } - $inhead1 = 0; -} - -sub unhead2 { - unitem(); - if ($inhead2) { - output "\n\n=back\n\n"; - } - $inhead2 = 0; -} - -sub unitem { - if ($initem) { - output "\n\n"; - ##print "\n\n=back\n\n"; - } - $initem = 0; -} - -sub nl { - output "\n"; -} - -my $NEWLINE; # how many newlines have we seen recently -my $LINE; # what remains to be printed - -sub output ($) { - for (split /(\n)/, shift) { - if ($_ eq "\n") { - if ($LINE) { - print wrap('', '', $LINE); - $LINE = ''; - } - if ($NEWLINE < 2) { - print; - $NEWLINE++; - } - } - elsif (/\S/ && length) { - $LINE .= $_; - $NEWLINE = 0; - } - } -} diff --git a/pod/buildtoc.PL b/pod/buildtoc.PL new file mode 100644 index 0000000000..54853d3065 --- /dev/null +++ b/pod/buildtoc.PL @@ -0,0 +1,470 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir(dirname($0)); +($file = basename($0)) =~ s/\.PL$//; +$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" +$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving" + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{'startperl'} + eval 'exec perl -S \$0 "\$@"' + if 0; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; + +# +# buildtoc +# +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is autogenerated by buildtoc.PL. +# Edit that file and run it to effect changes. +# +# Builds perltoc.pod and sanity checks the list of pods against all +# of the MANIFEST, perl.pod, and ourselves. +# + +use File::Find; +use Cwd; +use Text::Wrap; + +@PODS = glob("*.pod"); + +sub output ($); + +if (-d "pod") { + die "$0: failed to chdir('pod'): $!\n" unless chdir("pod"); +} + +@pods = qw( + perl + perlfaq + perltoc + perlbook + + perlsyn + perldata + perlop + perlsub + perlfunc + perlreftut + perldsc + perlrequick + perlpod + perlstyle + perltrap + + perlrun + perldiag + perllexwarn + perldebug + + perlvar + perllol + perlopentut + perlretut + + perlref + perlre + perlform + perllocale + perlunicode + + perlipc + perlfork + perlnumber + perlthrtut + + perlport + perlsec + + perlboot + perltoot + perltootc + perlobj + perlbot + perltie + + perlmod + perlmodlib + perlmodinstall + perlnewmod + + perlfaq1 + perlfaq2 + perlfaq3 + perlfaq4 + perlfaq5 + perlfaq6 + perlfaq7 + perlfaq8 + perlfaq9 + + perlcompile + + perlembed + perldebguts + perlxstut + perlxs + perlguts + perlcall + perlutil + perlfilter + perldbmfilter + perlapi + perlintern + perlapio + perltodo + perlhack + + perlhist + perldelta + perl56delta + perl5005delta + perl5004delta + + perlamiga + perlcygwin + perldos + perlhpux + perlmachten + perlos2 + perlos390 + perlposix-bc + perlvms + perlwin32 + ); + +@ARCHPODS = qw( + perlamiga + perlcygwin + perldos + perlhpux + perlmachten + perlos2 + perlos390 + perlposix-bc + perlvms + perlwin32 + ); +for (@ARCHPODS) { s/$/.pod/ } +@ARCHPODS{@ARCHPODS} = (); + +for (@pods) { s/$/.pod/ } +@pods{@pods} = (); +@PODS{@PODS} = (); + +open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!"; +while (<MANI>) { + if (m!^pod/([^.]+\.pod)\s+!i) { + push @MANIPODS, $1; + } +} +close(MANI); +@MANIPODS{@MANIPODS} = (); + +open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n"; +while (<PERLPOD>) { + if (/^For ease of access, /../^\(If you're intending /) { + if (/^\s+(perl\S*)\s+\w/) { + push @PERLPODS, "$1.pod"; + } + } +} +close(PERLPOD); +die "$0: could not find the pod listing of perl.pod\n" + unless @PERLPODS; +@PERLPODS{@PERLPODS} = (); + +# Cross-check against ourselves +# Cross-check against the MANIFEST +# Cross-check against the perl.pod + +foreach my $i (sort keys %PODS) { + warn "$0: $i exists but is unknown by buildtoc\n" + unless exists $pods{$i}; + warn "$0: $i exists but is unknown by ../MANIFEST\n" + if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i}; + warn "$0: $i exists but is unknown by perl.pod\n" + unless exists $PERLPODS{$i}; +} +foreach my $i (sort keys %pods) { + warn "$0: $i is known by buildtoc but does not exist\n" + unless exists $PODS{$i}; +} +foreach my $i (sort keys %MANIPODS) { + warn "$0: $i is known by ../MANIFEST but does not exist\n" + unless exists $PODS{$i}; +} +foreach my $i (sort keys %PERLPODS) { + warn "$0: $i is known by perl.pod but does not exist\n" + unless exists $PODS{$i}; +} + +# We are ready to rock. +open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!"; + +$/ = ''; +@ARGV = @pods; + +($_= <<EOPOD2B) =~ s/^\t//gm && output($_); + + =head1 NAME + + perltoc - perl documentation table of contents + + =head1 DESCRIPTION + + This page provides a brief table of contents for the rest of the Perl + documentation set. It is meant to be scanned quickly or grepped + through to locate the proper section you're looking for. + + =head1 BASIC DOCUMENTATION + +EOPOD2B +#' make emacs happy + +podset(@pods); + +find \&getpods => qw(../lib ../ext); + +sub getpods { + if (/\.p(od|m)$/) { + # Skip .pm files that have corresponding .pod files, and Functions.pm. + return if /(.*)\.pm$/ && -f "$1.pod"; + my $file = $File::Find::name; + return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself + + die "tut $name" if $file =~ /TUT/; + unless (open (F, "< $_\0")) { + warn "bogus <$file>: $!"; + system "ls", "-l", $file; + } + else { + my $line; + while ($line = <F>) { + if ($line =~ /^=head1\s+NAME\b/) { + push @modpods, $file; + #warn "GOOD $file\n"; + return; + } + } + warn "$0: $file: cannot find =head1 NAME\n"; + } + } +} + +die "no pods" unless @modpods; + +for (@modpods) { + #($name) = /(\w+)\.p(m|od)$/; + $name = path2modname($_); + if ($name =~ /^[a-z]/) { + push @pragmata, $_; + } else { + if ($done{$name}++) { + # warn "already did $_\n"; + next; + } + push @modules, $_; + push @modname, $name; + } +} + +($_= <<EOPOD2B) =~ s/^\t//gm && output($_); + + + + =head1 PRAGMA DOCUMENTATION + +EOPOD2B + +podset(sort @pragmata); + +($_= <<EOPOD2B) =~ s/^\t//gm && output($_); + + + + =head1 MODULE DOCUMENTATION + +EOPOD2B + +podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] ); + +($_= <<EOPOD2B) =~ s/^\t//gm; + + + =head1 AUXILIARY DOCUMENTATION + + Here should be listed all the extra programs' documentation, but they + don't all have manual pages yet: + + =over + + =item a2p + + =item s2p + + =item find2perl + + =item h2ph + + =item c2ph + + =item h2xs + + =item xsubpp + + =item pod2man + + =item wrapsuid + + =back + + =head1 AUTHOR + + Larry Wall <F<larry\@wall.org>>, with the help of oodles + of other folks. + + +EOPOD2B +output $_; +output "\n"; # flush $LINE +exit; + +sub podset { + local @ARGV = @_; + + while(<>) { + if (s/^=head1 (NAME)\s*/=head2 /) { + $pod = path2modname($ARGV); + unhead1(); + output "\n \n\n=head2 "; + $_ = <>; + if ( /^\s*$pod\b/ ) { + s/$pod\.pm/$pod/; # '.pm' in NAME !? + output $_; + } else { + s/^/$pod, /; + output $_; + } + next; + } + if (s/^=head1 (.*)/=item $1/) { + unhead2(); + output "=over\n\n" unless $inhead1; + $inhead1 = 1; + output $_; nl(); next; + } + if (s/^=head2 (.*)/=item $1/) { + unitem(); + output "=over\n\n" unless $inhead2; + $inhead2 = 1; + output $_; nl(); next; + } + if (s/^=item ([^=].*)/$1/) { + next if $pod eq 'perldiag'; + s/^\s*\*\s*$// && next; + s/^\s*\*\s*//; + s/\n/ /g; + s/\s+$//; + next if /^[\d.]+$/; + next if $pod eq 'perlmodlib' && /^ftp:/; + ##print "=over\n\n" unless $initem; + output ", " if $initem; + $initem = 1; + s/\.$//; + s/^-X\b/-I<X>/; + output $_; next; + } + if (s/^=cut\s*\n//) { + unhead1(); + next; + } + } +} + +sub path2modname { + local $_ = shift; + s/\.p(m|od)$//; + s-.*?/(lib|ext)/--; + s-/-::-g; + s/(\w+)::\1/$1/; + return $_; +} + +sub unhead1 { + unhead2(); + if ($inhead1) { + output "\n\n=back\n\n"; + } + $inhead1 = 0; +} + +sub unhead2 { + unitem(); + if ($inhead2) { + output "\n\n=back\n\n"; + } + $inhead2 = 0; +} + +sub unitem { + if ($initem) { + output "\n\n"; + ##print "\n\n=back\n\n"; + } + $initem = 0; +} + +sub nl { + output "\n"; +} + +my $NEWLINE; # how many newlines have we seen recently +my $LINE; # what remains to be printed + +sub output ($) { + for (split /(\n)/, shift) { + if ($_ eq "\n") { + if ($LINE) { + print OUT wrap('', '', $LINE); + $LINE = ''; + } + if ($NEWLINE < 2) { + print OUT; + $NEWLINE++; + } + } + elsif (/\S/ && length) { + $LINE .= $_; + $NEWLINE = 0; + } + } +} + +!NO!SUBS! + diff --git a/pod/perl.pod b/pod/perl.pod index 59ca0e0368..0273dbf9d0 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -12,74 +12,93 @@ B<perl> S<[ B<-sTuU> ]> S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]> S<[ B<-i>[I<extension>] ]> S<[ B<-e> I<'command'> ] [ B<--> ] [ I<programfile> ] [ I<argument> ]...> -For ease of access, the Perl manual has been split up into several -sections: +For ease of access, the Perl manual has been split up into several sections: perl Perl overview (this section) - perldelta Perl changes since previous version - perl5005delta Perl changes in version 5.005 - perl5004delta Perl changes in version 5.004 perlfaq Perl frequently asked questions perltoc Perl documentation table of contents + perlbook Perl book information - perldata Perl data structures perlsyn Perl syntax + perldata Perl data structures perlop Perl operators and precedence - perlre Perl regular expressions - perlrun Perl execution and options + perlsub Perl subroutines perlfunc Perl builtin functions - perlopentut Perl open() tutorial + perlreftut Perl references short introduction + perldsc Perl data structures intro + perlrequick Perl regular expressions quick start + perlpod Perl plain old documentation + perlstyle Perl style guide + perltrap Perl traps for the unwary + + perlrun Perl execution and options + perldiag Perl diagnostic messages + perllexwarn Perl warnings and their control + perldebug Perl debugging + perlvar Perl predefined variables - perlsub Perl subroutines - perlmod Perl modules: how they work - perlmodlib Perl modules: how to write and use - perlmodinstall Perl modules: how to install from CPAN + perllol Perl data structures: arrays of arrays + perlopentut Perl open() tutorial + perlretut Perl regular expressions tutorial + + perlref Perl references, the rest of the story + perlre Perl regular expressions, the rest of the story perlform Perl formats - perlunicode Perl unicode support perllocale Perl locale support + perlunicode Perl unicode support + + perlipc Perl interprocess communication + perlfork Perl fork() information + perlnumber Perl number semantics + perlthrtut Perl threads tutorial + + perlport Perl portability guide + perlsec Perl security - perlreftut Perl references short introduction - perlref Perl references, the rest of the story - perldsc Perl data structures intro - perllol Perl data structures: arrays of arrays perlboot Perl OO tutorial for beginners perltoot Perl OO tutorial, part 1 perltootc Perl OO tutorial, part 2 perlobj Perl objects - perltie Perl objects hidden behind simple variables perlbot Perl OO tricks and examples - perlipc Perl interprocess communication - perlfork Perl fork() information - perlthrtut Perl threads tutorial - perllexwarn Perl warnings and their control - perlfilter Perl source filters - perldbmfilter Perl DBM filters + perltie Perl objects hidden behind simple variables - perlcompile Perl compiler suite intro - perldebug Perl debugging - perldiag Perl diagnostic messages - perlnumber Perl number semantics - perlsec Perl security - perltrap Perl traps for the unwary - perlport Perl portability guide - perlstyle Perl style guide + perlmod Perl modules: how they work + perlmodlib Perl modules: how to write and use + perlmodinstall Perl modules: how to install from CPAN + perlnewmod Perl modules: preparing a new module for distribution + + perlfaq1 General Questions About Perl + perlfaq2 Obtaining and Learning about Perl + perlfaq3 Programming Tools + perlfaq4 Data Manipulation + perlfaq5 Files and Formats + perlfaq6 Regexes + perlfaq7 Perl Language Issues + perlfaq8 System Interaction + perlfaq9 Networking - perlpod Perl plain old documentation - perlbook Perl book information + perlcompile Perl compiler suite intro perlembed Perl ways to embed perl in your C or C++ application - perlapio Perl internal IO abstraction interface perldebguts Perl debugging guts and tips - perlxs Perl XS application programming interface perlxstut Perl XS tutorial + perlxs Perl XS application programming interface perlguts Perl internal functions for those doing extensions perlcall Perl calling conventions from C + perlutil utilities packaged with the Perl distribution + perlfilter Perl source filters + perldbmfilter Perl DBM filters perlapi Perl API listing (autogenerated) perlintern Perl internal functions (autogenerated) - + perlapio Perl internal IO abstraction interface perltodo Perl things to do perlhack Perl hackers guide + perlhist Perl history records + perldelta Perl changes since previous version + perl56delta Perl changes in version 5.6 + perl5005delta Perl changes in version 5.005 + perl5004delta Perl changes in version 5.004 perlamiga Perl notes for Amiga perlcygwin Perl notes for Cygwin @@ -88,6 +107,7 @@ sections: perlmachten Perl notes for Power MachTen perlos2 Perl notes for OS/2 perlos390 Perl notes for OS/390 + perlposix-bc Perl notes for POSIX-BC perlvms Perl notes for VMS perlwin32 Perl notes for Windows diff --git a/pod/perl56delta.pod b/pod/perl56delta.pod index 27cdc224ff..5a824ac8e5 100644 --- a/pod/perl56delta.pod +++ b/pod/perl56delta.pod @@ -10,7 +10,7 @@ This document describes differences between the 5.005 release and this one. =head2 Interpreter cloning, threads, and concurrency -Perl 5.005_63 introduces the beginnings of support for running multiple +Perl 5.6.0 introduces the beginnings of support for running multiple interpreters concurrently in different threads. In conjunction with the perl_clone() API call, which can be used to selectively duplicate the state of any given interpreter, it is possible to compile a @@ -375,7 +375,7 @@ problems associated with it. NOTE: This is currently an experimental feature. Interfaces and implementation are subject to change. -=item Support for CHECK blocks +=head2 Support for CHECK blocks In addition to C<BEGIN>, C<INIT>, C<END>, C<DESTROY> and C<AUTOLOAD>, subroutines named C<CHECK> are now special. These are queued up during @@ -388,7 +388,7 @@ be called directly. For example to match alphabetic characters use /[[:alpha:]]/. See L<perlre> for details. -=item Better pseudo-random number generator +=head2 Better pseudo-random number generator In 5.005_0x and earlier, perl's rand() function used the C library rand(3) function. As of 5.005_52, Configure tests for drand48(), @@ -409,7 +409,7 @@ Thus: now correctly prints "3|a", instead of "2|a". -=item Better worst-case behavior of hashes +=head2 Better worst-case behavior of hashes Small changes in the hashing algorithm have been implemented in order to improve the distribution of lower order bits in the @@ -632,7 +632,7 @@ Diagnostic output now goes to whichever file the C<STDERR> handle is pointing at, instead of always going to the underlying C runtime library's C<stderr>. -=item More consistent close-on-exec behavior +=head2 More consistent close-on-exec behavior On systems that support a close-on-exec flag on filehandles, the flag is now set for any handles created by pipe(), socketpair(), @@ -693,7 +693,7 @@ The variable modified by shmread(), and messages returned by msgrcv() because other untrusted processes can modify messages and shared memory segments for their own nefarious purposes. -=item More functional bareword prototype (*) +=head2 More functional bareword prototype (*) Bareword prototypes have been rationalized to enable them to be used to override builtins that accept barewords and interpret them in @@ -760,6 +760,38 @@ with another number. This behavior must be specifically enabled when running Configure. See F<INSTALL> and F<README.Y2K>. +=head2 Arrays now always interpolate into double-quoted strings + +In double-quoted strings, arrays now interpolate, no matter what. The +behavior in earlier versions of perl 5 was that arrays would interpolate +into strings if the array had been mentioned before the string was +compiled, and otherwise Perl would raise a fatal compile-time error. +In versions 5.000 through 5.003, the error was + + Literal @example now requires backslash + +In versions 5.004_01 through 5.6.0, the error was + + In string, @example now must be written as \@example + +The idea here was to get people into the habit of writing +C<"fred\@example.com"> when they wanted a literal C<@> sign, just as +they have always written C<"Give me back my \$5"> when they wanted a +literal C<$> sign. + +Starting with 5.6.1, when Perl now sees an C<@> sign in a +double-quoted string, it I<always> attempts to interpolate an array, +regardless of whether or not the array has been used or declared +already. The fatal error has been downgraded to an optional warning: + + Possible unintended interpolation of @example in string + +This warns you that C<"fred@example.com"> is going to turn into +C<fred.com> if you don't backslash the C<@>. + +See L<http://www.plover.com/~mjd/perl/at-error.html> for more details +about the history here. + =head1 Modules and Pragmata =head2 Modules @@ -1409,7 +1441,7 @@ eliminating redundant copying overheads. Minor changes in how subroutine calls are handled internally provide marginal improvements in performance. -=item delete(), each(), values() and hash iteration are faster +=head2 delete(), each(), values() and hash iteration are faster The hash values returned by delete(), each(), values() and hashes in a list context are the actual values in the hash, instead of copies. @@ -2298,6 +2330,20 @@ when you meant Remember that "my", "our", and "local" bind tighter than comma. +=item Possible unintended interpolation of %s in string + +(W ambiguous) It used to be that Perl would try to guess whether you +wanted an array interpolated or a literal @. It no longer does this; +arrays are now I<always> interpolated into strings. This means that +if you try something like: + + print "fred@example.com"; + +and the array C<@example> doesn't exist, Perl is going to print +C<fred.com>, which is probably not what you wanted. To get a literal +C<@> sign in a string, put a backslash before it, just as you would +to get a literal C<$> sign. + =item Possible Y2K bug: %s (W y2k) You are concatenating the number 19 with another number, which @@ -2522,7 +2568,7 @@ There is a potential incompatibility in the behavior of list slices that are comprised entirely of undefined values. See L</"Behavior of list slices is more consistent">. -=head2 Format of $English::PERL_VERSION is different +=item Format of $English::PERL_VERSION is different The English module now sets $PERL_VERSION to $^V (a string value) rather than C<$]> (a numeric value). This is a potential incompatibility. @@ -2647,7 +2693,7 @@ a simple scalar or as a reference to a typeglob. See L</"More functional bareword prototype (*)">. -=head2 Semantics of bit operators may have changed on 64-bit platforms +=item Semantics of bit operators may have changed on 64-bit platforms If your platform is either natively 64-bit or if Perl has been configured to used 64-bit integers, i.e., $Config{ivsize} is 8, @@ -2661,7 +2707,7 @@ the excess bits in the result of unary C<~>, e.g., C<~$x & 0xffffffff>. See L</"Bit operators support full native integer width">. -=head2 More builtins taint their results +=item More builtins taint their results As described in L</"Improved security features">, there may be more sources of taint in a Perl program. @@ -2891,6 +2937,18 @@ appear in %ENV. This may be a benign occurrence, as some software packages might directly modify logical name tables and introduce nonstandard names, or it may indicate that a logical name table has been corrupted. +=item In string, @%s now must be written as \@%s + +The description of this error used to say: + + (Someday it will simply assume that an unbackslashed @ + interpolates an array.) + +That day has come, and this fatal error has been removed. It has been +replaced by a non-fatal warning instead. +See L</Arrays now always interpolate into double-quoted strings> for +details. + =item Probable precedence problem on %s (W) The compiler found a bareword where it expected a conditional, diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 58e29515c4..e0b7c2b4f7 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -25,6 +25,9 @@ Same as C<av_len()>. Deprecated, use C<av_len()> instead. int AvFILL(AV* av) +=for hackers +Found in file av.h + =item av_clear Clears an array, making it empty. Does not free the memory used by the @@ -32,6 +35,31 @@ array itself. void av_clear(AV* ar) +=for hackers +Found in file av.c + +=item av_delete + +Deletes the element indexed by C<key> from the array. Returns the +deleted element. C<flags> is currently ignored. + + SV* av_delete(AV* ar, I32 key, I32 flags) + +=for hackers +Found in file av.c + +=item av_exists + +Returns true if the element indexed by C<key> has been initialized. + +This relies on the fact that uninitialized array elements are set to +C<&PL_sv_undef>. + + bool av_exists(AV* ar, I32 key) + +=for hackers +Found in file av.c + =item av_extend Pre-extend an array. The C<key> is the index to which the array should be @@ -39,6 +67,9 @@ extended. void av_extend(AV* ar, I32 key) +=for hackers +Found in file av.c + =item av_fetch Returns the SV at the specified index in the array. The C<key> is the @@ -50,6 +81,19 @@ more information on how to use this function on tied arrays. SV** av_fetch(AV* ar, I32 key, I32 lval) +=for hackers +Found in file av.c + +=item av_fill + +Ensure than an array has a given number of elements, equivalent to +Perl's C<$#array = $fill;>. + + void av_fill(AV* ar, I32 fill) + +=for hackers +Found in file av.c + =item av_len Returns the highest index in the array. Returns -1 if the array is @@ -57,6 +101,9 @@ empty. I32 av_len(AV* ar) +=for hackers +Found in file av.c + =item av_make Creates a new AV and populates it with a list of SVs. The SVs are copied @@ -65,6 +112,9 @@ will have a reference count of 1. AV* av_make(I32 size, SV** svp) +=for hackers +Found in file av.c + =item av_pop Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array @@ -72,6 +122,9 @@ is empty. SV* av_pop(AV* ar) +=for hackers +Found in file av.c + =item av_push Pushes an SV onto the end of the array. The array will grow automatically @@ -79,12 +132,18 @@ to accommodate the addition. void av_push(AV* ar, SV* val) +=for hackers +Found in file av.c + =item av_shift Shifts an SV off the beginning of the array. SV* av_shift(AV* ar) +=for hackers +Found in file av.c + =item av_store Stores an SV in an array. The array index is specified as C<key>. The @@ -100,12 +159,18 @@ more information on how to use this function on tied arrays. SV** av_store(AV* ar, I32 key, SV* val) +=for hackers +Found in file av.c + =item av_undef Undefines the array. Frees the memory used by the array itself. void av_undef(AV* ar) +=for hackers +Found in file av.c + =item av_unshift Unshift the given number of C<undef> values onto the beginning of the @@ -114,6 +179,20 @@ must then use C<av_store> to assign values to these new elements. void av_unshift(AV* ar, I32 num) +=for hackers +Found in file av.c + +=item bytes_to_utf8 + +Converts a string C<s> of length C<len> from ASCII into UTF8 encoding. +Returns a pointer to the newly-created string, and sets C<len> to +reflect the new length. + + U8 * bytes_to_utf8(U8 *s, STRLEN *len) + +=for hackers +Found in file utf8.c + =item call_argv Performs a callback to the specified Perl sub. See L<perlcall>. @@ -122,6 +201,9 @@ NOTE: the perl_ form of this function is deprecated. I32 call_argv(const char* sub_name, I32 flags, char** argv) +=for hackers +Found in file perl.c + =item call_method Performs a callback to the specified Perl method. The blessed object must @@ -131,6 +213,9 @@ NOTE: the perl_ form of this function is deprecated. I32 call_method(const char* methname, I32 flags) +=for hackers +Found in file perl.c + =item call_pv Performs a callback to the specified Perl sub. See L<perlcall>. @@ -139,6 +224,9 @@ NOTE: the perl_ form of this function is deprecated. I32 call_pv(const char* sub_name, I32 flags) +=for hackers +Found in file perl.c + =item call_sv Performs a callback to the Perl sub whose name is in the SV. See @@ -148,6 +236,9 @@ NOTE: the perl_ form of this function is deprecated. I32 call_sv(SV* sv, I32 flags) +=for hackers +Found in file perl.c + =item CLASS Variable which is setup by C<xsubpp> to indicate the @@ -155,6 +246,9 @@ class name for a C++ XS constructor. This is always a C<char*>. See C<THIS>. char* CLASS +=for hackers +Found in file XSUB.h + =item Copy The XSUB-writer's interface to the C C<memcpy> function. The C<src> is the @@ -163,20 +257,36 @@ the type. May fail on overlapping copies. See also C<Move>. void Copy(void* src, void* dest, int nitems, type) +=for hackers +Found in file handy.h + =item croak -This is the XSUB-writer's interface to Perl's C<die> function. Use this -function the same way you use the C C<printf> function. See -C<warn>. +This is the XSUB-writer's interface to Perl's C<die> function. +Normally use this function the same way you use the C C<printf> +function. See C<warn>. + +If you want to throw an exception object, assign the object to +C<$@> and then pass C<Nullch> to croak(): + + errsv = get_sv("@", TRUE); + sv_setsv(errsv, exception_object); + croak(Nullch); void croak(const char* pat, ...) +=for hackers +Found in file util.c + =item CvSTASH Returns the stash of the CV. HV* CvSTASH(CV* cv) +=for hackers +Found in file cv.h + =item dMARK Declare a stack marker variable, C<mark>, for the XSUB. See C<MARK> and @@ -184,12 +294,18 @@ C<dORIGMARK>. dMARK; +=for hackers +Found in file pp.h + =item dORIGMARK Saves the original stack mark for the XSUB. See C<ORIGMARK>. dORIGMARK; +=for hackers +Found in file pp.h + =item dSP Declares a local copy of perl's stack pointer for the XSUB, available via @@ -197,6 +313,9 @@ the C<SP> macro. See C<SP>. dSP; +=for hackers +Found in file pp.h + =item dXSARGS Sets up stack and mark pointers for an XSUB, calling dSP and dMARK. This @@ -205,6 +324,9 @@ variable to indicate the number of items on the stack. dXSARGS; +=for hackers +Found in file XSUB.h + =item dXSI32 Sets up the C<ix> variable for an XSUB which has aliases. This is usually @@ -212,12 +334,18 @@ handled automatically by C<xsubpp>. dXSI32; +=for hackers +Found in file XSUB.h + =item ENTER Opening bracket on a callback. See C<LEAVE> and L<perlcall>. ENTER; +=for hackers +Found in file scope.h + =item eval_pv Tells Perl to C<eval> the given string and return an SV* result. @@ -226,6 +354,9 @@ NOTE: the perl_ form of this function is deprecated. SV* eval_pv(const char* p, I32 croak_on_error) +=for hackers +Found in file perl.c + =item eval_sv Tells Perl to C<eval> the string in the SV. @@ -234,6 +365,9 @@ NOTE: the perl_ form of this function is deprecated. I32 eval_sv(SV* sv, I32 flags) +=for hackers +Found in file perl.c + =item EXTEND Used to extend the argument stack for an XSUB's return values. Once @@ -242,6 +376,9 @@ onto the stack. void EXTEND(SP, int nitems) +=for hackers +Found in file pp.h + =item fbm_compile Analyses the string in order to make fast searches on it using fbm_instr() @@ -249,6 +386,9 @@ Analyses the string in order to make fast searches on it using fbm_instr() void fbm_compile(SV* sv, U32 flags) +=for hackers +Found in file util.c + =item fbm_instr Returns the location of the SV in the string delimited by C<str> and @@ -258,6 +398,9 @@ then. char* fbm_instr(unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags) +=for hackers +Found in file util.c + =item FREETMPS Closing bracket for temporaries on a callback. See C<SAVETMPS> and @@ -265,6 +408,9 @@ L<perlcall>. FREETMPS; +=for hackers +Found in file scope.h + =item get_av Returns the AV of the specified Perl array. If C<create> is set and the @@ -275,6 +421,9 @@ NOTE: the perl_ form of this function is deprecated. AV* get_av(const char* name, I32 create) +=for hackers +Found in file perl.c + =item get_cv Returns the CV of the specified Perl subroutine. If C<create> is set and @@ -286,6 +435,9 @@ NOTE: the perl_ form of this function is deprecated. CV* get_cv(const char* name, I32 create) +=for hackers +Found in file perl.c + =item get_hv Returns the HV of the specified Perl hash. If C<create> is set and the @@ -296,6 +448,9 @@ NOTE: the perl_ form of this function is deprecated. HV* get_hv(const char* name, I32 create) +=for hackers +Found in file perl.c + =item get_sv Returns the SV of the specified Perl scalar. If C<create> is set and the @@ -306,6 +461,9 @@ NOTE: the perl_ form of this function is deprecated. SV* get_sv(const char* name, I32 create) +=for hackers +Found in file perl.c + =item GIMME A backward-compatible version of C<GIMME_V> which can only return @@ -314,6 +472,9 @@ Deprecated. Use C<GIMME_V> instead. U32 GIMME +=for hackers +Found in file op.h + =item GIMME_V The XSUB-writer's equivalent to Perl's C<wantarray>. Returns C<G_VOID>, @@ -322,12 +483,18 @@ respectively. U32 GIMME_V +=for hackers +Found in file op.h + =item GvSV Return the SV from the GV. SV* GvSV(GV* gv) +=for hackers +Found in file gv.h + =item gv_fetchmeth Returns the glob with the given C<name> and a defined subroutine or @@ -347,12 +514,18 @@ obtained from the GV with the C<GvCV> macro. GV* gv_fetchmeth(HV* stash, const char* name, STRLEN len, I32 level) +=for hackers +Found in file gv.c + =item gv_fetchmethod See L<gv_fetchmethod_autoload>. GV* gv_fetchmethod(HV* stash, const char* name) +=for hackers +Found in file gv.c + =item gv_fetchmethod_autoload Returns the glob which contains the subroutine to call to invoke the method @@ -379,6 +552,9 @@ C<call_sv> apply equally to these functions. GV* gv_fetchmethod_autoload(HV* stash, const char* name, I32 autoload) +=for hackers +Found in file gv.c + =item gv_stashpv Returns a pointer to the stash for a specified package. C<name> should @@ -388,6 +564,9 @@ package does not exist then NULL is returned. HV* gv_stashpv(const char* name, I32 create) +=for hackers +Found in file gv.c + =item gv_stashsv Returns a pointer to the stash for a specified package, which must be a @@ -395,47 +574,74 @@ valid UTF-8 string. See C<gv_stashpv>. HV* gv_stashsv(SV* sv, I32 create) +=for hackers +Found in file gv.c + =item G_ARRAY Used to indicate array context. See C<GIMME_V>, C<GIMME> and L<perlcall>. +=for hackers +Found in file cop.h + =item G_DISCARD Indicates that arguments returned from a callback should be discarded. See L<perlcall>. +=for hackers +Found in file cop.h + =item G_EVAL Used to force a Perl C<eval> wrapper around a callback. See L<perlcall>. +=for hackers +Found in file cop.h + =item G_NOARGS Indicates that no arguments are being sent to a callback. See L<perlcall>. +=for hackers +Found in file cop.h + =item G_SCALAR Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and L<perlcall>. +=for hackers +Found in file cop.h + =item G_VOID Used to indicate void context. See C<GIMME_V> and L<perlcall>. +=for hackers +Found in file cop.h + =item HEf_SVKEY This flag, used in the length slot of hash entries and magic structures, specifies the structure contains a C<SV*> pointer where a C<char*> pointer is to be expected. (For information only--not to be used). +=for hackers +Found in file hv.h + =item HeHASH Returns the computed hash stored in the hash entry. U32 HeHASH(HE* he) +=for hackers +Found in file hv.h + =item HeKEY Returns the actual pointer stored in the key slot of the hash entry. The @@ -445,6 +651,9 @@ usually preferable for finding the value of a key. void* HeKEY(HE* he) +=for hackers +Found in file hv.h + =item HeKLEN If this is negative, and amounts to C<HEf_SVKEY>, it indicates the entry @@ -454,6 +663,9 @@ lengths. STRLEN HeKLEN(HE* he) +=for hackers +Found in file hv.h + =item HePV Returns the key slot of the hash entry as a C<char*> value, doing any @@ -468,6 +680,9 @@ described elsewhere in this document. char* HePV(HE* he, STRLEN len) +=for hackers +Found in file hv.h + =item HeSVKEY Returns the key as an C<SV*>, or C<Nullsv> if the hash entry does not @@ -475,6 +690,9 @@ contain an C<SV*> key. SV* HeSVKEY(HE* he) +=for hackers +Found in file hv.h + =item HeSVKEY_force Returns the key as an C<SV*>. Will create and return a temporary mortal @@ -482,6 +700,9 @@ C<SV*> if the hash entry contains only a C<char*> key. SV* HeSVKEY_force(HE* he) +=for hackers +Found in file hv.h + =item HeSVKEY_set Sets the key to a given C<SV*>, taking care to set the appropriate flags to @@ -490,24 +711,36 @@ C<SV*>. SV* HeSVKEY_set(HE* he, SV* sv) +=for hackers +Found in file hv.h + =item HeVAL Returns the value slot (type C<SV*>) stored in the hash entry. SV* HeVAL(HE* he) +=for hackers +Found in file hv.h + =item HvNAME Returns the package name of a stash. See C<SvSTASH>, C<CvSTASH>. char* HvNAME(HV* stash) +=for hackers +Found in file hv.h + =item hv_clear Clears a hash, making it empty. void hv_clear(HV* tb) +=for hackers +Found in file hv.c + =item hv_delete Deletes a key/value pair in the hash. The value SV is removed from the @@ -517,6 +750,9 @@ will be returned. SV* hv_delete(HV* tb, const char* key, U32 klen, I32 flags) +=for hackers +Found in file hv.c + =item hv_delete_ent Deletes a key/value pair in the hash. The value SV is removed from the @@ -526,6 +762,9 @@ precomputed hash value, or 0 to ask for it to be computed. SV* hv_delete_ent(HV* tb, SV* key, I32 flags, U32 hash) +=for hackers +Found in file hv.c + =item hv_exists Returns a boolean indicating whether the specified hash key exists. The @@ -533,6 +772,9 @@ C<klen> is the length of the key. bool hv_exists(HV* tb, const char* key, U32 klen) +=for hackers +Found in file hv.c + =item hv_exists_ent Returns a boolean indicating whether the specified hash key exists. C<hash> @@ -541,6 +783,9 @@ computed. bool hv_exists_ent(HV* tb, SV* key, U32 hash) +=for hackers +Found in file hv.c + =item hv_fetch Returns the SV which corresponds to the specified key in the hash. The @@ -553,6 +798,9 @@ information on how to use this function on tied hashes. SV** hv_fetch(HV* tb, const char* key, U32 klen, I32 lval) +=for hackers +Found in file hv.c + =item hv_fetch_ent Returns the hash entry which corresponds to the specified key in the hash. @@ -568,6 +816,9 @@ information on how to use this function on tied hashes. HE* hv_fetch_ent(HV* tb, SV* key, I32 lval, U32 hash) +=for hackers +Found in file hv.c + =item hv_iterinit Prepares a starting point to traverse a hash table. Returns the number of @@ -580,6 +831,9 @@ value, you can get it through the macro C<HvFILL(tb)>. I32 hv_iterinit(HV* tb) +=for hackers +Found in file hv.c + =item hv_iterkey Returns the key from the current position of the hash iterator. See @@ -587,6 +841,9 @@ C<hv_iterinit>. char* hv_iterkey(HE* entry, I32* retlen) +=for hackers +Found in file hv.c + =item hv_iterkeysv Returns the key as an C<SV*> from the current position of the hash @@ -595,12 +852,18 @@ see C<hv_iterinit>. SV* hv_iterkeysv(HE* entry) +=for hackers +Found in file hv.c + =item hv_iternext Returns entries from a hash iterator. See C<hv_iterinit>. HE* hv_iternext(HV* tb) +=for hackers +Found in file hv.c + =item hv_iternextsv Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one @@ -608,6 +871,9 @@ operation. SV* hv_iternextsv(HV* hv, char** key, I32* retlen) +=for hackers +Found in file hv.c + =item hv_iterval Returns the value from the current position of the hash iterator. See @@ -615,12 +881,18 @@ C<hv_iterkey>. SV* hv_iterval(HV* tb, HE* entry) +=for hackers +Found in file hv.c + =item hv_magic Adds magic to a hash. See C<sv_magic>. void hv_magic(HV* hv, GV* gv, int how) +=for hackers +Found in file hv.c + =item hv_store Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is @@ -637,6 +909,9 @@ information on how to use this function on tied hashes. SV** hv_store(HV* tb, const char* key, U32 klen, SV* val, U32 hash) +=for hackers +Found in file hv.c + =item hv_store_ent Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash> @@ -654,19 +929,28 @@ information on how to use this function on tied hashes. HE* hv_store_ent(HV* tb, SV* key, SV* val, U32 hash) +=for hackers +Found in file hv.c + =item hv_undef Undefines the hash. void hv_undef(HV* tb) +=for hackers +Found in file hv.c + =item isALNUM Returns a boolean indicating whether the C C<char> is an ASCII alphanumeric -character or digit. +character (including underscore) or digit. bool isALNUM(char ch) +=for hackers +Found in file handy.h + =item isALPHA Returns a boolean indicating whether the C C<char> is an ASCII alphabetic @@ -674,6 +958,9 @@ character. bool isALPHA(char ch) +=for hackers +Found in file handy.h + =item isDIGIT Returns a boolean indicating whether the C C<char> is an ASCII @@ -681,6 +968,9 @@ digit. bool isDIGIT(char ch) +=for hackers +Found in file handy.h + =item isLOWER Returns a boolean indicating whether the C C<char> is a lowercase @@ -688,12 +978,18 @@ character. bool isLOWER(char ch) +=for hackers +Found in file handy.h + =item isSPACE Returns a boolean indicating whether the C C<char> is whitespace. bool isSPACE(char ch) +=for hackers +Found in file handy.h + =item isUPPER Returns a boolean indicating whether the C C<char> is an uppercase @@ -701,6 +997,9 @@ character. bool isUPPER(char ch) +=for hackers +Found in file handy.h + =item items Variable which is setup by C<xsubpp> to indicate the number of @@ -708,6 +1007,9 @@ items on the stack. See L<perlxs/"Variable-length Parameter Lists">. I32 items +=for hackers +Found in file XSUB.h + =item ix Variable which is setup by C<xsubpp> to indicate which of an @@ -715,12 +1017,18 @@ XSUB's aliases was used to invoke it. See L<perlxs/"The ALIAS: Keyword">. I32 ix +=for hackers +Found in file XSUB.h + =item LEAVE Closing bracket on a callback. See C<ENTER> and L<perlcall>. LEAVE; +=for hackers +Found in file scope.h + =item looks_like_number Test if an the content of an SV looks like a number (or is a @@ -728,58 +1036,88 @@ number). I32 looks_like_number(SV* sv) +=for hackers +Found in file sv.c + =item MARK Stack marker variable for the XSUB. See C<dMARK>. +=for hackers +Found in file pp.h + =item mg_clear Clear something magical that the SV represents. See C<sv_magic>. int mg_clear(SV* sv) +=for hackers +Found in file mg.c + =item mg_copy Copies the magic from one SV to another. See C<sv_magic>. int mg_copy(SV* sv, SV* nsv, const char* key, I32 klen) +=for hackers +Found in file mg.c + =item mg_find Finds the magic pointer for type matching the SV. See C<sv_magic>. MAGIC* mg_find(SV* sv, int type) +=for hackers +Found in file mg.c + =item mg_free Free any magic storage used by the SV. See C<sv_magic>. int mg_free(SV* sv) +=for hackers +Found in file mg.c + =item mg_get Do magic after a value is retrieved from the SV. See C<sv_magic>. int mg_get(SV* sv) +=for hackers +Found in file mg.c + =item mg_length Report on the SV's length. See C<sv_magic>. U32 mg_length(SV* sv) +=for hackers +Found in file mg.c + =item mg_magical Turns on the magical status of an SV. See C<sv_magic>. void mg_magical(SV* sv) +=for hackers +Found in file mg.c + =item mg_set Do magic after a value is assigned to the SV. See C<sv_magic>. int mg_set(SV* sv) +=for hackers +Found in file mg.c + =item Move The XSUB-writer's interface to the C C<memmove> function. The C<src> is the @@ -788,18 +1126,27 @@ the type. Can do overlapping moves. See also C<Copy>. void Move(void* src, void* dest, int nitems, type) +=for hackers +Found in file handy.h + =item New The XSUB-writer's interface to the C C<malloc> function. void New(int id, void* ptr, int nitems, type) +=for hackers +Found in file handy.h + =item newAV Creates a new AV. The reference count is set to 1. AV* newAV() +=for hackers +Found in file av.c + =item Newc The XSUB-writer's interface to the C C<malloc> function, with @@ -807,6 +1154,9 @@ cast. void Newc(int id, void* ptr, int nitems, type, cast) +=for hackers +Found in file handy.h + =item newCONSTSUB Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is @@ -814,12 +1164,18 @@ eligible for inlining at compile-time. void newCONSTSUB(HV* stash, char* name, SV* sv) +=for hackers +Found in file op.c + =item newHV Creates a new HV. The reference count is set to 1. HV* newHV() +=for hackers +Found in file hv.c + =item newRV_inc Creates an RV wrapper for an SV. The reference count for the original SV is @@ -827,6 +1183,9 @@ incremented. SV* newRV_inc(SV* sv) +=for hackers +Found in file sv.h + =item newRV_noinc Creates an RV wrapper for an SV. The reference count for the original @@ -834,6 +1193,9 @@ SV is B<not> incremented. SV* newRV_noinc(SV *sv) +=for hackers +Found in file sv.c + =item NEWSV Creates a new SV. A non-zero C<len> parameter indicates the number of @@ -844,6 +1206,9 @@ C<id> is an integer id between 0 and 1299 (used to identify leaks). SV* NEWSV(int id, STRLEN len) +=for hackers +Found in file handy.h + =item newSViv Creates a new SV and copies an integer into it. The reference count for the @@ -851,6 +1216,9 @@ SV is set to 1. SV* newSViv(IV i) +=for hackers +Found in file sv.c + =item newSVnv Creates a new SV and copies a floating point value into it. @@ -858,6 +1226,9 @@ The reference count for the SV is set to 1. SV* newSVnv(NV n) +=for hackers +Found in file sv.c + =item newSVpv Creates a new SV and copies a string into it. The reference count for the @@ -866,6 +1237,9 @@ strlen(). For efficiency, consider using C<newSVpvn> instead. SV* newSVpv(const char* s, STRLEN len) +=for hackers +Found in file sv.c + =item newSVpvf Creates a new SV an initialize it with the string formatted like @@ -873,6 +1247,9 @@ C<sprintf>. SV* newSVpvf(const char* pat, ...) +=for hackers +Found in file sv.c + =item newSVpvn Creates a new SV and copies a string into it. The reference count for the @@ -882,6 +1259,9 @@ C<len> bytes long. SV* newSVpvn(const char* s, STRLEN len) +=for hackers +Found in file sv.c + =item newSVrv Creates a new SV for the RV, C<rv>, to point to. If C<rv> is not an RV then @@ -891,12 +1271,18 @@ reference count is 1. SV* newSVrv(SV* rv, const char* classname) +=for hackers +Found in file sv.c + =item newSVsv Creates a new SV which is an exact duplicate of the original SV. SV* newSVsv(SV* old) +=for hackers +Found in file sv.c + =item newSVuv Creates a new SV and copies an unsigned integer into it. @@ -904,15 +1290,24 @@ The reference count for the SV is set to 1. SV* newSVuv(UV u) +=for hackers +Found in file sv.c + =item newXS Used by C<xsubpp> to hook up XSUBs as Perl subs. +=for hackers +Found in file op.c + =item newXSproto Used by C<xsubpp> to hook up XSUBs as Perl subs. Adds Perl prototypes to the subs. +=for hackers +Found in file XSUB.h + =item Newz The XSUB-writer's interface to the C C<malloc> function. The allocated @@ -920,66 +1315,105 @@ memory is zeroed with C<memzero>. void Newz(int id, void* ptr, int nitems, type) +=for hackers +Found in file handy.h + =item Nullav Null AV pointer. +=for hackers +Found in file av.h + =item Nullch Null character pointer. +=for hackers +Found in file handy.h + =item Nullcv Null CV pointer. +=for hackers +Found in file cv.h + =item Nullhv Null HV pointer. +=for hackers +Found in file hv.h + =item Nullsv Null SV pointer. +=for hackers +Found in file handy.h + =item ORIGMARK The original stack mark for the XSUB. See C<dORIGMARK>. +=for hackers +Found in file pp.h + =item perl_alloc Allocates a new Perl interpreter. See L<perlembed>. PerlInterpreter* perl_alloc() +=for hackers +Found in file perl.c + =item perl_construct Initializes a new Perl interpreter. See L<perlembed>. void perl_construct(PerlInterpreter* interp) +=for hackers +Found in file perl.c + =item perl_destruct Shuts down a Perl interpreter. See L<perlembed>. void perl_destruct(PerlInterpreter* interp) +=for hackers +Found in file perl.c + =item perl_free Releases a Perl interpreter. See L<perlembed>. void perl_free(PerlInterpreter* interp) +=for hackers +Found in file perl.c + =item perl_parse Tells a Perl interpreter to parse a Perl script. See L<perlembed>. int perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env) +=for hackers +Found in file perl.c + =item perl_run Tells a Perl interpreter to run. See L<perlembed>. int perl_run(PerlInterpreter* interp) +=for hackers +Found in file perl.c + =item PL_DBsingle When Perl is run in debugging mode, with the B<-d> switch, this SV is a @@ -990,6 +1424,9 @@ C<PL_DBsub>. SV * PL_DBsingle +=for hackers +Found in file intrpvar.h + =item PL_DBsub When Perl is run in debugging mode, with the B<-d> switch, this GV contains @@ -999,6 +1436,9 @@ C<PL_DBsingle>. GV * PL_DBsub +=for hackers +Found in file intrpvar.h + =item PL_DBtrace Trace variable used when Perl is run in debugging mode, with the B<-d> @@ -1007,12 +1447,18 @@ variable. See C<PL_DBsingle>. SV * PL_DBtrace +=for hackers +Found in file intrpvar.h + =item PL_dowarn The C variable which corresponds to Perl's $^W warning variable. bool PL_dowarn +=for hackers +Found in file intrpvar.h + =item PL_modglobal C<PL_modglobal> is a general purpose, interpreter global HV for use by @@ -1023,6 +1469,9 @@ prefixed by the package name of the extension that owns the data. HV* PL_modglobal +=for hackers +Found in file intrpvar.h + =item PL_na A convenience variable which is typically used with C<SvPV> when one @@ -1032,6 +1481,9 @@ C<SvPV_nolen> macro. STRLEN PL_na +=for hackers +Found in file thrdvar.h + =item PL_sv_no This is the C<false> SV. See C<PL_sv_yes>. Always refer to this as @@ -1039,12 +1491,18 @@ C<&PL_sv_no>. SV PL_sv_no +=for hackers +Found in file intrpvar.h + =item PL_sv_undef This is the C<undef> SV. Always refer to this as C<&PL_sv_undef>. SV PL_sv_undef +=for hackers +Found in file intrpvar.h + =item PL_sv_yes This is the C<true> SV. See C<PL_sv_no>. Always refer to this as @@ -1052,36 +1510,54 @@ C<&PL_sv_yes>. SV PL_sv_yes +=for hackers +Found in file intrpvar.h + =item POPi Pops an integer off the stack. IV POPi +=for hackers +Found in file pp.h + =item POPl Pops a long off the stack. long POPl +=for hackers +Found in file pp.h + =item POPn Pops a double off the stack. NV POPn +=for hackers +Found in file pp.h + =item POPp Pops a string off the stack. char* POPp +=for hackers +Found in file pp.h + =item POPs Pops an SV off the stack. SV* POPs +=for hackers +Found in file pp.h + =item PUSHi Push an integer onto the stack. The stack must have room for this element. @@ -1089,6 +1565,9 @@ Handles 'set' magic. See C<XPUSHi>. void PUSHi(IV iv) +=for hackers +Found in file pp.h + =item PUSHMARK Opening bracket for arguments on a callback. See C<PUTBACK> and @@ -1096,6 +1575,9 @@ L<perlcall>. PUSHMARK; +=for hackers +Found in file pp.h + =item PUSHn Push a double onto the stack. The stack must have room for this element. @@ -1103,6 +1585,9 @@ Handles 'set' magic. See C<XPUSHn>. void PUSHn(NV nv) +=for hackers +Found in file pp.h + =item PUSHp Push a string onto the stack. The stack must have room for this element. @@ -1111,6 +1596,9 @@ C<XPUSHp>. void PUSHp(char* str, STRLEN len) +=for hackers +Found in file pp.h + =item PUSHs Push an SV onto the stack. The stack must have room for this element. @@ -1118,6 +1606,9 @@ Does not handle 'set' magic. See C<XPUSHs>. void PUSHs(SV* sv) +=for hackers +Found in file pp.h + =item PUSHu Push an unsigned integer onto the stack. The stack must have room for this @@ -1125,6 +1616,9 @@ element. See C<XPUSHu>. void PUSHu(UV uv) +=for hackers +Found in file pp.h + =item PUTBACK Closing bracket for XSUB arguments. This is usually handled by C<xsubpp>. @@ -1132,12 +1626,18 @@ See C<PUSHMARK> and L<perlcall> for other uses. PUTBACK; +=for hackers +Found in file pp.h + =item Renew The XSUB-writer's interface to the C C<realloc> function. void Renew(void* ptr, int nitems, type) +=for hackers +Found in file handy.h + =item Renewc The XSUB-writer's interface to the C C<realloc> function, with @@ -1145,6 +1645,9 @@ cast. void Renewc(void* ptr, int nitems, type, cast) +=for hackers +Found in file handy.h + =item require_pv Tells Perl to C<require> a module. @@ -1153,6 +1656,9 @@ NOTE: the perl_ form of this function is deprecated. void require_pv(const char* pv) +=for hackers +Found in file perl.c + =item RETVAL Variable which is setup by C<xsubpp> to hold the return value for an @@ -1161,11 +1667,17 @@ L<perlxs/"The RETVAL Variable">. (whatever) RETVAL +=for hackers +Found in file XSUB.h + =item Safefree The XSUB-writer's interface to the C C<free> function. - void Safefree(void* src, void* dest, int nitems, type) + void Safefree(void* ptr) + +=for hackers +Found in file handy.h =item savepv @@ -1173,6 +1685,9 @@ Copy a string to a safe spot. This does not use an SV. char* savepv(const char* sv) +=for hackers +Found in file util.c + =item savepvn Copy a string to a safe spot. The C<len> indicates number of bytes to @@ -1180,6 +1695,9 @@ copy. This does not use an SV. char* savepvn(const char* sv, I32 len) +=for hackers +Found in file util.c + =item SAVETMPS Opening bracket for temporaries on a callback. See C<FREETMPS> and @@ -1187,29 +1705,44 @@ L<perlcall>. SAVETMPS; +=for hackers +Found in file scope.h + =item SP Stack pointer. This is usually handled by C<xsubpp>. See C<dSP> and C<SPAGAIN>. +=for hackers +Found in file pp.h + =item SPAGAIN Refetch the stack pointer. Used after a callback. See L<perlcall>. SPAGAIN; +=for hackers +Found in file pp.h + =item ST Used to access elements on the XSUB's stack. SV* ST(int ix) +=for hackers +Found in file XSUB.h + =item strEQ Test two strings to see if they are equal. Returns true or false. bool strEQ(char* s1, char* s2) +=for hackers +Found in file handy.h + =item strGE Test two strings to see if the first, C<s1>, is greater than or equal to @@ -1217,6 +1750,9 @@ the second, C<s2>. Returns true or false. bool strGE(char* s1, char* s2) +=for hackers +Found in file handy.h + =item strGT Test two strings to see if the first, C<s1>, is greater than the second, @@ -1224,6 +1760,9 @@ C<s2>. Returns true or false. bool strGT(char* s1, char* s2) +=for hackers +Found in file handy.h + =item strLE Test two strings to see if the first, C<s1>, is less than or equal to the @@ -1231,6 +1770,9 @@ second, C<s2>. Returns true or false. bool strLE(char* s1, char* s2) +=for hackers +Found in file handy.h + =item strLT Test two strings to see if the first, C<s1>, is less than the second, @@ -1238,6 +1780,9 @@ C<s2>. Returns true or false. bool strLT(char* s1, char* s2) +=for hackers +Found in file handy.h + =item strNE Test two strings to see if they are different. Returns true or @@ -1245,6 +1790,9 @@ false. bool strNE(char* s1, char* s2) +=for hackers +Found in file handy.h + =item strnEQ Test two strings to see if they are equal. The C<len> parameter indicates @@ -1253,6 +1801,9 @@ C<strncmp>). bool strnEQ(char* s1, char* s2, STRLEN len) +=for hackers +Found in file handy.h + =item strnNE Test two strings to see if they are different. The C<len> parameter @@ -1261,24 +1812,36 @@ wrapper for C<strncmp>). bool strnNE(char* s1, char* s2, STRLEN len) +=for hackers +Found in file handy.h + =item StructCopy This is an architecture-independent macro to copy one structure to another. void StructCopy(type src, type dest, type) +=for hackers +Found in file handy.h + =item SvCUR Returns the length of the string which is in the SV. See C<SvLEN>. STRLEN SvCUR(SV* sv) +=for hackers +Found in file sv.h + =item SvCUR_set Set the length of the string which is in the SV. See C<SvCUR>. void SvCUR_set(SV* sv, STRLEN len) +=for hackers +Found in file sv.h + =item SvEND Returns a pointer to the last character in the string which is in the SV. @@ -1286,6 +1849,9 @@ See C<SvCUR>. Access the character as *(SvEND(sv)). char* SvEND(SV* sv) +=for hackers +Found in file sv.h + =item SvGETMAGIC Invokes C<mg_get> on an SV if it has 'get' magic. This macro evaluates its @@ -1293,6 +1859,9 @@ argument more than once. void SvGETMAGIC(SV* sv) +=for hackers +Found in file sv.h + =item SvGROW Expands the character buffer in the SV so that it has room for the @@ -1302,12 +1871,18 @@ Returns a pointer to the character buffer. void SvGROW(SV* sv, STRLEN len) +=for hackers +Found in file sv.h + =item SvIOK Returns a boolean indicating whether the SV contains an integer. bool SvIOK(SV* sv) +=for hackers +Found in file sv.h + =item SvIOKp Returns a boolean indicating whether the SV contains an integer. Checks @@ -1315,30 +1890,45 @@ the B<private> setting. Use C<SvIOK>. bool SvIOKp(SV* sv) +=for hackers +Found in file sv.h + =item SvIOK_off Unsets the IV status of an SV. void SvIOK_off(SV* sv) +=for hackers +Found in file sv.h + =item SvIOK_on Tells an SV that it is an integer. void SvIOK_on(SV* sv) +=for hackers +Found in file sv.h + =item SvIOK_only Tells an SV that it is an integer and disables all other OK bits. void SvIOK_only(SV* sv) +=for hackers +Found in file sv.h + =item SvIV Coerces the given SV to an integer and returns it. IV SvIV(SV* sv) +=for hackers +Found in file sv.h + =item SvIVX Returns the integer which is stored in the SV, assuming SvIOK is @@ -1346,12 +1936,18 @@ true. IV SvIVX(SV* sv) +=for hackers +Found in file sv.h + =item SvLEN Returns the size of the string buffer in the SV. See C<SvCUR>. STRLEN SvLEN(SV* sv) +=for hackers +Found in file sv.h + =item SvNIOK Returns a boolean indicating whether the SV contains a number, integer or @@ -1359,6 +1955,9 @@ double. bool SvNIOK(SV* sv) +=for hackers +Found in file sv.h + =item SvNIOKp Returns a boolean indicating whether the SV contains a number, integer or @@ -1366,18 +1965,27 @@ double. Checks the B<private> setting. Use C<SvNIOK>. bool SvNIOKp(SV* sv) +=for hackers +Found in file sv.h + =item SvNIOK_off Unsets the NV/IV status of an SV. void SvNIOK_off(SV* sv) +=for hackers +Found in file sv.h + =item SvNOK Returns a boolean indicating whether the SV contains a double. bool SvNOK(SV* sv) +=for hackers +Found in file sv.h + =item SvNOKp Returns a boolean indicating whether the SV contains a double. Checks the @@ -1385,30 +1993,45 @@ B<private> setting. Use C<SvNOK>. bool SvNOKp(SV* sv) +=for hackers +Found in file sv.h + =item SvNOK_off Unsets the NV status of an SV. void SvNOK_off(SV* sv) +=for hackers +Found in file sv.h + =item SvNOK_on Tells an SV that it is a double. void SvNOK_on(SV* sv) +=for hackers +Found in file sv.h + =item SvNOK_only Tells an SV that it is a double and disables all other OK bits. void SvNOK_only(SV* sv) +=for hackers +Found in file sv.h + =item SvNV Coerce the given SV to a double and return it. NV SvNV(SV* sv) +=for hackers +Found in file sv.h + =item SvNVX Returns the double which is stored in the SV, assuming SvNOK is @@ -1416,12 +2039,18 @@ true. NV SvNVX(SV* sv) +=for hackers +Found in file sv.h + =item SvOK Returns a boolean indicating whether the value is an SV. bool SvOK(SV* sv) +=for hackers +Found in file sv.h + =item SvOOK Returns a boolean indicating whether the SvIVX is a valid offset value for @@ -1431,6 +2060,9 @@ allocated string buffer is really (SvPVX - SvIVX). bool SvOOK(SV* sv) +=for hackers +Found in file sv.h + =item SvPOK Returns a boolean indicating whether the SV contains a character @@ -1438,6 +2070,9 @@ string. bool SvPOK(SV* sv) +=for hackers +Found in file sv.h + =item SvPOKp Returns a boolean indicating whether the SV contains a character string. @@ -1445,24 +2080,36 @@ Checks the B<private> setting. Use C<SvPOK>. bool SvPOKp(SV* sv) +=for hackers +Found in file sv.h + =item SvPOK_off Unsets the PV status of an SV. void SvPOK_off(SV* sv) +=for hackers +Found in file sv.h + =item SvPOK_on Tells an SV that it is a string. void SvPOK_on(SV* sv) +=for hackers +Found in file sv.h + =item SvPOK_only Tells an SV that it is a string and disables all other OK bits. void SvPOK_only(SV* sv) +=for hackers +Found in file sv.h + =item SvPV Returns a pointer to the string in the SV, or a stringified form of the SV @@ -1470,6 +2117,9 @@ if the SV does not contain a string. Handles 'get' magic. char* SvPV(SV* sv, STRLEN len) +=for hackers +Found in file sv.h + =item SvPVX Returns a pointer to the string in the SV. The SV must contain a @@ -1477,6 +2127,9 @@ string. char* SvPVX(SV* sv) +=for hackers +Found in file sv.h + =item SvPV_force Like <SvPV> but will force the SV into becoming a string (SvPOK). You want @@ -1484,6 +2137,9 @@ force if you are going to update the SvPVX directly. char* SvPV_force(SV* sv, STRLEN len) +=for hackers +Found in file sv.h + =item SvPV_nolen Returns a pointer to the string in the SV, or a stringified form of the SV @@ -1491,48 +2147,72 @@ if the SV does not contain a string. Handles 'get' magic. char* SvPV_nolen(SV* sv) +=for hackers +Found in file sv.h + =item SvREFCNT Returns the value of the object's reference count. U32 SvREFCNT(SV* sv) +=for hackers +Found in file sv.h + =item SvREFCNT_dec Decrements the reference count of the given SV. void SvREFCNT_dec(SV* sv) +=for hackers +Found in file sv.h + =item SvREFCNT_inc Increments the reference count of the given SV. SV* SvREFCNT_inc(SV* sv) +=for hackers +Found in file sv.h + =item SvROK Tests if the SV is an RV. bool SvROK(SV* sv) +=for hackers +Found in file sv.h + =item SvROK_off Unsets the RV status of an SV. void SvROK_off(SV* sv) +=for hackers +Found in file sv.h + =item SvROK_on Tells an SV that it is an RV. void SvROK_on(SV* sv) +=for hackers +Found in file sv.h + =item SvRV Dereferences an RV to return the SV. SV* SvRV(SV* sv) +=for hackers +Found in file sv.h + =item SvSETMAGIC Invokes C<mg_set> on an SV if it has 'set' magic. This macro evaluates its @@ -1540,6 +2220,9 @@ argument more than once. void SvSETMAGIC(SV* sv) +=for hackers +Found in file sv.h + =item SvSetSV Calls C<sv_setsv> if dsv is not the same as ssv. May evaluate arguments @@ -1547,6 +2230,9 @@ more than once. void SvSetSV(SV* dsb, SV* ssv) +=for hackers +Found in file sv.h + =item SvSetSV_nosteal Calls a non-destructive version of C<sv_setsv> if dsv is not the same as @@ -1554,18 +2240,27 @@ ssv. May evaluate arguments more than once. void SvSetSV_nosteal(SV* dsv, SV* ssv) +=for hackers +Found in file sv.h + =item SvSTASH Returns the stash of the SV. HV* SvSTASH(SV* sv) +=for hackers +Found in file sv.h + =item SvTAINT Taints an SV if tainting is enabled void SvTAINT(SV* sv) +=for hackers +Found in file sv.h + =item SvTAINTED Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if @@ -1573,6 +2268,9 @@ not. bool SvTAINTED(SV* sv) +=for hackers +Found in file sv.h + =item SvTAINTED_off Untaints an SV. Be I<very> careful with this routine, as it short-circuits @@ -1584,12 +2282,18 @@ untainting variables. void SvTAINTED_off(SV* sv) +=for hackers +Found in file sv.h + =item SvTAINTED_on Marks an SV as tainted. void SvTAINTED_on(SV* sv) +=for hackers +Found in file sv.h + =item SvTRUE Returns a boolean indicating whether Perl would evaluate the SV as true or @@ -1597,45 +2301,75 @@ false, defined or undefined. Does not handle 'get' magic. bool SvTRUE(SV* sv) +=for hackers +Found in file sv.h + =item svtype An enum of flags for Perl types. These are found in the file B<sv.h> in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. +=for hackers +Found in file sv.h + =item SvTYPE Returns the type of the SV. See C<svtype>. svtype SvTYPE(SV* sv) +=for hackers +Found in file sv.h + =item SVt_IV Integer type flag for scalars. See C<svtype>. +=for hackers +Found in file sv.h + =item SVt_NV Double type flag for scalars. See C<svtype>. +=for hackers +Found in file sv.h + =item SVt_PV Pointer type flag for scalars. See C<svtype>. +=for hackers +Found in file sv.h + =item SVt_PVAV Type flag for arrays. See C<svtype>. +=for hackers +Found in file sv.h + =item SVt_PVCV Type flag for code refs. See C<svtype>. +=for hackers +Found in file sv.h + =item SVt_PVHV Type flag for hashes. See C<svtype>. +=for hackers +Found in file sv.h + =item SVt_PVMG Type flag for blessed scalars. See C<svtype>. +=for hackers +Found in file sv.h + =item SvUPGRADE Used to upgrade an SV to a more complex form. Uses C<sv_upgrade> to @@ -1643,12 +2377,18 @@ perform the upgrade if necessary. See C<svtype>. void SvUPGRADE(SV* sv, svtype type) +=for hackers +Found in file sv.h + =item SvUV Coerces the given SV to an unsigned integer and returns it. UV SvUV(SV* sv) +=for hackers +Found in file sv.h + =item SvUVX Returns the unsigned integer which is stored in the SV, assuming SvIOK is @@ -1656,6 +2396,9 @@ true. UV SvUVX(SV* sv) +=for hackers +Found in file sv.h + =item sv_2mortal Marks an SV as mortal. The SV will be destroyed when the current context @@ -1663,6 +2406,9 @@ ends. SV* sv_2mortal(SV* sv) +=for hackers +Found in file sv.c + =item sv_bless Blesses an SV into a specified package. The SV must be an RV. The package @@ -1671,6 +2417,9 @@ of the SV is unaffected. SV* sv_bless(SV* sv, HV* stash) +=for hackers +Found in file sv.c + =item sv_catpv Concatenates the string onto the end of the string which is in the SV. @@ -1678,6 +2427,9 @@ Handles 'get' magic, but not 'set' magic. See C<sv_catpv_mg>. void sv_catpv(SV* sv, const char* ptr) +=for hackers +Found in file sv.c + =item sv_catpvf Processes its arguments like C<sprintf> and appends the formatted output @@ -1686,12 +2438,18 @@ typically be called after calling this function to handle 'set' magic. void sv_catpvf(SV* sv, const char* pat, ...) +=for hackers +Found in file sv.c + =item sv_catpvf_mg Like C<sv_catpvf>, but also handles 'set' magic. void sv_catpvf_mg(SV *sv, const char* pat, ...) +=for hackers +Found in file sv.c + =item sv_catpvn Concatenates the string onto the end of the string which is in the SV. The @@ -1700,18 +2458,27 @@ C<len> indicates number of bytes to copy. Handles 'get' magic, but not void sv_catpvn(SV* sv, const char* ptr, STRLEN len) +=for hackers +Found in file sv.c + =item sv_catpvn_mg Like C<sv_catpvn>, but also handles 'set' magic. void sv_catpvn_mg(SV *sv, const char *ptr, STRLEN len) +=for hackers +Found in file sv.c + =item sv_catpv_mg Like C<sv_catpv>, but also handles 'set' magic. void sv_catpv_mg(SV *sv, const char *ptr) +=for hackers +Found in file sv.c + =item sv_catsv Concatenates the string from SV C<ssv> onto the end of the string in SV @@ -1719,12 +2486,18 @@ C<dsv>. Handles 'get' magic, but not 'set' magic. See C<sv_catsv_mg>. void sv_catsv(SV* dsv, SV* ssv) +=for hackers +Found in file sv.c + =item sv_catsv_mg Like C<sv_catsv>, but also handles 'set' magic. void sv_catsv_mg(SV *dstr, SV *sstr) +=for hackers +Found in file sv.c + =item sv_chop Efficient removal of characters from the beginning of the string buffer. @@ -1734,6 +2507,19 @@ string. void sv_chop(SV* sv, char* ptr) +=for hackers +Found in file sv.c + +=item sv_clear + +Clear an SV, making it empty. Does not free the memory used by the SV +itself. + + void sv_clear(SV* sv) + +=for hackers +Found in file sv.c + =item sv_cmp Compares the strings in two SVs. Returns -1, 0, or 1 indicating whether the @@ -1742,12 +2528,28 @@ C<sv2>. I32 sv_cmp(SV* sv1, SV* sv2) +=for hackers +Found in file sv.c + +=item sv_cmp_locale + +Compares the strings in two SVs in a locale-aware manner. See +L</sv_cmp_locale> + + I32 sv_cmp_locale(SV* sv1, SV* sv2) + +=for hackers +Found in file sv.c + =item sv_dec Auto-decrement of the value in the SV. void sv_dec(SV* sv) +=for hackers +Found in file sv.c + =item sv_derived_from Returns a boolean indicating whether the SV is derived from the specified @@ -1756,6 +2558,9 @@ for class names as well as for objects. bool sv_derived_from(SV* sv, const char* name) +=for hackers +Found in file universal.c + =item sv_eq Returns a boolean indicating whether the strings in the two SVs are @@ -1763,6 +2568,28 @@ identical. I32 sv_eq(SV* sv1, SV* sv2) +=for hackers +Found in file sv.c + +=item sv_free + +Free the memory used by an SV. + + void sv_free(SV* sv) + +=for hackers +Found in file sv.c + +=item sv_gets + +Get a line from the filehandle and store it into the SV, optionally +appending to the currently-stored string. + + char* sv_gets(SV* sv, PerlIO* fp, I32 append) + +=for hackers +Found in file sv.c + =item sv_grow Expands the character buffer in the SV. This will use C<sv_unref> and will @@ -1771,12 +2598,18 @@ Use C<SvGROW>. char* sv_grow(SV* sv, STRLEN newlen) +=for hackers +Found in file sv.c + =item sv_inc Auto-increment of the value in the SV. void sv_inc(SV* sv) +=for hackers +Found in file sv.c + =item sv_insert Inserts a string at the specified offset/length within the SV. Similar to @@ -1784,6 +2617,9 @@ the Perl substr() function. void sv_insert(SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen) +=for hackers +Found in file sv.c + =item sv_isa Returns a boolean indicating whether the SV is blessed into the specified @@ -1792,6 +2628,9 @@ an inheritance relationship. int sv_isa(SV* sv, const char* name) +=for hackers +Found in file sv.c + =item sv_isobject Returns a boolean indicating whether the SV is an RV pointing to a blessed @@ -1800,18 +2639,37 @@ will return false. int sv_isobject(SV* sv) +=for hackers +Found in file sv.c + =item sv_len Returns the length of the string in the SV. See also C<SvCUR>. STRLEN sv_len(SV* sv) +=for hackers +Found in file sv.c + +=item sv_len_utf8 + +Returns the number of characters in the string in an SV, counting wide +UTF8 bytes as a single character. + + STRLEN sv_len_utf8(SV* sv) + +=for hackers +Found in file sv.c + =item sv_magic Adds magic to an SV. void sv_magic(SV* sv, SV* obj, int how, const char* name, I32 namlen) +=for hackers +Found in file sv.c + =item sv_mortalcopy Creates a new SV which is a copy of the original SV. The new SV is marked @@ -1819,12 +2677,64 @@ as mortal. SV* sv_mortalcopy(SV* oldsv) +=for hackers +Found in file sv.c + =item sv_newmortal Creates a new SV which is mortal. The reference count of the SV is set to 1. SV* sv_newmortal() +=for hackers +Found in file sv.c + +=item sv_pvn_force + +Get a sensible string out of the SV somehow. + + char* sv_pvn_force(SV* sv, STRLEN* lp) + +=for hackers +Found in file sv.c + +=item sv_pvutf8n_force + +Get a sensible UTF8-encoded string out of the SV somehow. See +L</sv_pvn_force>. + + char* sv_pvutf8n_force(SV* sv, STRLEN* lp) + +=for hackers +Found in file sv.c + +=item sv_reftype + +Returns a string describing what the SV is a reference to. + + char* sv_reftype(SV* sv, int ob) + +=for hackers +Found in file sv.c + +=item sv_replace + +Make the first argument a copy of the second, then delete the original. + + void sv_replace(SV* sv, SV* nsv) + +=for hackers +Found in file sv.c + +=item sv_rvweaken + +Weaken a reference. + + SV* sv_rvweaken(SV *sv) + +=for hackers +Found in file sv.c + =item sv_setiv Copies an integer into the given SV. Does not handle 'set' magic. See @@ -1832,12 +2742,18 @@ C<sv_setiv_mg>. void sv_setiv(SV* sv, IV num) +=for hackers +Found in file sv.c + =item sv_setiv_mg Like C<sv_setiv>, but also handles 'set' magic. void sv_setiv_mg(SV *sv, IV i) +=for hackers +Found in file sv.c + =item sv_setnv Copies a double into the given SV. Does not handle 'set' magic. See @@ -1845,12 +2761,18 @@ C<sv_setnv_mg>. void sv_setnv(SV* sv, NV num) +=for hackers +Found in file sv.c + =item sv_setnv_mg Like C<sv_setnv>, but also handles 'set' magic. void sv_setnv_mg(SV *sv, NV num) +=for hackers +Found in file sv.c + =item sv_setpv Copies a string into an SV. The string must be null-terminated. Does not @@ -1858,6 +2780,9 @@ handle 'set' magic. See C<sv_setpv_mg>. void sv_setpv(SV* sv, const char* ptr) +=for hackers +Found in file sv.c + =item sv_setpvf Processes its arguments like C<sprintf> and sets an SV to the formatted @@ -1865,12 +2790,18 @@ output. Does not handle 'set' magic. See C<sv_setpvf_mg>. void sv_setpvf(SV* sv, const char* pat, ...) +=for hackers +Found in file sv.c + =item sv_setpvf_mg Like C<sv_setpvf>, but also handles 'set' magic. void sv_setpvf_mg(SV *sv, const char* pat, ...) +=for hackers +Found in file sv.c + =item sv_setpviv Copies an integer into the given SV, also updating its string value. @@ -1878,12 +2809,18 @@ Does not handle 'set' magic. See C<sv_setpviv_mg>. void sv_setpviv(SV* sv, IV num) +=for hackers +Found in file sv.c + =item sv_setpviv_mg Like C<sv_setpviv>, but also handles 'set' magic. void sv_setpviv_mg(SV *sv, IV iv) +=for hackers +Found in file sv.c + =item sv_setpvn Copies a string into an SV. The C<len> parameter indicates the number of @@ -1891,18 +2828,27 @@ bytes to be copied. Does not handle 'set' magic. See C<sv_setpvn_mg>. void sv_setpvn(SV* sv, const char* ptr, STRLEN len) +=for hackers +Found in file sv.c + =item sv_setpvn_mg Like C<sv_setpvn>, but also handles 'set' magic. void sv_setpvn_mg(SV *sv, const char *ptr, STRLEN len) +=for hackers +Found in file sv.c + =item sv_setpv_mg Like C<sv_setpv>, but also handles 'set' magic. void sv_setpv_mg(SV *sv, const char *ptr) +=for hackers +Found in file sv.c + =item sv_setref_iv Copies an integer into a new SV, optionally blessing the SV. The C<rv> @@ -1913,6 +2859,9 @@ will be returned and will have a reference count of 1. SV* sv_setref_iv(SV* rv, const char* classname, IV iv) +=for hackers +Found in file sv.c + =item sv_setref_nv Copies a double into a new SV, optionally blessing the SV. The C<rv> @@ -1923,6 +2872,9 @@ will be returned and will have a reference count of 1. SV* sv_setref_nv(SV* rv, const char* classname, NV nv) +=for hackers +Found in file sv.c + =item sv_setref_pv Copies a pointer into a new SV, optionally blessing the SV. The C<rv> @@ -1939,6 +2891,9 @@ Note that C<sv_setref_pvn> copies the string while this copies the pointer. SV* sv_setref_pv(SV* rv, const char* classname, void* pv) +=for hackers +Found in file sv.c + =item sv_setref_pvn Copies a string into a new SV, optionally blessing the SV. The length of the @@ -1952,6 +2907,9 @@ Note that C<sv_setref_pv> copies the pointer while this copies the string. SV* sv_setref_pvn(SV* rv, const char* classname, char* pv, STRLEN n) +=for hackers +Found in file sv.c + =item sv_setsv Copies the contents of the source SV C<ssv> into the destination SV C<dsv>. @@ -1961,12 +2919,18 @@ C<sv_setsv_mg>. void sv_setsv(SV* dsv, SV* ssv) +=for hackers +Found in file sv.c + =item sv_setsv_mg Like C<sv_setsv>, but also handles 'set' magic. void sv_setsv_mg(SV *dstr, SV *sstr) +=for hackers +Found in file sv.c + =item sv_setuv Copies an unsigned integer into the given SV. Does not handle 'set' magic. @@ -1974,12 +2938,36 @@ See C<sv_setuv_mg>. void sv_setuv(SV* sv, UV num) +=for hackers +Found in file sv.c + =item sv_setuv_mg Like C<sv_setuv>, but also handles 'set' magic. void sv_setuv_mg(SV *sv, UV u) +=for hackers +Found in file sv.c + +=item sv_true + +Returns true if the SV has a true value by Perl's rules. + + I32 sv_true(SV *sv) + +=for hackers +Found in file sv.c + +=item sv_unmagic + +Removes magic from an SV. + + int sv_unmagic(SV* sv, int type) + +=for hackers +Found in file sv.c + =item sv_unref Unsets the RV status of the SV, and decrements the reference count of @@ -1988,6 +2976,9 @@ as a reversal of C<newSVrv>. See C<SvROK_off>. void sv_unref(SV* sv) +=for hackers +Found in file sv.c + =item sv_upgrade Upgrade an SV to a more complex form. Use C<SvUPGRADE>. See @@ -1995,6 +2986,9 @@ C<svtype>. bool sv_upgrade(SV* sv, U32 mt) +=for hackers +Found in file sv.c + =item sv_usepvn Tells an SV to use C<ptr> to find its string value. Normally the string is @@ -2007,12 +3001,55 @@ See C<sv_usepvn_mg>. void sv_usepvn(SV* sv, char* ptr, STRLEN len) +=for hackers +Found in file sv.c + =item sv_usepvn_mg Like C<sv_usepvn>, but also handles 'set' magic. void sv_usepvn_mg(SV *sv, char *ptr, STRLEN len) +=for hackers +Found in file sv.c + +=item sv_utf8_downgrade + +Attempt to convert the PV of an SV from UTF8-encoded to byte encoding. +This may not be possible if the PV contains non-byte encoding characters; +if this is the case, either returns false or, if C<fail_ok> is not +true, croaks. + +NOTE: this function is experimental and may change or be +removed without notice. + + bool sv_utf8_downgrade(SV *sv, bool fail_ok) + +=for hackers +Found in file sv.c + +=item sv_utf8_encode + +Convert the PV of an SV to UTF8-encoded, but then turn off the C<SvUTF8> +flag so that it looks like bytes again. Nothing calls this. + +NOTE: this function is experimental and may change or be +removed without notice. + + void sv_utf8_encode(SV *sv) + +=for hackers +Found in file sv.c + +=item sv_utf8_upgrade + +Convert the PV of an SV to its UTF8-encoded form. + + void sv_utf8_upgrade(SV *sv) + +=for hackers +Found in file sv.c + =item sv_vcatpvfn Processes its arguments like C<vsprintf> and appends the formatted output @@ -2023,6 +3060,9 @@ locales). void sv_vcatpvfn(SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted) +=for hackers +Found in file sv.c + =item sv_vsetpvfn Works like C<vcatpvfn> but copies the text into the SV instead of @@ -2030,6 +3070,9 @@ appending it. void sv_vsetpvfn(SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted) +=for hackers +Found in file sv.c + =item THIS Variable which is setup by C<xsubpp> to designate the object in a C++ @@ -2038,18 +3081,48 @@ L<perlxs/"Using XS With C++">. (whatever) THIS +=for hackers +Found in file XSUB.h + =item toLOWER Converts the specified character to lowercase. char toLOWER(char ch) +=for hackers +Found in file handy.h + =item toUPPER Converts the specified character to uppercase. char toUPPER(char ch) +=for hackers +Found in file handy.h + +=item U8 *s + +Returns true if first C<len> bytes of the given string form valid a UTF8 +string, false otherwise. + + bool_utf8_string U8 *s(STRLEN len) + +=for hackers +Found in file utf8.c + +=item utf8_to_bytes + +Converts a string C<s> of length C<len> from UTF8 into ASCII encoding. +Unlike C<bytes_to_utf8>, this over-writes the original string. +Returns zero on failure after converting as much as possible. + + U8 * utf8_to_bytes(U8 *s, STRLEN len) + +=for hackers +Found in file utf8.c + =item warn This is the XSUB-writer's interface to Perl's C<warn> function. Use this @@ -2058,6 +3131,9 @@ C<croak>. void warn(const char* pat, ...) +=for hackers +Found in file util.c + =item XPUSHi Push an integer onto the stack, extending the stack if necessary. Handles @@ -2065,6 +3141,9 @@ Push an integer onto the stack, extending the stack if necessary. Handles void XPUSHi(IV iv) +=for hackers +Found in file pp.h + =item XPUSHn Push a double onto the stack, extending the stack if necessary. Handles @@ -2072,6 +3151,9 @@ Push a double onto the stack, extending the stack if necessary. Handles void XPUSHn(NV nv) +=for hackers +Found in file pp.h + =item XPUSHp Push a string onto the stack, extending the stack if necessary. The C<len> @@ -2080,6 +3162,9 @@ C<PUSHp>. void XPUSHp(char* str, STRLEN len) +=for hackers +Found in file pp.h + =item XPUSHs Push an SV onto the stack, extending the stack if necessary. Does not @@ -2087,6 +3172,9 @@ handle 'set' magic. See C<PUSHs>. void XPUSHs(SV* sv) +=for hackers +Found in file pp.h + =item XPUSHu Push an unsigned integer onto the stack, extending the stack if necessary. @@ -2094,11 +3182,17 @@ See C<PUSHu>. void XPUSHu(UV uv) +=for hackers +Found in file pp.h + =item XS Macro to declare an XSUB and its C parameter list. This is handled by C<xsubpp>. +=for hackers +Found in file XSUB.h + =item XSRETURN Return from XSUB, indicating number of items on the stack. This is usually @@ -2106,48 +3200,72 @@ handled by C<xsubpp>. void XSRETURN(int nitems) +=for hackers +Found in file XSUB.h + =item XSRETURN_EMPTY Return an empty list from an XSUB immediately. XSRETURN_EMPTY; +=for hackers +Found in file XSUB.h + =item XSRETURN_IV Return an integer from an XSUB immediately. Uses C<XST_mIV>. void XSRETURN_IV(IV iv) +=for hackers +Found in file XSUB.h + =item XSRETURN_NO Return C<&PL_sv_no> from an XSUB immediately. Uses C<XST_mNO>. XSRETURN_NO; +=for hackers +Found in file XSUB.h + =item XSRETURN_NV Return an double from an XSUB immediately. Uses C<XST_mNV>. void XSRETURN_NV(NV nv) +=for hackers +Found in file XSUB.h + =item XSRETURN_PV Return a copy of a string from an XSUB immediately. Uses C<XST_mPV>. void XSRETURN_PV(char* str) +=for hackers +Found in file XSUB.h + =item XSRETURN_UNDEF Return C<&PL_sv_undef> from an XSUB immediately. Uses C<XST_mUNDEF>. XSRETURN_UNDEF; +=for hackers +Found in file XSUB.h + =item XSRETURN_YES Return C<&PL_sv_yes> from an XSUB immediately. Uses C<XST_mYES>. XSRETURN_YES; +=for hackers +Found in file XSUB.h + =item XST_mIV Place an integer into the specified position C<pos> on the stack. The @@ -2155,6 +3273,9 @@ value is stored in a new mortal SV. void XST_mIV(int pos, IV iv) +=for hackers +Found in file XSUB.h + =item XST_mNO Place C<&PL_sv_no> into the specified position C<pos> on the @@ -2162,6 +3283,9 @@ stack. void XST_mNO(int pos) +=for hackers +Found in file XSUB.h + =item XST_mNV Place a double into the specified position C<pos> on the stack. The value @@ -2169,6 +3293,9 @@ is stored in a new mortal SV. void XST_mNV(int pos, NV nv) +=for hackers +Found in file XSUB.h + =item XST_mPV Place a copy of a string into the specified position C<pos> on the stack. @@ -2176,6 +3303,9 @@ The value is stored in a new mortal SV. void XST_mPV(int pos, char* str) +=for hackers +Found in file XSUB.h + =item XST_mUNDEF Place C<&PL_sv_undef> into the specified position C<pos> on the @@ -2183,6 +3313,9 @@ stack. void XST_mUNDEF(int pos) +=for hackers +Found in file XSUB.h + =item XST_mYES Place C<&PL_sv_yes> into the specified position C<pos> on the @@ -2190,11 +3323,17 @@ stack. void XST_mYES(int pos) +=for hackers +Found in file XSUB.h + =item XS_VERSION The version identifier for an XS module. This is usually handled automatically by C<ExtUtils::MakeMaker>. See C<XS_VERSION_BOOTCHECK>. +=for hackers +Found in file XSUB.h + =item XS_VERSION_BOOTCHECK Macro to verify that a PM module's $VERSION variable matches the XS @@ -2203,6 +3342,9 @@ C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">. XS_VERSION_BOOTCHECK; +=for hackers +Found in file XSUB.h + =item Zero The XSUB-writer's interface to the C C<memzero> function. The C<dest> is the @@ -2210,6 +3352,9 @@ destination, C<nitems> is the number of items, and C<type> is the type. void Zero(void* dest, int nitems, type) +=for hackers +Found in file handy.h + =back =head1 AUTHORS diff --git a/pod/perldata.pod b/pod/perldata.pod index ac444fa17c..70ab1615f2 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -259,7 +259,7 @@ of sixteen buckets has been touched, and presumably contains all 10,000 of your items. This isn't supposed to happen. You can preallocate space for a hash by assigning to the keys() function. -This rounds up the allocated bucked to the next power of two: +This rounds up the allocated buckets to the next power of two: keys(%users) = 1000; # allocate 1024 buckets @@ -303,7 +303,8 @@ price is $Z<>100." print "The price is $Price.\n"; # interpreted As in some shells, you can enclose the variable name in braces to -disambiguate it from following alphanumerics. You must also do +disambiguate it from following alphanumerics (and underscores). +You must also do this when interpolating a variable into a string to separate the variable name from a following double-colon or an apostrophe, since these would be otherwise treated as a package separator: diff --git a/pod/perldebguts.pod b/pod/perldebguts.pod index 45c33c7ec4..5812a40fcb 100644 --- a/pod/perldebguts.pod +++ b/pod/perldebguts.pod @@ -639,7 +639,7 @@ than 32 bytes (all these examples assume 32-bit architectures, the result are quite a bit worse on 64-bit architectures). If a variable is accessed in two of three different ways (which require an integer, a float, or a string), the memory footprint may increase yet another -20 bytes. A sloppy malloc(3) implementation can make inflate these +20 bytes. A sloppy malloc(3) implementation can inflate these numbers dramatically. On the opposite end of the scale, a declaration like @@ -686,7 +686,7 @@ the following example: Total sbrk(): 215040/47:145. Odd ends: pad+heads+chain+tail: 0+2192+0+6144. It is possible to ask for such a statistic at arbitrary points in -your execution using the mstats() function out of the standard +your execution using the mstat() function out of the standard Devel::Peek module. Here is some explanation of that format: diff --git a/pod/perldebug.pod b/pod/perldebug.pod index c8ef60fa45..bccdcf4f51 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -767,6 +767,11 @@ Breakable lines are marked with C<:>. Lines with breakpoints are marked by C<b> and those with actions by C<a>. The line that's about to be executed is marked by C<< ==> >>. +Please be aware that code in debugger listings may not look the same +as your original source code. Line directives and external source +filters can alter the code before Perl sees it, causing code to move +from its original positions or take on entirely different forms. + =item Frame listing When the C<frame> option is set, the debugger would print entered (and diff --git a/pod/perldiag.pod b/pod/perldiag.pod index a49b9afb13..d6bf043a78 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -76,6 +76,13 @@ on the operator (e.g. C<CORE::log($x)>) or by declaring the subroutine to be an object method (see L<perlsub/"Subroutine Attributes"> or L<attributes>). +=item Ambiguous range in transliteration operator + +(F) You wrote something like C<tr/a-z-0//> which doesn't mean anything at +all. To include a C<-> character in a transliteration, put it either +first or last. (In the past, C<tr/a-z-0//> was synonymous with +C<tr/a-y//>, which was probably not what you would have expected.) + =item Ambiguous use of %s resolved as %s (W ambiguous)(S) You said something that may not be interpreted the way @@ -254,9 +261,9 @@ open(), or did it in another package. (S malloc) An internal routine called free() on something that had never been malloc()ed in the first place. Mandatory, but can be disabled by -setting environment variable C<PERL_BADFREE> to 1. +setting environment variable C<PERL_BADFREE> to 0. -This message can be quite often seen with DB_File on systems with "hard" +This message can be seen quite often with DB_File on systems with "hard" dynamic linking, like C<AIX> and C<OS/2>. It is a bug of C<Berkeley DB> which is left unnoticed if C<DB> uses I<forgiving> system malloc(). @@ -747,6 +754,12 @@ the file, say, by doing C<make install>. functioning as a class, but that package doesn't define that particular method, nor does any of its base classes. See L<perlobj>. +=item (perhaps you forgot to load "%s"?) + +(F) This is an educated guess made in conjunction with the message +"Can't locate object method \"%s\" via package \"%s\"". It often means +that a method requires a package that has not been loaded. + =item Can't locate package %s for @%s::ISA (W syntax) The @ISA array contained the name of another package that @@ -1018,23 +1031,23 @@ Perhaps you need to copy the value to a temporary, and repeat that. I<inside> character classes, the [] are part of the construct, for example: /[012[:alpha:]345]/. Note that [= =] and [. .] are not currently implemented; they are simply placeholders for future -extensions. +extensions and will cause fatal errors. =item Character class syntax [. .] is reserved for future extensions -(W regexp) Within regular expression character classes ([]) the syntax +(F regexp) Within regular expression character classes ([]) the syntax beginning with "[." and ending with ".]" is reserved for future -extensions. If you need to represent those character sequences inside a -regular expression character class, just quote the square brackets with -the backslash: "\[." and ".\]". +extensions. If you need to represent those character sequences inside +a regular expression character class, just quote the square brackets +with the backslash: "\[." and ".\]". =item Character class syntax [= =] is reserved for future extensions -(W regexp) Within regular expression character classes ([]) the syntax +(F) Within regular expression character classes ([]) the syntax beginning with "[=" and ending with "=]" is reserved for future -extensions. If you need to represent those character sequences inside a -regular expression character class, just quote the square brackets with -the backslash: "\[=" and "=\]". +extensions. If you need to represent those character sequences inside +a regular expression character class, just quote the square brackets +with the backslash: "\[=" and "=\]". =item Character class [:%s:] unknown @@ -1051,7 +1064,7 @@ not realizing that 777 will be interpreted as a decimal number, equivalent to 01411. Octal constants are introduced with a leading 0 in Perl, as in C. -=item Close on unopened file <%s> +=item Close on unopened file %s (W unopened) You tried to close a filehandle that was never opened. @@ -1075,7 +1088,7 @@ arbitrarily. ("Simple" and "medium" situations are handled without recursion and are not subject to a limit.) Try shortening the string under examination; looping in Perl code (e.g. with C<while>) rather than in the regular expression engine; or rewriting the regular expression so -that it is simpler or backtracks less. (See L<perlbook> for information +that it is simpler or backtracks less. (See L<perlfaq2> for information on I<Mastering Regular Expressions>.) =item connect() on closed socket %s @@ -1691,6 +1704,11 @@ L<perlfunc/sprintf>. (F) The range specified in a character class had a minimum character greater than the maximum character. See L<perlre>. +=item invalid [] range "%s" in transliteration operator + +(F) The range specified in the tr/// or y/// operator had a minimum +character greater than the maximum character. See L<perlop>. + =item Invalid separator character %s in attribute list (F) Something other than a colon or whitespace was seen between the @@ -1768,7 +1786,12 @@ or with nonempty prefix1 and prefix2. If C<prefix1> is indeed a prefix of a builtin library search path, prefix2 is substituted. The error may appear if components are not found, or are too long. See -"PERLLIB_PREFIX" in F<README.os2>. +"PERLLIB_PREFIX" in L<perlos2>. + +=item Malformed UTF-16 surrogate + +Perl thought it was reading UTF-16 encoded character data but while +doing it Perl met a malformed Unicode surrogate. =item %s matches null string many times @@ -2472,6 +2495,11 @@ was string. (P) The lexer got into a bad state while processing a case modifier. +=item panic: utf16_to_utf8: odd bytelen + +(P) Something tried to call utf16_to_utf8 with an odd (as opposed +to even) byte length. + =item Parentheses missing around "%s" list (W parenthesis) You said something like @@ -2493,7 +2521,7 @@ you upgraded, anyway? See L<perlfunc/require>. =item PERL_SH_DIR too long (F) An error peculiar to OS/2. PERL_SH_DIR is the directory to find the -C<sh>-shell in. See "PERL_SH_DIR" in F<README.os2>. +C<sh>-shell in. See "PERL_SH_DIR" in L<perlos2>. =item perl: warning: Setting locale failed. @@ -2641,7 +2669,7 @@ before now. Check your logic flow. applications die in silence. It is considered a feature of the OS/2 port. One can easily disable this by appropriate sighandlers, see L<perlipc/"Signals">. See also "Process terminated by SIGTERM/SIGINT" -in F<README.os2>. +in L<perlos2>. =item Prototype mismatch: %s vs %s @@ -2962,7 +2990,7 @@ unless there was a failure. You probably wanted to use system() instead, which does return. To suppress this warning, put the exec() in a block by itself. -=item Stat on unopened file <%s> +=item Stat on unopened file %s (W unopened) You tried to use the stat() function (or an equivalent file test) on a filehandle that was either never opened or has since been @@ -3082,7 +3110,7 @@ for Perl to reach. Perl is doing you a favor by refusing. (W unopened) You tried to use the tell() function on a filehandle that was either never opened or has since been closed. -=item Test on unopened file <%s> +=item Test on unopened file %s (W unopened) You tried to invoke a file test operator on a filehandle that isn't open. Check your logic. See also L<perlfunc/-X>. @@ -3401,6 +3429,11 @@ Note that under some systems, like OS/2, there may be different flavors of Perl executables, some of which may support fork, some not. Try changing the name you call Perl by to C<perl_>, C<perl__>, and so on. +=item Unsupported script encoding + +(F) Your program file begins with a Unicode Byte Order Mark (BOM) which +declares it to be in a Unicode encoding that Perl cannot yet read. + =item Unsupported socket function "%s" called (F) Your machine doesn't support the Berkeley socket mechanism, or at @@ -3420,6 +3453,12 @@ an attribute list, but the matching closing (right) parenthesis character was not found. You may need to add (or remove) a backslash character to get your parentheses to balance. See L<attributes>. +=item Unterminated compressed integer + +(F) An argument to unpack("w",...) was incompatible with the BER +compressed integer format and could not be converted to an integer. +See L<perlfunc/pack>. + =item Unterminated <> operator (F) The lexer saw a left angle bracket in a place where it was expecting diff --git a/pod/perlembed.pod b/pod/perlembed.pod index c4df676b19..dce785e6c2 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -894,21 +894,14 @@ That's where the glue code can be inserted to create the initial contact between Perl and linked C/C++ routines. Let's take a look some pieces of I<perlmain.c> to see how Perl does this: + static void xs_init (pTHX); - #ifdef __cplusplus - # define EXTERN_C extern "C" - #else - # define EXTERN_C extern - #endif - - static void xs_init (void); - - EXTERN_C void boot_DynaLoader (CV* cv); - EXTERN_C void boot_Socket (CV* cv); + EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); + EXTERN_C void boot_Socket (pTHX_ CV* cv); EXTERN_C void - xs_init() + xs_init(pTHX) { char *file = __FILE__; /* DynaLoader is a special case */ @@ -955,21 +948,13 @@ B<ExtUtils::Embed> can also automate writing the I<xs_init> glue code. Consult L<perlxs>, L<perlguts>, and L<perlapi> for more details. -=head1 Embedding Perl under Win32 - -At the time of this writing (5.004), there are two versions of Perl -which run under Win32. (The two versions are merging in 5.005.) -Interfacing to ActiveState's Perl library is quite different from the -examples in this documentation, as significant changes were made to -the internal Perl API. However, it is possible to embed ActiveState's -Perl runtime. For details, see the Perl for Win32 FAQ at -http://www.perl.com/CPAN/doc/FAQs/win32/perlwin32faq.html. +=head1 Embedding Perl under Windows -With the "official" Perl version 5.004 or higher, all the examples -within this documentation will compile and run untouched, although -the build process is slightly different between Unix and Win32. +In general, all of the source code shown here should work unmodified under +Windows. -For starters, backticks don't work under the Win32 native command shell. +However, there are some caveats about the command-line examples shown. +For starters, backticks won't work under the Win32 native command shell. The ExtUtils::Embed kit on CPAN ships with a script called B<genmake>, which generates a simple makefile to build a program from a single C source file. It can be used like this: diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index af9178dee1..d0b92bb941 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -196,15 +196,13 @@ Christiansen maintains a list of these books, some with extensive reviews, at http://www.perl.com/perl/critiques/index.html. The incontestably definitive reference book on Perl, written by -the creator of Perl, is now in its second edition: +the creator of Perl, is now (July 2000) in its third edition: Programming Perl (the "Camel Book"): - by Larry Wall, Tom Christiansen, and Randal Schwartz - ISBN 1-56592-149-6 (English) - ISBN 4-89052-384-7 (Japanese) - URL: http://www.oreilly.com/catalog/pperl2/ - (French, German, Italian, and Hungarian translations also - available) + by Larry Wall, Tom Christiansen, and Jon Orwant + 0-596-00027-8 [3rd edition July 2000] + http://www.oreilly.com/catalog/pperl3/ + (English, translations to several languages are also available) The companion volume to the Camel containing thousands of real-world examples, mini-tutorials, and complete programs @@ -212,9 +210,9 @@ of real-world examples, mini-tutorials, and complete programs The Perl Cookbook (the "Ram Book"): by Tom Christiansen and Nathan Torkington, - with Foreword by Larry Wall - ISBN: 1-56592-243-3 - URL: http://perl.oreilly.com/cookbook/ + with Foreword by Larry Wall + ISBN 1-56592-243-3 [1st Edition August 1998] + http://perl.oreilly.com/cookbook/ If you're already a hard-core systems programmer, then the Camel Book might suffice for you to learn Perl from. But if you're not, check @@ -223,8 +221,8 @@ out: Learning Perl (the "Llama Book"): by Randal Schwartz and Tom Christiansen with Foreword by Larry Wall - ISBN: 1-56592-284-0 - URL: http://www.oreilly.com/catalog/lperl2/ + ISBN 1-56592-284-0 [2nd Edition July 1997] + http://www.oreilly.com/catalog/lperl2/ Despite the picture at the URL above, the second edition of "Llama Book" really has a blue cover, and is updated for the 5.004 release @@ -245,66 +243,106 @@ See http://www.ora.com/ on the Web. What follows is a list of the books that the FAQ authors found personally useful. Your mileage may (but, we hope, probably won't) vary. -Recommended books on (or mostly on) Perl follow; those marked with -a star may be ordered from O'Reilly. +Recommended books on (or mostly on) Perl follow. =over =item References - *Programming Perl - by Larry Wall, Tom Christiansen, and Randal L. Schwartz + Programming Perl + by Larry Wall, Tom Christiansen, and Jon Orwant + ISBN 0-596-00027-8 [3rd edition July 2000] + http://www.oreilly.com/catalog/pperl3/ - *Perl 5 Desktop Reference + Perl 5 Pocket Reference by Johan Vromans + ISBN 0-596-00032-4 [3rd edition May 2000] + http://www.oreilly.com/catalog/perlpr3/ - *Perl in a Nutshell + Perl in a Nutshell by Ellen Siever, Stephan Spainhour, and Nathan Patwardhan + ISBN 1-56592-286-7 [1st edition December 1998] + http://www.oreilly.com/catalog/perlnut/ =item Tutorials - *Learning Perl [2nd edition] + Elements of Programming with Perl + by Andrew L. Johnson + ISBN 1884777805 [1st edition October 1999] + http://www.manning.com/Johnson/ + + Learning Perl by Randal L. Schwartz and Tom Christiansen with foreword by Larry Wall + ISBN 1-56592-284-0 [2nd edition July 1997] + http://www.oreilly.com/catalog/lperl2/ - *Learning Perl on Win32 Systems + Learning Perl on Win32 Systems by Randal L. Schwartz, Erik Olson, and Tom Christiansen, with foreword by Larry Wall + ISBN 1-56592-324-3 [1st edition August 1997] + http://www.oreilly.com/catalog/lperlwin/ Perl: The Programmer's Companion by Nigel Chapman + ISBN 0-471-97563-X [1st edition October 1997] + http://catalog.wiley.com/title.cgi?isbn=047197563X - Cross-Platform Perl - by Eric F. Johnson + Cross-Platform Perl + by Eric Foster-Johnson + ISBN 1-55851-483-X [2nd edition September 2000] + http://www.pconline.com/~erc/perlbook.htm - MacPerl: Power and Ease - by Vicki Brown and Chris Nandor, foreword by Matthias Neeracher + MacPerl: Power and Ease + by Vicki Brown and Chris Nandor, + with foreword by Matthias Neeracher + ISBN 1-881957-32-2 [1st edition May 1998] + http://www.macperl.com/ptf_book/ =item Task-Oriented - *The Perl Cookbook + The Perl Cookbook by Tom Christiansen and Nathan Torkington with foreword by Larry Wall + ISBN 1-56592-243-3 [1st edition August 1998] + http://www.oreilly.com/catalog/cookbook/ - Perl5 Interactive Course [2nd edition] + Perl5 Interactive Course by Jon Orwant + ISBN 1571690646 [1st edition June 1997] - *Advanced Perl Programming + Advanced Perl Programming by Sriram Srinivasan + ISBN 1-56592-220-4 [1st edition August 1997] + http://www.oreilly.com/catalog/advperl/ Effective Perl Programming by Joseph Hall + ISBN 0-201-41975-0 [1st edition 1998] + http://www.awl.com/ =item Special Topics - *Mastering Regular Expressions - by Jeffrey Friedl + Mastering Regular Expressions + by Jeffrey E. F. Friedl + ISBN 1-56592-257-3 [1st edition January 1997] + http://www.oreilly.com/catalog/regex/ - How to Set up and Maintain a World Wide Web Site [2nd edition] + How to Set up and Maintain a World Wide Web Site by Lincoln Stein + ISBN 0-201-63389-2 [1st edition 1995] + http://www.awl.com/ - *Learning Perl/Tk + Object Oriented Perl + Damian Conway + with foreword by Randal L. Schwartz + ISBN 1884777791 [1st edition August 1999] + http://www.manning.com/Conway/ + + Learning Perl/Tk by Nancy Walsh + ISBN 1-56592-314-6 [1st edition January 1999] + http://www.oreilly.com/catalog/lperltk/ =back @@ -331,14 +369,19 @@ http://www.stonehenge.com/merlyn/WebTechniques/. To get the best (and possibly cheapest) performance, pick a site from the list below and use it to grab the complete list of mirror sites. From there you can find the quickest site for you. Remember, the -following list is I<not> the complete list of CPAN mirrors. - - http://www.perl.com/CPAN-local - http://www.perl.com/CPAN (redirects to an ftp mirror) - ftp://cpan.valueclick.com/pub/CPAN/ +following list is I<not> the complete list of CPAN mirrors +(the complete list contains 136 sites as of July 2000): + + http://www.perl.com/CPAN/ + http://www.cpan.org/CPAN/ + http://download.sourceforge.net/mirrors/CPAN/ + ftp://ftp.digital.com/pub/plan/perl/CPAN/ + ftp://ftp.flirble.org/pub/languages/perl/CPAN/ + ftp://ftp.uvsq.fr/pub/perl/CPAN/ ftp://ftp.funet.fi/pub/languages/perl/CPAN/ - http://www.cs.ruu.nl/pub/PERL/CPAN/ - ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ + ftp://ftp.dti.ad.jp/pub/lang/CPAN/ + ftp://mirror.aarnet.edu.au/pub/perl/CPAN/ + ftp://cpan.if.usp.br/pub/mirror/CPAN/ =head2 What mailing lists are there for Perl? diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index e997a8fcb9..ecbd65243e 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -1746,7 +1746,7 @@ if you just want to say, ``Is this a float?'' Or you could check out the String::Scanf module on CPAN instead. The POSIX module (part of the standard Perl distribution) provides the -C<strtol> and C<strtod> for converting strings to double and longs, +C<strtod> and C<strtol> for converting strings to double and longs, respectively. =head2 How do I keep persistent data across program calls? diff --git a/pod/perlfaq6.pod b/pod/perlfaq6.pod index bf007ee26b..29136abd96 100644 --- a/pod/perlfaq6.pod +++ b/pod/perlfaq6.pod @@ -415,7 +415,8 @@ Use the split function: Note that this isn't really a word in the English sense; it's just chunks of consecutive non-whitespace characters. -To work with only alphanumeric sequences, you might consider +To work with only alphanumeric sequences (including underscores), you +might consider while (<>) { foreach $word (m/(\w+)/g) { diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod index 16a803c997..d1bd593dfe 100644 --- a/pod/perlfaq9.pod +++ b/pod/perlfaq9.pod @@ -215,7 +215,8 @@ Here's an example of decoding: $string =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; Encoding is a bit harder, because you can't just blindly change -all the non-alphanumunder character (C<\W>) into their hex escapes. +all characters that are not letters, digits or underscores (C<\W>) +into their hex escapes. It's important that characters with special meaning like C</> and C<?> I<not> be translated. Probably the easiest way to get this right is to avoid reinventing the wheel and just use the URI::Escape module, diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 4e67506e26..e19d341dad 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -688,8 +688,11 @@ On POSIX systems, you can detect this condition this way: Returns the character represented by that NUMBER in the character set. For example, C<chr(65)> is C<"A"> in either ASCII or Unicode, and -chr(0x263a) is a Unicode smiley face (but only within the scope of -a C<use utf8>). For the reverse, use L</ord>. +chr(0x263a) is a Unicode smiley face. Within the scope of C<use utf8>, +characters higher than 127 are encoded in Unicode; if you don't want +this, temporarily C<use bytes> or use C<pack("C*",...)> + +For the reverse, use L</ord>. See L<utf8> for more about Unicode. If NUMBER is omitted, uses C<$_>. @@ -1265,11 +1268,11 @@ there was an error. In the first form, the return value of EXPR is parsed and executed as if it were a little Perl program. The value of the expression (which is itself determined within scalar context) is first parsed, and if there weren't any -errors, executed in the context of the current Perl program, so that any -variable settings or subroutine and format definitions remain afterwards. -Note that the value is parsed every time the eval executes. If EXPR is -omitted, evaluates C<$_>. This form is typically used to delay parsing -and subsequent execution of the text of EXPR until run time. +errors, executed in the lexical context of the current Perl program, so +that any variable settings or subroutine and format definitions remain +afterwards. Note that the value is parsed every time the eval executes. +If EXPR is omitted, evaluates C<$_>. This form is typically used to +delay parsing and subsequent execution of the text of EXPR until run time. In the second form, the code within the BLOCK is parsed only once--at the same time the code surrounding the eval itself was parsed--and executed @@ -2078,9 +2081,9 @@ or equivalently, @foo = grep {!/^#/} @bar; # weed out comments -Note that, because C<$_> is a reference into the list value, it can -be used to modify the elements of the array. While this is useful and -supported, it can cause bizarre results if the LIST is not a named array. +Note that C<$_> is an alias to the list value, so it can be used to +modify the elements of the LIST. While this is useful and supported, +it can cause bizarre results if the elements of LIST are not variables. Similarly, grep returns aliases into the original list, much as a for loop's index variable aliases the list elements. That is, modifying an element of a list returned by grep (for example, in a C<foreach>, C<map> @@ -2462,9 +2465,9 @@ is just a funny way to write $hash{getkey($_)} = $_; } -Note that, because C<$_> is a reference into the list value, it can -be used to modify the elements of the array. While this is useful and -supported, it can cause bizarre results if the LIST is not a named array. +Note that C<$_> is an alias to the list value, so it can be used to +modify the elements of the LIST. While this is useful and supported, +it can cause bizarre results if the elements of LIST are not variables. Using a regular C<foreach> loop for this purpose would be clearer in most cases. See also L</grep> for an array composed of those items of the original list for which the BLOCK or EXPR evaluates to true. @@ -2495,13 +2498,13 @@ first to get the correct constant definitions. If CMD is C<IPC_STAT>, then ARG must be a variable which will hold the returned C<msqid_ds> structure. Returns like C<ioctl>: the undefined value for error, C<"0 but true"> for zero, or the actual return value otherwise. See also -C<IPC::SysV> and C<IPC::Semaphore> documentation. +L<perlipc/"SysV IPC">, C<IPC::SysV>, and C<IPC::Semaphore> documentation. =item msgget KEY,FLAGS Calls the System V IPC function msgget(2). Returns the message queue -id, or the undefined value if there is an error. See also C<IPC::SysV> -and C<IPC::Msg> documentation. +id, or the undefined value if there is an error. See also +L<perlipc/"SysV IPC"> and C<IPC::SysV> and C<IPC::Msg> documentation. =item msgrcv ID,VAR,SIZE,TYPE,FLAGS @@ -2511,7 +2514,8 @@ SIZE. Note that when a message is received, the message type as a native long integer will be the first thing in VAR, followed by the actual message. This packing may be opened with C<unpack("l! a*")>. Taints the variable. Returns true if successful, or false if there is -an error. See also C<IPC::SysV> and C<IPC::SysV::Msg> documentation. +an error. See also L<perlipc/"SysV IPC">, C<IPC::SysV>, and +C<IPC::SysV::Msg> documentation. =item msgsnd ID,MSG,FLAGS @@ -3202,6 +3206,15 @@ equal $foo). =item * +If the pattern begins with a C<U>, the resulting string will be treated +as Unicode-encoded. You can force UTF8 encoding on in a string with an +initial C<U0>, and the bytes that follow will be interpreted as Unicode +characters. If you don't want this to happen, you can begin your pattern +with C<C0> (or anything else) to force Perl not to UTF8 encode your +string, and then follow this with a C<U*> somewhere in your pattern. + +=item * + You must yourself do any alignment or padding by inserting for example enough C<'x'>es while packing. There is no way to pack() and unpack() could know where the bytes are going to or coming from. Therefore @@ -3426,7 +3439,7 @@ Generalized quotes. See L<perlop/"Regexp Quote-Like Operators">. =item quotemeta -Returns the value of EXPR with all non-alphanumeric +Returns the value of EXPR with all non-"word" characters backslashed. (That is, all characters not matching C</[A-Za-z_0-9]/> will be preceded by a backslash in the returned string, regardless of any locale settings.) @@ -3934,13 +3947,15 @@ semid_ds structure or semaphore value array. Returns like C<ioctl>: the undefined value for error, "C<0 but true>" for zero, or the actual return value otherwise. The ARG must consist of a vector of native short integers, which may be created with C<pack("s!",(0)x$nsem)>. -See also C<IPC::SysV> and C<IPC::Semaphore> documentation. +See also L<perlipc/"SysV IPC">, C<IPC::SysV>, C<IPC::Semaphore> +documentation. =item semget KEY,NSEMS,FLAGS Calls the System V IPC function semget. Returns the semaphore id, or -the undefined value if there is an error. See also C<IPC::SysV> and -C<IPC::SysV::Semaphore> documentation. +the undefined value if there is an error. See also +L<perlipc/"SysV IPC">, C<IPC::SysV>, C<IPC::SysV::Semaphore> +documentation. =item semop KEY,OPSTRING @@ -3955,8 +3970,9 @@ following code waits on semaphore $semnum of semaphore id $semid: $semop = pack("sss", $semnum, -1, 0); die "Semaphore trouble: $!\n" unless semop($semid, $semop); -To signal the semaphore, replace C<-1> with C<1>. See also C<IPC::SysV> -and C<IPC::SysV::Semaphore> documentation. +To signal the semaphore, replace C<-1> with C<1>. See also +L<perlipc/"SysV IPC">, C<IPC::SysV>, and C<IPC::SysV::Semaphore> +documentation. =item send SOCKET,MSG,FLAGS,TO @@ -4002,7 +4018,7 @@ C<@ARGV> array at file scopes or within the lexical scopes established by the C<eval ''>, C<BEGIN {}>, C<INIT {}>, C<CHECK {}>, and C<END {}> constructs. -See also C<unshift>, C<push>, and C<pop>. C<shift()> and C<unshift> do the +See also C<unshift>, C<push>, and C<pop>. C<shift> and C<unshift> do the same thing to the left end of an array that C<pop> and C<push> do to the right end. @@ -4016,13 +4032,13 @@ first to get the correct constant definitions. If CMD is C<IPC_STAT>, then ARG must be a variable which will hold the returned C<shmid_ds> structure. Returns like ioctl: the undefined value for error, "C<0> but true" for zero, or the actual return value otherwise. -See also C<IPC::SysV> documentation. +See also L<perlipc/"SysV IPC"> and C<IPC::SysV> documentation. =item shmget KEY,SIZE,FLAGS Calls the System V IPC function shmget. Returns the shared memory segment id, or the undefined value if there is an error. -See also C<IPC::SysV> documentation. +See also L<perlipc/"SysV IPC"> and C<IPC::SysV> documentation. =item shmread ID,VAR,POS,SIZE @@ -4034,8 +4050,8 @@ detaching from it. When reading, VAR must be a variable that will hold the data read. When writing, if STRING is too long, only SIZE bytes are used; if STRING is too short, nulls are written to fill out SIZE bytes. Return true if successful, or false if there is an error. -shmread() taints the variable. See also C<IPC::SysV> documentation and -the C<IPC::Shareable> module from CPAN. +shmread() taints the variable. See also L<perlipc/"SysV IPC">, +C<IPC::SysV> documentation, and the C<IPC::Shareable> module from CPAN. =item shutdown SOCKET,HOW @@ -4237,15 +4253,12 @@ Examples: If you're using strict, you I<must not> declare $a and $b as lexicals. They are package globals. That means -if you're in the C<main> package, it's - - @articles = sort {$main::b <=> $main::a} @files; - -or just - - @articles = sort {$::b <=> $::a} @files; - -but if you're in the C<FooPack> package, it's +if you're in the C<main> package and type + + @articles = sort {$b <=> $a} @files; + +then C<$a> and C<$b> are C<$main::a> and C<$main::b> (or C<$::a> and C<$::b>), +but if you're in the C<FooPack> package, it's the same as typing @articles = sort {$FooPack::b <=> $FooPack::a} @files; @@ -4304,11 +4317,9 @@ Example, assuming array lengths are passed before arrays: Splits a string into a list of strings and returns that list. By default, empty leading fields are preserved, and empty trailing ones are deleted. -If not in list context, returns the number of fields found and splits into -the C<@_> array. (In list context, you can force the split into C<@_> by -using C<??> as the pattern delimiters, but it still returns the list -value.) The use of implicit split to C<@_> is deprecated, however, because -it clobbers your subroutine arguments. +In scalar context, returns the number of fields found and splits into +the C<@_> array. Use of split in scalar context is deprecated, however, +because it clobbers your subroutine arguments. If EXPR is omitted, splits the C<$_> string. If PATTERN is also omitted, splits on whitespace (after skipping any leading whitespace). Anything @@ -4367,6 +4378,9 @@ A C<split> on C</\s+/> is like a C<split(' ')> except that any leading whitespace produces a null first field. A C<split> with no arguments really does a C<split(' ', $_)> internally. +A PATTERN of C</^/> is treated as if it were C</^/m>, since it isn't +much use otherwise. + Example: open(PASSWD, '/etc/passwd'); @@ -4381,9 +4395,18 @@ L</chomp>, and L</join>.) =item sprintf FORMAT, LIST -Returns a string formatted by the usual C<printf> conventions of the -C library function C<sprintf>. See L<sprintf(3)> or L<printf(3)> -on your system for an explanation of the general principles. +Returns a string formatted by the usual C<printf> conventions of the C +library function C<sprintf>. See below for more details +and see L<sprintf(3)> or L<printf(3)> on your system for an explanation of +the general principles. + +For example: + + # Format number with up to 8 leading zeroes + $result = sprintf("%08d", $number); + + # Round number to 3 digits after decimal point + $rounded = sprintf("%.3f", $number); Perl does its own C<sprintf> formatting--it emulates the C function C<sprintf>, but it doesn't use it (except for floating-point diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 5f1dd21a14..f2b4b909b8 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -34,8 +34,8 @@ as well.) =head2 Working with SVs An SV can be created and loaded with one command. There are four types of -values that can be loaded: an integer value (IV), a double (NV), a string, -(PV), and another scalar (SV). +values that can be loaded: an integer value (IV), a double (NV), +a string (PV), and another scalar (SV). The six routines are: @@ -832,6 +832,8 @@ The current kinds of Magic Virtual Tables are: a vtbl_amagicelem %OVERLOAD hash element c (none) Holds overload table (AMT) on stash B vtbl_bm Boyer-Moore (fast string search) + D vtbl_regdata Regex match position data (@+ and @- vars) + d vtbl_regdatum Regex match position data element E vtbl_env %ENV hash e vtbl_envelem %ENV hash element f vtbl_fm Formline ('compiled' format) @@ -1315,6 +1317,21 @@ destination starting points. Perl will move, copy, or zero out C<number> instances of the size of the C<type> data structure (using the C<sizeof> function). +Here is a handy table of equivalents between ordinary C and Perl's +memory abstraction layer: + + Instead Of: Use: + + malloc New + calloc Newz + realloc Renew + memcopy Copy + memmove Move + free Safefree + strdup savepv + strndup savepvn (Hey, strndup doesn't exist!) + memcpy/*(struct foo *) StructCopy + =head2 PerlIO The most recent development releases of Perl has been experimenting with @@ -1554,17 +1571,11 @@ First problem: deciding which functions will be public API functions and which will be private. All functions whose names begin C<S_> are private (think "S" for "secret" or "static"). All other functions begin with "Perl_", but just because a function begins with "Perl_" does not mean it is -part of the API. The easiest way to be B<sure> a function is part of the API -is to find its entry in L<perlapi>. If it exists in L<perlapi>, it's part -of the API. If it doesn't, and you think it should be (i.e., you need it for -your extension), send mail via L<perlbug> explaining why you think it -should be. - -(L<perlapi> itself is generated by embed.pl, a Perl script that generates -significant portions of the Perl source code. It has a list of almost -all the functions defined by the Perl interpreter along with their calling -characteristics and some flags. Functions that are part of the public API -are marked with an 'A' in its flags.) +part of the API. (See L</Internal Functions>.) The easiest way to be B<sure> a +function is part of the API is to find its entry in L<perlapi>. +If it exists in L<perlapi>, it's part of the API. If it doesn't, and you +think it should be (i.e., you need it for your extension), send mail via +L<perlbug> explaining why you think it should be. Second problem: there must be a syntax so that the same subroutine declarations and calls can pass a structure as their first argument, @@ -1779,6 +1790,333 @@ The Perl engine/interpreter and the host are orthogonal entities. There could be one or more interpreters in a process, and one or more "hosts", with free association between them. +=head1 Internal Functions + +All of Perl's internal functions which will be exposed to the outside +world are be prefixed by C<Perl_> so that they will not conflict with XS +functions or functions used in a program in which Perl is embedded. +Similarly, all global variables begin with C<PL_>. (By convention, +static functions start with C<S_>) + +Inside the Perl core, you can get at the functions either with or +without the C<Perl_> prefix, thanks to a bunch of defines that live in +F<embed.h>. This header file is generated automatically from +F<embed.pl>. F<embed.pl> also creates the prototyping header files for +the internal functions, generates the documentation and a lot of other +bits and pieces. It's important that when you add a new function to the +core or change an existing one, you change the data in the table at the +end of F<embed.pl> as well. Here's a sample entry from that table: + + Apd |SV** |av_fetch |AV* ar|I32 key|I32 lval + +The second column is the return type, the third column the name. Columns +after that are the arguments. The first column is a set of flags: + +=over 3 + +=item A + +This function is a part of the public API. + +=item p + +This function has a C<Perl_> prefix; ie, it is defined as C<Perl_av_fetch> + +=item d + +This function has documentation using the C<apidoc> feature which we'll +look at in a second. + +=back + +Other available flags are: + +=over 3 + +=item s + +This is a static function and is defined as C<S_whatever>. + +=item n + +This does not use C<aTHX_> and C<pTHX> to pass interpreter context. (See +L<perlguts/Background and PERL_IMPLICIT_CONTEXT>.) + +=item r + +This function never returns; C<croak>, C<exit> and friends. + +=item f + +This function takes a variable number of arguments, C<printf> style. +The argument list should end with C<...>, like this: + + Afprd |void |croak |const char* pat|... + +=item m + +This function is part of the experimental development API, and may change +or disappear without notice. + +=item o + +This function should not have a compatibility macro to define, say, +C<Perl_parse> to C<parse>. It must be called as C<Perl_parse>. + +=item j + +This function is not a member of C<CPerlObj>. If you don't know +what this means, don't use it. + +=item x + +This function isn't exported out of the Perl core. + +=back + +If you edit F<embed.pl>, you will need to run C<make regen_headers> to +force a rebuild of F<embed.h> and other auto-generated files. + +=head2 Formatted Printing of IVs and UVs + +If you are printing IVs or UVs instead of the stdio(3) style formatting +codes like C<%d> you should use the following macros for portability + + IVdf IV in decimal + UVuf UV in decimal + UVof UV in octal + UVxf UV in hexadecimal + +For example: printf("IV is %"IVdf"\n", iv); That will expand +to whatever is the correct format for the IVs. + +=head2 Source Documentation + +There's an effort going on to document the internal functions and +automatically produce reference manuals from them - L<perlapi> is one +such manual which details all the functions which are available to XS +writers. L<perlintern> is the autogenerated manual for the functions +which are not part of the API and are supposedly for internal use only. + +Source documentation is created by putting POD comments into the C +source, like this: + + /* + =for apidoc sv_setiv + + Copies an integer into the given SV. Does not handle 'set' magic. See + C<sv_setiv_mg>. + + =cut + */ + +Please try and supply some documentation if you add functions to the +Perl core. + +=head1 Unicode Support + +Perl 5.6.0 introduced Unicode support. It's important for porters and XS +writers to understand this support and make sure that the code they +write does not corrupt Unicode data. + +=head2 What B<is> Unicode, anyway? + +In the olden, less enlightened times, we all used to use ASCII. Most of +us did, anyway. The big problem with ASCII is that it's American. Well, +no, that's not actually the problem; the problem is that it's not +particularly useful for people who don't use the Roman alphabet. What +used to happen was that particular languages would stick their own +alphabet in the upper range of the sequence, between 128 and 255. Of +course, we then ended up with plenty of variants that weren't quite +ASCII, and the whole point of it being a standard was lost. + +Worse still, if you've got a language like Chinese or +Japanese that has hundreds or thousands of characters, then you really +can't fit them into a mere 256, so they had to forget about ASCII +altogether, and build their own systems using pairs of numbers to refer +to one character. + +To fix this, some people formed Unicode, Inc. and +produced a new character set containing all the characters you can +possibly think of and more. There are several ways of representing these +characters, and the one Perl uses is called UTF8. UTF8 uses +a variable number of bytes to represent a character, instead of just +one. You can learn more about Unicode at +L<http://www.unicode.org/|http://www.unicode.org/> + +=head2 How can I recognise a UTF8 string? + +You can't. This is because UTF8 data is stored in bytes just like +non-UTF8 data. The Unicode character 200, (C<0xC8> for you hex types) +capital E with a grave accent, is represented by the two bytes +C<v196.172>. Unfortunately, the non-Unicode string C<chr(196).chr(172)> +has that byte sequence as well. So you can't tell just by looking - this +is what makes Unicode input an interesting problem. + +The API function C<is_utf8_string> can help; it'll tell you if a string +contains only valid UTF8 characters. However, it can't do the work for +you. On a character-by-character basis, C<is_utf8_char> will tell you +whether the current character in a string is valid UTF8. + +=head2 How does UTF8 represent Unicode characters? + +As mentioned above, UTF8 uses a variable number of bytes to store a +character. Characters with values 1...128 are stored in one byte, just +like good ol' ASCII. Character 129 is stored as C<v194.129>; this +contines up to character 191, which is C<v194.191>. Now we've run out of +bits (191 is binary C<10111111>) so we move on; 192 is C<v195.128>. And +so it goes on, moving to three bytes at character 2048. + +Assuming you know you're dealing with a UTF8 string, you can find out +how long the first character in it is with the C<UTF8SKIP> macro: + + char *utf = "\305\233\340\240\201"; + I32 len; + + len = UTF8SKIP(utf); /* len is 2 here */ + utf += len; + len = UTF8SKIP(utf); /* len is 3 here */ + +Another way to skip over characters in a UTF8 string is to use +C<utf8_hop>, which takes a string and a number of characters to skip +over. You're on your own about bounds checking, though, so don't use it +lightly. + +All bytes in a multi-byte UTF8 character will have the high bit set, so +you can test if you need to do something special with this character +like this: + + UV uv; + + if (utf & 0x80) + /* Must treat this as UTF8 */ + uv = utf8_to_uv(utf); + else + /* OK to treat this character as a byte */ + uv = *utf; + +You can also see in that example that we use C<utf8_to_uv> to get the +value of the character; the inverse function C<uv_to_utf8> is available +for putting a UV into UTF8: + + if (uv > 0x80) + /* Must treat this as UTF8 */ + utf8 = uv_to_utf8(utf8, uv); + else + /* OK to treat this character as a byte */ + *utf8++ = uv; + +You B<must> convert characters to UVs using the above functions if +you're ever in a situation where you have to match UTF8 and non-UTF8 +characters. You may not skip over UTF8 characters in this case. If you +do this, you'll lose the ability to match hi-bit non-UTF8 characters; +for instance, if your UTF8 string contains C<v196.172>, and you skip +that character, you can never match a C<chr(200)> in a non-UTF8 string. +So don't do that! + +=head2 How does Perl store UTF8 strings? + +Currently, Perl deals with Unicode strings and non-Unicode strings +slightly differently. If a string has been identified as being UTF-8 +encoded, Perl will set a flag in the SV, C<SVf_UTF8>. You can check and +manipulate this flag with the following macros: + + SvUTF8(sv) + SvUTF8_on(sv) + SvUTF8_off(sv) + +This flag has an important effect on Perl's treatment of the string: if +Unicode data is not properly distinguished, regular expressions, +C<length>, C<substr> and other string handling operations will have +undesirable results. + +The problem comes when you have, for instance, a string that isn't +flagged is UTF8, and contains a byte sequence that could be UTF8 - +especially when combining non-UTF8 and UTF8 strings. + +Never forget that the C<SVf_UTF8> flag is separate to the PV value; you +need be sure you don't accidentally knock it off while you're +manipulating SVs. More specifically, you cannot expect to do this: + + SV *sv; + SV *nsv; + STRLEN len; + char *p; + + p = SvPV(sv, len); + frobnicate(p); + nsv = newSVpvn(p, len); + +The C<char*> string does not tell you the whole story, and you can't +copy or reconstruct an SV just by copying the string value. Check if the +old SV has the UTF8 flag set, and act accordingly: + + p = SvPV(sv, len); + frobnicate(p); + nsv = newSVpvn(p, len); + if (SvUTF8(sv)) + SvUTF8_on(nsv); + +In fact, your C<frobnicate> function should be made aware of whether or +not it's dealing with UTF8 data, so that it can handle the string +appropriately. + +=head2 How do I convert a string to UTF8? + +If you're mixing UTF8 and non-UTF8 strings, you might find it necessary +to upgrade one of the strings to UTF8. If you've got an SV, the easiest +way to do this is: + + sv_utf8_upgrade(sv); + +However, you must not do this, for example: + + if (!SvUTF8(left)) + sv_utf8_upgrade(left); + +If you do this in a binary operator, you will actually change one of the +strings that came into the operator, and, while it shouldn't be noticable +by the end user, it can cause problems. + +Instead, C<bytes_to_utf8> will give you a UTF8-encoded B<copy> of its +string argument. This is useful for having the data available for +comparisons and so on, without harming the orginal SV. There's also +C<utf8_to_bytes> to go the other way, but naturally, this will fail if +the string contains any characters above 255 that can't be represented +in a single byte. + +=head2 Is there anything else I need to know? + +Not really. Just remember these things: + +=over 3 + +=item * + +There's no way to tell if a string is UTF8 or not. You can tell if an SV +is UTF8 by looking at is C<SvUTF8> flag. Don't forget to set the flag if +something should be UTF8. Treat the flag as part of the PV, even though +it's not - if you pass on the PV to somewhere, pass on the flag too. + +=item * + +If a string is UTF8, B<always> use C<utf8_to_uv> to get at the value, +unless C<!(*s & 0x80)> in which case you can use C<*s>. + +=item * + +When writing to a UTF8 string, B<always> use C<uv_to_utf8>, unless +C<uv < 0x80> in which case you can use C<*s = uv>. + +=item * + +Mixing UTF8 and non-UTF8 strings is tricky. Use C<bytes_to_utf8> to get +a new string which is UTF8 encoded. There are tricks you can use to +delay deciding whether you need to use a UTF8 string until you get to a +high character - C<HALF_UPGRADE> is one of those. + +=back + =head1 AUTHORS Until May 1997, this document was maintained by Jeff Okamoto diff --git a/pod/perlhack.pod b/pod/perlhack.pod index c640870264..4d2545d0e7 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -251,31 +251,6 @@ volunteers who test CPAN modules on a variety of platforms. Perl Labs platforms and gives feedback to the CPAN testers mailing list. Both efforts welcome volunteers. -To become an active and patching Perl porter, you'll need to learn how -Perl works on the inside. Chip Salzenberg, a pumpking, has written -articles on Perl internals for The Perl Journal -(I<http://www.tpj.com/>) which explain how various parts of the Perl -interpreter work. The C<perlguts> manpage explains the internal data -structures. And, of course, the C source code (sometimes sparsely -commented, sometimes commented well) is a great place to start (begin -with C<perl.c> and see where it goes from there). A lot of the style -of the Perl source is explained in the I<Porting/pumpkin.pod> file in -the source distribution. - -It is essential that you be comfortable using a good debugger -(e.g. gdb, dbx) before you can patch perl. Stepping through perl -as it executes a script is perhaps the best (if sometimes tedious) -way to gain a precise understanding of the overall architecture of -the language. - -If you build a version of the Perl interpreter with C<-DDEBUGGING>, -Perl's B<-D> command line flag will cause copious debugging information -to be emitted (see the C<perlrun> manpage). If you build a version of -Perl with compiler debugging information (e.g. with the C compiler's -C<-g> option instead of C<-O>) then you can step through the execution -of the interpreter with your favourite C symbolic debugger, setting -breakpoints on particular functions. - It's a good idea to read and lurk for a while before chipping in. That way you'll get to see the dynamic of the conversations, learn the personalities of the players, and hopefully be better prepared to make @@ -285,6 +260,1074 @@ If after all this you still think you want to join the perl5-porters mailing list, send mail to I<perl5-porters-subscribe@perl.org>. To unsubscribe, send mail to I<perl5-porters-unsubscribe@perl.org>. +To hack on the Perl guts, you'll need to read the following things: + +=over 3 + +=item L<perlguts> + +This is of paramount importance, since it's the documentation of what +goes where in the Perl source. Read it over a couple of times and it +might start to make sense - don't worry if it doesn't yet, because the +best way to study it is to read it in conjunction with poking at Perl +source, and we'll do that later on. + +You might also want to look at Gisle Aas's illustrated perlguts - +there's no guarantee that this will be absolutely up-to-date with the +latest documentation in the Perl core, but the fundamentals will be +right. (http://gisle.aas.no/perl/illguts/) + +=item L<perlxstut> and L<perlxs> + +A working knowledge of XSUB programming is incredibly useful for core +hacking; XSUBs use techniques drawn from the PP code, the portion of the +guts that actually executes a Perl program. It's a lot gentler to learn +those techniques from simple examples and explanation than from the core +itself. + +=item L<perlapi> + +The documentation for the Perl API explains what some of the internal +functions do, as well as the many macros used in the source. + +=item F<Porting/pumpkin.pod> + +This is a collection of words of wisdom for a Perl porter; some of it is +only useful to the pumpkin holder, but most of it applies to anyone +wanting to go about Perl development. + +=item The perl5-porters FAQ + +This is posted to perl5-porters at the beginning on every month, and +should be available from http://perlhacker.org/p5p-faq; alternatively, +you can get the FAQ emailed to you by sending mail to +C<perl5-porters-faq@perl.org>. It contains hints on reading +perl5-porters, information on how perl5-porters works and how Perl +development in general works. + +=back + +=head2 Finding Your Way Around + +Perl maintenance can be split into a number of areas, and certain people +(pumpkins) will have responsibility for each area. These areas sometimes +correspond to files or directories in the source kit. Among the areas are: + +=over 3 + +=item Core modules + +Modules shipped as part of the Perl core live in the F<lib/> and F<ext/> +subdirectories: F<lib/> is for the pure-Perl modules, and F<ext/> +contains the core XS modules. + +=item Documentation + +Documentation maintenance includes looking after everything in the +F<pod/> directory, (as well as contributing new documentation) and +the documentation to the modules in core. + +=item Configure + +The configure process is the way we make Perl portable across the +myriad of operating systems it supports. Responsibility for the +configure, build and installation process, as well as the overall +portability of the core code rests with the configure pumpkin - others +help out with individual operating systems. + +The files involved are the operating system directories, (F<win32/>, +F<os2/>, F<vms/> and so on) the shell scripts which generate F<config.h> +and F<Makefile>, as well as the metaconfig files which generate +F<Configure>. (metaconfig isn't included in the core distribution.) + +=item Interpreter + +And of course, there's the core of the Perl interpreter itself. Let's +have a look at that in a little more detail. + +=back + +Before we leave looking at the layout, though, don't forget that +F<MANIFEST> contains not only the file names in the Perl distribution, +but short descriptions of what's in them, too. For an overview of the +important files, try this: + + perl -lne 'print if /^[^\/]+\.[ch]\s+/' MANIFEST + +=head2 Elements of the interpreter + +The work of the interpreter has two main stages: compiling the code +into the internal representation, or bytecode, and then executing it. +L<perlguts/Compiled code> explains exactly how the compilation stage +happens. + +Here is a short breakdown of perl's operation: + +=over 3 + +=item Startup + +The action begins in F<perlmain.c>. (or F<miniperlmain.c> for miniperl) +This is very high-level code, enough to fit on a single screen, and it +resembles the code found in L<perlembed>; most of the real action takes +place in F<perl.c> + +First, F<perlmain.c> allocates some memory and constructs a Perl +interpreter: + + 1 PERL_SYS_INIT3(&argc,&argv,&env); + 2 + 3 if (!PL_do_undump) { + 4 my_perl = perl_alloc(); + 5 if (!my_perl) + 6 exit(1); + 7 perl_construct(my_perl); + 8 PL_perl_destruct_level = 0; + 9 } + +Line 1 is a macro, and its definition is dependent on your operating +system. Line 3 references C<PL_do_undump>, a global variable - all +global variables in Perl start with C<PL_>. This tells you whether the +current running program was created with the C<-u> flag to perl and then +F<undump>, which means it's going to be false in any sane context. + +Line 4 calls a function in F<perl.c> to allocate memory for a Perl +interpreter. It's quite a simple function, and the guts of it looks like +this: + + my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter)); + +Here you see an example of Perl's system abstraction, which we'll see +later: C<PerlMem_malloc> is either your system's C<malloc>, or Perl's +own C<malloc> as defined in F<malloc.c> if you selected that option at +configure time. + +Next, in line 7, we construct the interpreter; this sets up all the +special variables that Perl needs, the stacks, and so on. + +Now we pass Perl the command line options, and tell it to go: + + exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); + if (!exitstatus) { + exitstatus = perl_run(my_perl); + } + + +C<perl_parse> is actually a wrapper around C<S_parse_body>, as defined +in F<perl.c>, which processes the command line options, sets up any +statically linked XS modules, opens the program and calls C<yyparse> to +parse it. + +=item Parsing + +The aim of this stage is to take the Perl source, and turn it into an op +tree. We'll see what one of those looks like later. Strictly speaking, +there's three things going on here. + +C<yyparse>, the parser, lives in F<perly.c>, although you're better off +reading the original YACC input in F<perly.y>. (Yes, Virginia, there +B<is> a YACC grammar for Perl!) The job of the parser is to take your +code and `understand' it, splitting it into sentences, deciding which +operands go with which operators and so on. + +The parser is nobly assisted by the lexer, which chunks up your input +into tokens, and decides what type of thing each token is: a variable +name, an operator, a bareword, a subroutine, a core function, and so on. +The main point of entry to the lexer is C<yylex>, and that and its +associated routines can be found in F<toke.c>. Perl isn't much like +other computer languages; it's highly context sensitive at times, it can +be tricky to work out what sort of token something is, or where a token +ends. As such, there's a lot of interplay between the tokeniser and the +parser, which can get pretty frightening if you're not used to it. + +As the parser understands a Perl program, it builds up a tree of +operations for the interpreter to perform during execution. The routines +which construct and link together the various operations are to be found +in F<op.c>, and will be examined later. + +=item Optimization + +Now the parsing stage is complete, and the finished tree represents +the operations that the Perl interpreter needs to perform to execute our +program. Next, Perl does a dry run over the tree looking for +optimisations: constant expressions such as C<3 + 4> will be computed +now, and the optimizer will also see if any multiple operations can be +replaced with a single one. For instance, to fetch the variable C<$foo>, +instead of grabbing the glob C<*foo> and looking at the scalar +component, the optimizer fiddles the op tree to use a function which +directly looks up the scalar in question. The main optimizer is C<peep> +in F<op.c>, and many ops have their own optimizing functions. + +=item Running + +Now we're finally ready to go: we have compiled Perl byte code, and all +that's left to do is run it. The actual execution is done by the +C<runops_standard> function in F<run.c>; more specifically, it's done by +these three innocent looking lines: + + while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { + PERL_ASYNC_CHECK(); + } + +You may be more comfortable with the Perl version of that: + + PERL_ASYNC_CHECK() while $Perl::op = &{$Perl::op->{function}}; + +Well, maybe not. Anyway, each op contains a function pointer, which +stipulates the function which will actually carry out the operation. +This function will return the next op in the sequence - this allows for +things like C<if> which choose the next op dynamically at run time. +The C<PERL_ASYNC_CHECK> makes sure that things like signals interrupt +execution if required. + +The actual functions called are known as PP code, and they're spread +between four files: F<pp_hot.c> contains the `hot' code, which is most +often used and highly optimized, F<pp_sys.c> contains all the +system-specific functions, F<pp_ctl.c> contains the functions which +implement control structures (C<if>, C<while> and the like) and F<pp.c> +contains everything else. These are, if you like, the C code for Perl's +built-in functions and operators. + +=back + +=head2 Internal Variable Types + +You should by now have had a look at L<perlguts>, which tells you about +Perl's internal variable types: SVs, HVs, AVs and the rest. If not, do +that now. + +These variables are used not only to represent Perl-space variables, but +also any constants in the code, as well as some structures completely +internal to Perl. The symbol table, for instance, is an ordinary Perl +hash. Your code is represented by an SV as it's read into the parser; +any program files you call are opened via ordinary Perl filehandles, and +so on. + +The core L<Devel::Peek|Devel::Peek> module lets us examine SVs from a +Perl program. Let's see, for instance, how Perl treats the constant +C<"hello">. + + % perl -MDevel::Peek -e 'Dump("hello")' + 1 SV = PV(0xa041450) at 0xa04ecbc + 2 REFCNT = 1 + 3 FLAGS = (POK,READONLY,pPOK) + 4 PV = 0xa0484e0 "hello"\0 + 5 CUR = 5 + 6 LEN = 6 + +Reading C<Devel::Peek> output takes a bit of practise, so let's go +through it line by line. + +Line 1 tells us we're looking at an SV which lives at C<0xa04ecbc> in +memory. SVs themselves are very simple structures, but they contain a +pointer to a more complex structure. In this case, it's a PV, a +structure which holds a string value, at location C<0xa041450>. Line 2 +is the reference count; there are no other references to this data, so +it's 1. + +Line 3 are the flags for this SV - it's OK to use it as a PV, it's a +read-only SV (because it's a constant) and the data is a PV internally. +Next we've got the contents of the string, starting at location +C<0xa0484e0>. + +Line 5 gives us the current length of the string - note that this does +B<not> include the null terminator. Line 6 is not the length of the +string, but the length of the currently allocated buffer; as the string +grows, Perl automatically extends the available storage via a routine +called C<SvGROW>. + +You can get at any of these quantities from C very easily; just add +C<Sv> to the name of the field shown in the snippet, and you've got a +macro which will return the value: C<SvCUR(sv)> returns the current +length of the string, C<SvREFCOUNT(sv)> returns the reference count, +C<SvPV(sv, len)> returns the string itself with its length, and so on. +More macros to manipulate these properties can be found in L<perlguts>. + +Let's take an example of manipulating a PV, from C<sv_catpvn>, in F<sv.c> + + 1 void + 2 Perl_sv_catpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len) + 3 { + 4 STRLEN tlen; + 5 char *junk; + + 6 junk = SvPV_force(sv, tlen); + 7 SvGROW(sv, tlen + len + 1); + 8 if (ptr == junk) + 9 ptr = SvPVX(sv); + 10 Move(ptr,SvPVX(sv)+tlen,len,char); + 11 SvCUR(sv) += len; + 12 *SvEND(sv) = '\0'; + 13 (void)SvPOK_only_UTF8(sv); /* validate pointer */ + 14 SvTAINT(sv); + 15 } + +This is a function which adds a string, C<ptr>, of length C<len> onto +the end of the PV stored in C<sv>. The first thing we do in line 6 is +make sure that the SV B<has> a valid PV, by calling the C<SvPV_force> +macro to force a PV. As a side effect, C<tlen> gets set to the current +value of the PV, and the PV itself is returned to C<junk>. + +In line 7, we make sure that the SV will have enough room to accomodate +the old string, the new string and the null terminator. If C<LEN> isn't +big enough, C<SvGROW> will reallocate space for us. + +Now, if C<junk> is the same as the string we're trying to add, we can +grab the string directly from the SV; C<SvPVX> is the address of the PV +in the SV. + +Line 10 does the actual catenation: the C<Move> macro moves a chunk of +memory around: we move the string C<ptr> to the end of the PV - that's +the start of the PV plus its current length. We're moving C<len> bytes +of type C<char>. After doing so, we need to tell Perl we've extended the +string, by altering C<CUR> to reflect the new length. C<SvEND> is a +macro which gives us the end of the string, so that needs to be a +C<"\0">. + +Line 13 manipulates the flags; since we've changed the PV, any IV or NV +values will no longer be valid: if we have C<$a=10; $a.="6";> we don't +want to use the old IV of 10. C<SvPOK_only_utf8> is a special UTF8-aware +version of C<SvPOK_only>, a macro which turns off the IOK and NOK flags +and turns on POK. The final C<SvTAINT> is a macro which launders tainted +data if taint mode is turned on. + +AVs and HVs are more complicated, but SVs are by far the most common +variable type being thrown around. Having seen something of how we +manipulate these, let's go on and look at how the op tree is +constructed. + +=head2 Op Trees + +First, what is the op tree, anyway? The op tree is the parsed +representation of your program, as we saw in our section on parsing, and +it's the sequence of operations that Perl goes through to execute your +program, as we saw in L</Running>. + +An op is a fundamental operation that Perl can perform: all the built-in +functions and operators are ops, and there are a series of ops which +deal with concepts the interpreter needs internally - entering and +leaving a block, ending a statement, fetching a variable, and so on. + +The op tree is connected in two ways: you can imagine that there are two +"routes" through it, two orders in which you can traverse the tree. +First, parse order reflects how the parser understood the code, and +secondly, execution order tells perl what order to perform the +operations in. + +The easiest way to examine the op tree is to stop Perl after it has +finished parsing, and get it to dump out the tree. This is exactly what +the compiler backends L<B::Terse|B::Terse> and L<B::Debug|B::Debug> do. + +Let's have a look at how Perl sees C<$a = $b + $c>: + + % perl -MO=Terse -e '$a=$b+$c' + 1 LISTOP (0x8179888) leave + 2 OP (0x81798b0) enter + 3 COP (0x8179850) nextstate + 4 BINOP (0x8179828) sassign + 5 BINOP (0x8179800) add [1] + 6 UNOP (0x81796e0) null [15] + 7 SVOP (0x80fafe0) gvsv GV (0x80fa4cc) *b + 8 UNOP (0x81797e0) null [15] + 9 SVOP (0x8179700) gvsv GV (0x80efeb0) *c + 10 UNOP (0x816b4f0) null [15] + 11 SVOP (0x816dcf0) gvsv GV (0x80fa460) *a + +Let's start in the middle, at line 4. This is a BINOP, a binary +operator, which is at location C<0x8179828>. The specific operator in +question is C<sassign> - scalar assignment - and you can find the code +which implements it in the function C<pp_sassign> in F<pp_hot.c>. As a +binary operator, it has two children: the add operator, providing the +result of C<$b+$c>, is uppermost on line 5, and the left hand side is on +line 10. + +Line 10 is the null op: this does exactly nothing. What is that doing +there? If you see the null op, it's a sign that something has been +optimized away after parsing. As we mentioned in L</Optimization>, +the optimization stage sometimes converts two operations into one, for +example when fetching a scalar variable. When this happens, instead of +rewriting the op tree and cleaning up the dangling pointers, it's easier +just to replace the redundant operation with the null op. Originally, +the tree would have looked like this: + + 10 SVOP (0x816b4f0) rv2sv [15] + 11 SVOP (0x816dcf0) gv GV (0x80fa460) *a + +That is, fetch the C<a> entry from the main symbol table, and then look +at the scalar component of it: C<gvsv> (C<pp_gvsv> into F<pp_hot.c>) +happens to do both these things. + +The right hand side, starting at line 5 is similar to what we've just +seen: we have the C<add> op (C<pp_add> also in F<pp_hot.c>) add together +two C<gvsv>s. + +Now, what's this about? + + 1 LISTOP (0x8179888) leave + 2 OP (0x81798b0) enter + 3 COP (0x8179850) nextstate + +C<enter> and C<leave> are scoping ops, and their job is to perform any +housekeeping every time you enter and leave a block: lexical variables +are tidied up, unreferenced variables are destroyed, and so on. Every +program will have those first three lines: C<leave> is a list, and its +children are all the statements in the block. Statements are delimited +by C<nextstate>, so a block is a collection of C<nextstate> ops, with +the ops to be performed for each statement being the children of +C<nextstate>. C<enter> is a single op which functions as a marker. + +That's how Perl parsed the program, from top to bottom: + + Program + | + Statement + | + = + / \ + / \ + $a + + / \ + $b $c + +However, it's impossible to B<perform> the operations in this order: +you have to find the values of C<$b> and C<$c> before you add them +together, for instance. So, the other thread that runs through the op +tree is the execution order: each op has a field C<op_next> which points +to the next op to be run, so following these pointers tells us how perl +executes the code. We can traverse the tree in this order using +the C<exec> option to C<B::Terse>: + + % perl -MO=Terse,exec -e '$a=$b+$c' + 1 OP (0x8179928) enter + 2 COP (0x81798c8) nextstate + 3 SVOP (0x81796c8) gvsv GV (0x80fa4d4) *b + 4 SVOP (0x8179798) gvsv GV (0x80efeb0) *c + 5 BINOP (0x8179878) add [1] + 6 SVOP (0x816dd38) gvsv GV (0x80fa468) *a + 7 BINOP (0x81798a0) sassign + 8 LISTOP (0x8179900) leave + +This probably makes more sense for a human: enter a block, start a +statement. Get the values of C<$b> and C<$c>, and add them together. +Find C<$a>, and assign one to the other. Then leave. + +The way Perl builds up these op trees in the parsing process can be +unravelled by examining F<perly.y>, the YACC grammar. Let's take the +piece we need to construct the tree for C<$a = $b + $c> + + 1 term : term ASSIGNOP term + 2 { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); } + 3 | term ADDOP term + 4 { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } + +If you're not used to reading BNF grammars, this is how it works: You're +fed certain things by the tokeniser, which generally end up in upper +case. Here, C<ADDOP>, is provided when the tokeniser sees C<+> in your +code. C<ASSIGNOP> is provided when C<=> is used for assigning. These are +`terminal symbols', because you can't get any simpler than them. + +The grammar, lines one and three of the snippet above, tells you how to +build up more complex forms. These complex forms, `non-terminal symbols' +are generally placed in lower case. C<term> here is a non-terminal +symbol, representing a single expression. + +The grammar gives you the following rule: you can make the thing on the +left of the colon if you see all the things on the right in sequence. +This is called a "reduction", and the aim of parsing is to completely +reduce the input. There are several different ways you can perform a +reduction, separated by vertical bars: so, C<term> followed by C<=> +followed by C<term> makes a C<term>, and C<term> followed by C<+> +followed by C<term> can also make a C<term>. + +So, if you see two terms with an C<=> or C<+>, between them, you can +turn them into a single expression. When you do this, you execute the +code in the block on the next line: if you see C<=>, you'll do the code +in line 2. If you see C<+>, you'll do the code in line 4. It's this code +which contributes to the op tree. + + | term ADDOP term + { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } + +What this does is creates a new binary op, and feeds it a number of +variables. The variables refer to the tokens: C<$1> is the first token in +the input, C<$2> the second, and so on - think regular expression +backreferences. C<$$> is the op returned from this reduction. So, we +call C<newBINOP> to create a new binary operator. The first parameter to +C<newBINOP>, a function in F<op.c>, is the op type. It's an addition +operator, so we want the type to be C<ADDOP>. We could specify this +directly, but it's right there as the second token in the input, so we +use C<$2>. The second parameter is the op's flags: 0 means `nothing +special'. Then the things to add: the left and right hand side of our +expression, in scalar context. + +=head2 Stacks + +When perl executes something like C<addop>, how does it pass on its +results to the next op? The answer is, through the use of stacks. Perl +has a number of stacks to store things it's currently working on, and +we'll look at the three most important ones here. + +=over 3 + +=item Argument stack + +Arguments are passed to PP code and returned from PP code using the +argument stack, C<ST>. The typical way to handle arguments is to pop +them off the stack, deal with them how you wish, and then push the result +back onto the stack. This is how, for instance, the cosine operator +works: + + NV value; + value = POPn; + value = Perl_cos(value); + XPUSHn(value); + +We'll see a more tricky example of this when we consider Perl's macros +below. C<POPn> gives you the NV (floating point value) of the top SV on +the stack: the C<$x> in C<cos($x)>. Then we compute the cosine, and push +the result back as an NV. The C<X> in C<XPUSHn> means that the stack +should be extended if necessary - it can't be necessary here, because we +know there's room for one more item on the stack, since we've just +removed one! The C<XPUSH*> macros at least guarantee safety. + +Alternatively, you can fiddle with the stack directly: C<SP> gives you +the first element in your portion of the stack, and C<TOP*> gives you +the top SV/IV/NV/etc. on the stack. So, for instance, to do unary +negation of an integer: + + SETi(-TOPi); + +Just set the integer value of the top stack entry to its negation. + +Argument stack manipulation in the core is exactly the same as it is in +XSUBs - see L<perlxstut>, L<perlxs> and L<perlguts> for a longer +description of the macros used in stack manipulation. + +=item Mark stack + +I say `your portion of the stack' above because PP code doesn't +necessarily get the whole stack to itself: if your function calls +another function, you'll only want to expose the arguments aimed for the +called function, and not (necessarily) let it get at your own data. The +way we do this is to have a `virtual' bottom-of-stack, exposed to each +function. The mark stack keeps bookmarks to locations in the argument +stack usable by each function. For instance, when dealing with a tied +variable, (internally, something with `P' magic) Perl has to call +methods for accesses to the tied variables. However, we need to separate +the arguments exposed to the method to the argument exposed to the +original function - the store or fetch or whatever it may be. Here's how +the tied C<push> is implemented; see C<av_push> in F<av.c>: + + 1 PUSHMARK(SP); + 2 EXTEND(SP,2); + 3 PUSHs(SvTIED_obj((SV*)av, mg)); + 4 PUSHs(val); + 5 PUTBACK; + 6 ENTER; + 7 call_method("PUSH", G_SCALAR|G_DISCARD); + 8 LEAVE; + 9 POPSTACK; + +The lines which concern the mark stack are the first, fifth and last +lines: they save away, restore and remove the current position of the +argument stack. + +Let's examine the whole implementation, for practice: + + 1 PUSHMARK(SP); + +Push the current state of the stack pointer onto the mark stack. This is +so that when we've finished adding items to the argument stack, Perl +knows how many things we've added recently. + + 2 EXTEND(SP,2); + 3 PUSHs(SvTIED_obj((SV*)av, mg)); + 4 PUSHs(val); + +We're going to add two more items onto the argument stack: when you have +a tied array, the C<PUSH> subroutine receives the object and the value +to be pushed, and that's exactly what we have here - the tied object, +retrieved with C<SvTIED_obj>, and the value, the SV C<val>. + + 5 PUTBACK; + +Next we tell Perl to make the change to the global stack pointer: C<dSP> +only gave us a local copy, not a reference to the global. + + 6 ENTER; + 7 call_method("PUSH", G_SCALAR|G_DISCARD); + 8 LEAVE; + +C<ENTER> and C<LEAVE> localise a block of code - they make sure that all +variables are tidied up, everything that has been localised gets +its previous value returned, and so on. Think of them as the C<{> and +C<}> of a Perl block. + +To actually do the magic method call, we have to call a subroutine in +Perl space: C<call_method> takes care of that, and it's described in +L<perlcall>. We call the C<PUSH> method in scalar context, and we're +going to discard its return value. + + 9 POPSTACK; + +Finally, we remove the value we placed on the mark stack, since we +don't need it any more. + +=item Save stack + +C doesn't have a concept of local scope, so perl provides one. We've +seen that C<ENTER> and C<LEAVE> are used as scoping braces; the save +stack implements the C equivalent of, for example: + + { + local $foo = 42; + ... + } + +See L<perlguts/Localising Changes> for how to use the save stack. + +=back + +=head2 Millions of Macros + +One thing you'll notice about the Perl source is that it's full of +macros. Some have called the pervasive use of macros the hardest thing +to understand, others find it adds to clarity. Let's take an example, +the code which implements the addition operator: + + 1 PP(pp_add) + 2 { + 3 djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + 4 { + 5 dPOPTOPnnrl_ul; + 6 SETn( left + right ); + 7 RETURN; + 8 } + 9 } + +Every line here (apart from the braces, of course) contains a macro. The +first line sets up the function declaration as Perl expects for PP code; +line 3 sets up variable declarations for the argument stack and the +target, the return value of the operation. Finally, it tries to see if +the addition operation is overloaded; if so, the appropriate subroutine +is called. + +Line 5 is another variable declaration - all variable declarations start +with C<d> - which pops from the top of the argument stack two NVs (hence +C<nn>) and puts them into the variables C<right> and C<left>, hence the +C<rl>. These are the two operands to the addition operator. Next, we +call C<SETn> to set the NV of the return value to the result of adding +the two values. This done, we return - the C<RETURN> macro makes sure +that our return value is properly handled, and we pass the next operator +to run back to the main run loop. + +Most of these macros are explained in L<perlapi>, and some of the more +important ones are explained in L<perlxs> as well. Pay special attention +to L<perlguts/Background and PERL_IMPLICIT_CONTEXT> for information on +the C<[pad]THX_?> macros. + + +=head2 Poking at Perl + +To really poke around with Perl, you'll probably want to build Perl for +debugging, like this: + + ./Configure -d -D optimize=-g + make + +C<-g> is a flag to the C compiler to have it produce debugging +information which will allow us to step through a running program. +F<Configure> will also turn on the C<DEBUGGING> compilation symbol which +enables all the internal debugging code in Perl. There are a whole bunch +of things you can debug with this: L<perlrun> lists them all, and the +best way to find out about them is to play about with them. The most +useful options are probably + + l Context (loop) stack processing + t Trace execution + o Method and overloading resolution + c String/numeric conversions + +Some of the functionality of the debugging code can be achieved using XS +modules. + + -Dr => use re 'debug' + -Dx => use O 'Debug' + +=head2 Using a source-level debugger + +If the debugging output of C<-D> doesn't help you, it's time to step +through perl's execution with a source-level debugger. + +=over 3 + +=item * + +We'll use C<gdb> for our examples here; the principles will apply to any +debugger, but check the manual of the one you're using. + +=back + +To fire up the debugger, type + + gdb ./perl + +You'll want to do that in your Perl source tree so the debugger can read +the source code. You should see the copyright message, followed by the +prompt. + + (gdb) + +C<help> will get you into the documentation, but here are the most +useful commands: + +=over 3 + +=item run [args] + +Run the program with the given arguments. + +=item break function_name + +=item break source.c:xxx + +Tells the debugger that we'll want to pause execution when we reach +either the named function (but see L</Function names>!) or the given +line in the named source file. + +=item step + +Steps through the program a line at a time. + +=item next + +Steps through the program a line at a time, without descending into +functions. + +=item continue + +Run until the next breakpoint. + +=item finish + +Run until the end of the current function, then stop again. + +=item + +Just pressing Enter will do the most recent operation again - it's a +blessing when stepping through miles of source code. + +=item print + +Execute the given C code and print its results. B<WARNING>: Perl makes +heavy use of macros, and F<gdb> is not aware of macros. You'll have to +substitute them yourself. So, for instance, you can't say + + print SvPV_nolen(sv) + +but you have to say + + print Perl_sv_2pv_nolen(sv) + +You may find it helpful to have a "macro dictionary", which you can +produce by saying C<cpp -dM perl.c | sort>. Even then, F<cpp> won't +recursively apply the macros for you. + +=back + +=head2 Dumping Perl Data Structures + +One way to get around this macro hell is to use the dumping functions in +F<dump.c>; these work a little like an internal +L<Devel::Peek|Devel::Peek>, but they also cover OPs and other structures +that you can't get at from Perl. Let's take an example. We'll use the +C<$a = $b + $c> we used before, but give it a bit of context: +C<$b = "6XXXX"; $c = 2.3;>. Where's a good place to stop and poke around? + +What about C<pp_add>, the function we examined earlier to implement the +C<+> operator: + + (gdb) break Perl_pp_add + Breakpoint 1 at 0x46249f: file pp_hot.c, line 309. + +Notice we use C<Perl_pp_add> and not C<pp_add> - see L<perlguts/Function Names>. +With the breakpoint in place, we can run our program: + + (gdb) run -e '$b = "6XXXX"; $c = 2.3; $a = $b + $c' + +Lots of junk will go past as gdb reads in the relevant source files and +libraries, and then: + + Breakpoint 1, Perl_pp_add () at pp_hot.c:309 + 309 djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + (gdb) step + 311 dPOPTOPnnrl_ul; + (gdb) + +We looked at this bit of code before, and we said that C<dPOPTOPnnrl_ul> +arranges for two C<NV>s to be placed into C<left> and C<right> - let's +slightly expand it: + + #define dPOPTOPnnrl_ul NV right = POPn; \ + SV *leftsv = TOPs; \ + NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0 + +C<POPn> takes the SV from the top of the stack and obtains its NV either +directly (if C<SvNOK> is set) or by calling the C<sv_2nv> function. +C<TOPs> takes the next SV from the top of the stack - yes, C<POPn> uses +C<TOPs> - but doesn't remove it. We then use C<SvNV> to get the NV from +C<leftsv> in the same way as before - yes, C<POPn> uses C<SvNV>. + +Since we don't have an NV for C<$b>, we'll have to use C<sv_2nv> to +convert it. If we step again, we'll find ourselves there: + + Perl_sv_2nv (sv=0xa0675d0) at sv.c:1669 + 1669 if (!sv) + (gdb) + +We can now use C<Perl_sv_dump> to investigate the SV: + + SV = PV(0xa057cc0) at 0xa0675d0 + REFCNT = 1 + FLAGS = (POK,pPOK) + PV = 0xa06a510 "6XXXX"\0 + CUR = 5 + LEN = 6 + $1 = void + +We know we're going to get C<6> from this, so let's finish the +subroutine: + + (gdb) finish + Run till exit from #0 Perl_sv_2nv (sv=0xa0675d0) at sv.c:1671 + 0x462669 in Perl_pp_add () at pp_hot.c:311 + 311 dPOPTOPnnrl_ul; + +We can also dump out this op: the current op is always stored in +C<PL_op>, and we can dump it with C<Perl_op_dump>. This'll give us +similar output to L<B::Debug|B::Debug>. + + { + 13 TYPE = add ===> 14 + TARG = 1 + FLAGS = (SCALAR,KIDS) + { + TYPE = null ===> (12) + (was rv2sv) + FLAGS = (SCALAR,KIDS) + { + 11 TYPE = gvsv ===> 12 + FLAGS = (SCALAR) + GV = main::b + } + } + +< finish this later > + +=head2 Patching + +All right, we've now had a look at how to navigate the Perl sources and +some things you'll need to know when fiddling with them. Let's now get +on and create a simple patch. Here's something Larry suggested: if a +C<U> is the first active format during a C<pack>, (for example, +C<pack "U3C8", @stuff>) then the resulting string should be treated as +UTF8 encoded. + +How do we prepare to fix this up? First we locate the code in question - +the C<pack> happens at runtime, so it's going to be in one of the F<pp> +files. Sure enough, C<pp_pack> is in F<pp.c>. Since we're going to be +altering this file, let's copy it to F<pp.c~>. + +Now let's look over C<pp_pack>: we take a pattern into C<pat>, and then +loop over the pattern, taking each format character in turn into +C<datum_type>. Then for each possible format character, we swallow up +the other arguments in the pattern (a field width, an asterisk, and so +on) and convert the next chunk input into the specified format, adding +it onto the output SV C<cat>. + +How do we know if the C<U> is the first format in the C<pat>? Well, if +we have a pointer to the start of C<pat> then, if we see a C<U> we can +test whether we're still at the start of the string. So, here's where +C<pat> is set up: + + STRLEN fromlen; + register char *pat = SvPVx(*++MARK, fromlen); + register char *patend = pat + fromlen; + register I32 len; + I32 datumtype; + SV *fromstr; + +We'll have another string pointer in there: + + STRLEN fromlen; + register char *pat = SvPVx(*++MARK, fromlen); + register char *patend = pat + fromlen; + + char *patcopy; + register I32 len; + I32 datumtype; + SV *fromstr; + +And just before we start the loop, we'll set C<patcopy> to be the start +of C<pat>: + + items = SP - MARK; + MARK++; + sv_setpvn(cat, "", 0); + + patcopy = pat; + while (pat < patend) { + +Now if we see a C<U> which was at the start of the string, we turn on +the UTF8 flag for the output SV, C<cat>: + + + if (datumtype == 'U' && pat==patcopy+1) + + SvUTF8_on(cat); + if (datumtype == '#') { + while (pat < patend && *pat != '\n') + pat++; + +Remember that it has to be C<patcopy+1> because the first character of +the string is the C<U> which has been swallowed into C<datumtype!> + +Oops, we forgot one thing: what if there are spaces at the start of the +pattern? C<pack(" U*", @stuff)> will have C<U> as the first active +character, even though it's not the first thing in the pattern. In this +case, we have to advance C<patcopy> along with C<pat> when we see spaces: + + if (isSPACE(datumtype)) + continue; + +needs to become + + if (isSPACE(datumtype)) { + patcopy++; + continue; + } + +OK. That's the C part done. Now we must do two additional things before +this patch is ready to go: we've changed the behaviour of Perl, and so +we must document that change. We must also provide some more regression +tests to make sure our patch works and doesn't create a bug somewhere +else along the line. + +The regression tests for each operator live in F<t/op/>, and so we make +a copy of F<t/op/pack.t> to F<t/op/pack.t~>. Now we can add our tests +to the end. First, we'll test that the C<U> does indeed create Unicode +strings: + + print 'not ' unless "1.20.300.4000" eq sprintf "%vd", pack("U*",1,20,300,4000); + print "ok $test\n"; $test++; + +Now we'll test that we got that space-at-the-beginning business right: + + print 'not ' unless "1.20.300.4000" eq + sprintf "%vd", pack(" U*",1,20,300,4000); + print "ok $test\n"; $test++; + +And finally we'll test that we don't make Unicode strings if C<U> is B<not> +the first active format: + + print 'not ' unless v1.20.300.4000 ne + sprintf "%vd", pack("C0U*",1,20,300,4000); + print "ok $test\n"; $test++; + +Musn't forget to change the number of tests which appears at the top, or +else the automated tester will get confused: + + -print "1..156\n"; + +print "1..159\n"; + +We now compile up Perl, and run it through the test suite. Our new +tests pass, hooray! + +Finally, the documentation. The job is never done until the paperwork is +over, so let's describe the change we've just made. The relevant place +is F<pod/perlfunc.pod>; again, we make a copy, and then we'll insert +this text in the description of C<pack>: + + =item * + + If the pattern begins with a C<U>, the resulting string will be treated + as Unicode-encoded. You can force UTF8 encoding on in a string with an + initial C<U0>, and the bytes that follow will be interpreted as Unicode + characters. If you don't want this to happen, you can begin your pattern + with C<C0> (or anything else) to force Perl not to UTF8 encode your + string, and then follow this with a C<U*> somewhere in your pattern. + +All done. Now let's create the patch. F<Porting/patching.pod> tells us +that if we're making major changes, we should copy the entire directory +to somewhere safe before we begin fiddling, and then do + + diff -ruN old new > patch + +However, we know which files we've changed, and we can simply do this: + + diff -u pp.c~ pp.c > patch + diff -u t/op/pack.t~ t/op/pack.t >> patch + diff -u pod/perlfunc.pod~ pod/perlfunc.pod >> patch + +We end up with a patch looking a little like this: + + --- pp.c~ Fri Jun 02 04:34:10 2000 + +++ pp.c Fri Jun 16 11:37:25 2000 + @@ -4375,6 +4375,7 @@ + register I32 items; + STRLEN fromlen; + register char *pat = SvPVx(*++MARK, fromlen); + + char *patcopy; + register char *patend = pat + fromlen; + register I32 len; + I32 datumtype; + @@ -4405,6 +4406,7 @@ + ... + +And finally, we submit it, with our rationale, to perl5-porters. Job +done! + +=head2 CONCLUSION + +We've had a brief look around the Perl source, an overview of the stages +F<perl> goes through when it's running your code, and how to use a +debugger to poke at the Perl guts. Finally, we took a very simple +problem and demonstrated how to solve it fully - with documentation, +regression tests, and finally a patch for submission to p5p. + +I'd now suggest you read over those references again, and then, as soon +as possible, get your hands dirty. The best way to learn is by doing, +so: + +=over 3 + +=item * + +Subscribe to perl5-porters, follow the patches and try and understand +them; don't be afraid to ask if there's a portion you're not clear on - +who knows, you may unearth a bug in the patch... + +=item * + +Keep up to date with the bleeding edge Perl distributions and get +familiar with the changes. Try and get an idea of what areas people are +working on and the changes they're making. + +=item * + +Find an area of Perl that seems interesting to you, and see if you can +work out how it works. Scan through the source, and step over it in the +debugger. Play, poke, investigate, fiddle! You'll probably get to +understand not just your chosen area but a much wider range of F<perl>'s +activity as well, and probably sooner than you'd think. + +=back + +=over 3 + +=item I<The Road goes ever on and on, down from the door where it began.> + +=back + +If you can do these things, you've started on the long road to Perl porting. +Thanks for wanting to help make Perl better - and happy hacking! + =head1 AUTHOR This document was written by Nathan Torkington, and is maintained by diff --git a/pod/perlintern.pod b/pod/perlintern.pod index b0aab33e2b..8afabd90f0 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -12,6 +12,21 @@ B<they are not for use in extensions>! =over 8 +=item is_gv_magical + +Returns C<TRUE> if given the name of a magical GV. + +Currently only useful internally when determining if a GV should be +created even in rvalue contexts. + +C<flags> is not used at present but available for future extension to +allow selecting particular classes of magical variable. + + bool is_gv_magical(char *name, STRLEN len, U32 flags) + +=for hackers +Found in file gv.c + =back =head1 AUTHORS diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 475271d071..6467a295e3 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -234,8 +234,7 @@ prepared to clean up core dumps now and again. To forbid signal handlers altogether would bars you from many interesting programs, including virtually everything in this manpage, -since you could no longer even write SIGCHLD handlers. Their dodginess -is expected to be addresses in the 5.005 release. +since you could no longer even write SIGCHLD handlers. =head1 Using open() for IPC @@ -837,7 +836,7 @@ domain sockets can show up in the file system with an ls(1) listing. You can test for these with Perl's B<-S> file test: unless ( -S '/dev/log' ) { - die "something's wicked with the print system"; + die "something's wicked with the log system"; } Here's a sample Unix-domain client: diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 55ccf441fd..a257e380c0 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -449,7 +449,7 @@ if you "use locale". a A b B c C d D e E a b c d e A B C D E -Here is a code snippet to tell what alphanumeric +Here is a code snippet to tell what "word" characters are in the current locale, in that locale's order: use locale; @@ -518,8 +518,9 @@ results, and so always obey the current C<LC_COLLATE> locale. In the scope of S<C<use locale>>, Perl obeys the C<LC_CTYPE> locale setting. This controls the application's notion of which characters are alphabetic. This affects Perl's C<\w> regular expression metanotation, -which stands for alphanumeric characters--that is, alphabetic and -numeric characters. (Consult L<perlre> for more information about +which stands for alphanumeric characters--that is, alphabetic, +numeric, and including other special characters such as the underscore or +hyphen. (Consult L<perlre> for more information about regular expressions.) Thanks to C<LC_CTYPE>, depending on your locale setting, characters like 'E<aelig>', 'E<eth>', 'E<szlig>', and 'E<oslash>' may be understood as C<\w> characters. @@ -953,37 +954,12 @@ operating system upgrade. =head1 SEE ALSO -L<POSIX (3)/isalnum> - -L<POSIX (3)/isalpha> - -L<POSIX (3)/isdigit> - -L<POSIX (3)/isgraph> - -L<POSIX (3)/islower> - -L<POSIX (3)/isprint>, - -L<POSIX (3)/ispunct> - -L<POSIX (3)/isspace> - -L<POSIX (3)/isupper>, - -L<POSIX (3)/isxdigit> - -L<POSIX (3)/localeconv> - -L<POSIX (3)/setlocale>, - -L<POSIX (3)/strcoll> - -L<POSIX (3)/strftime> - -L<POSIX (3)/strtod>, - -L<POSIX (3)/strxfrm> +L<POSIX (3)/isalnum>, L<POSIX (3)/isalpha>, L<POSIX (3)/isdigit>, +L<POSIX (3)/isgraph>, L<POSIX (3)/islower>, L<POSIX (3)/isprint>, +L<POSIX (3)/ispunct>, L<POSIX (3)/isspace>, L<POSIX (3)/isupper>, +L<POSIX (3)/isxdigit>, L<POSIX (3)/localeconv>, L<POSIX (3)/setlocale>, +L<POSIX (3)/strcoll>, L<POSIX (3)/strftime>, L<POSIX (3)/strtod>, +L<POSIX (3)/strxfrm>. =head1 HISTORY diff --git a/pod/perlmodlib.PL b/pod/perlmodlib.PL new file mode 100644 index 0000000000..a594d729e4 --- /dev/null +++ b/pod/perlmodlib.PL @@ -0,0 +1,822 @@ +#!../miniperl + +open (OUT, ">perlmodlib.tmp") or die $!; +my (@pragma, @mod); +open (MANIFEST, "../MANIFEST") or die $!; + +while (<MANIFEST>) { + my $filename; + next unless s|^lib/|| or m|^ext/|; + ($filename) = /(\S+)/; + $filename =~ s|^[^/]+/|| if $filename =~ s|^ext/||; + next unless $filename =~ /\.pm$/; + next unless open (MOD, "../lib/$filename"); + my ($name, $thing); + my $foundit=0; + {local $/=""; + while (<MOD>) { + next unless /^=head1 NAME/; + $foundit++; + last; + } + } + next unless $foundit; + my $title = <MOD>; + chomp($title); + close MOD; + + my $perlname = $filename; + $perlname =~ s|\.pm$||; + $perlname =~ s|/|::|g; + + ($name, $thing) = split / - /, $title,2; + next unless $name and $thing; + $thing=~s/^perl pragma to //i; + $thing=ucfirst($thing); + $title = "=item $perlname\n\n$thing\n\n"; + + if ($filename=~/[A-Z]/) { + push @mod, $title; + } else { + push @pragma, $title; + } +} + +print OUT <<'EOF'; +=head1 NAME + +perlmodlib - constructing new Perl modules and finding existing ones + +=head1 DESCRIPTION + +=head1 THE PERL MODULE LIBRARY + +Many modules are included the Perl distribution. These are described +below, and all end in F<.pm>. You may discover compiled library +file (usually ending in F<.so>) or small pieces of modules to be +autoloaded (ending in F<.al>); these were automatically generated +by the installation process. You may also discover files in the +library directory that end in either F<.pl> or F<.ph>. These are +old libraries supplied so that old programs that use them still +run. The F<.pl> files will all eventually be converted into standard +modules, and the F<.ph> files made by B<h2ph> will probably end up +as extension modules made by B<h2xs>. (Some F<.ph> values may +already be available through the POSIX, Errno, or Fcntl modules.) +The B<pl2pm> file in the distribution may help in your conversion, +but it's just a mechanical process and therefore far from bulletproof. + +=head2 Pragmatic Modules + +They work somewhat like compiler directives (pragmata) in that they +tend to affect the compilation of your program, and thus will usually +work well only when used within a C<use>, or C<no>. Most of these +are lexically scoped, so an inner BLOCK may countermand them +by saying: + + no integer; + no strict 'refs'; + no warnings; + +which lasts until the end of that BLOCK. + +Some pragmas are lexically scoped--typically those that affect the +C<$^H> hints variable. Others affect the current package instead, +like C<use vars> and C<use subs>, which allow you to predeclare a +variables or subroutines within a particular I<file> rather than +just a block. Such declarations are effective for the entire file +for which they were declared. You cannot rescind them with C<no +vars> or C<no subs>. + +The following pragmas are defined (and have their own documentation). + +=over 12 + +EOF + +print OUT $_ for (sort @pragma); + +print OUT <<EOF; +=back + +=head2 Standard Modules + +Standard, bundled modules are all expected to behave in a well-defined +manner with respect to namespace pollution because they use the +Exporter module. See their own documentation for details. + +=over 12 + +EOF + +print OUT $_ for (sort @mod); + +print OUT <<'EOF'; +=back + +To find out I<all> modules installed on your system, including +those without documentation or outside the standard release, +jus tdo this: + + % find `perl -e 'print "@INC"'` -name '*.pm' -print + +They should all have their own documentation installed and accessible +via your system man(1) command. If you do not have a B<find> +program, you can use the Perl B<find2perl> program instead, which +generates Perl code as output you can run through perl. If you +have a B<man> program but it doesn't find your modules, you'll have +to fix your manpath. See L<perl> for details. If you have no +system B<man> command, you might try the B<perldoc> program. + +=head2 Extension Modules + +Extension modules are written in C (or a mix of Perl and C). They +are usually dynamically loaded into Perl if and when you need them, +but may also be be linked in statically. Supported extension modules +include Socket, Fcntl, and POSIX. + +Many popular C extension modules do not come bundled (at least, not +completely) due to their sizes, volatility, or simply lack of time +for adequate testing and configuration across the multitude of +platforms on which Perl was beta-tested. You are encouraged to +look for them on CPAN (described below), or using web search engines +like Alta Vista or Deja News. + +=head1 CPAN + +CPAN stands for Comprehensive Perl Archive Network; it's a globally +replicated trove of Perl materials, including documentation, style +guides, tricks and traps, alternate ports to non-Unix systems and +occasional binary distributions for these. Search engines for +CPAN can be found at http://cpan.perl.com/ and at +http://theory.uwinnipeg.ca/mod_perl/cpan-search.pl . + +Most importantly, CPAN includes around a thousand unbundled modules, +some of which require a C compiler to build. Major categories of +modules are: + +=over + +=item * +Language Extensions and Documentation Tools + +=item * +Development Support + +=item * +Operating System Interfaces + +=item * +Networking, Device Control (modems) and InterProcess Communication + +=item * +Data Types and Data Type Utilities + +=item * +Database Interfaces + +=item * +User Interfaces + +=item * +Interfaces to / Emulations of Other Programming Languages + +=item * +File Names, File Systems and File Locking (see also File Handles) + +=item * +String Processing, Language Text Processing, Parsing, and Searching + +=item * +Option, Argument, Parameter, and Configuration File Processing + +=item * +Internationalization and Locale + +=item * +Authentication, Security, and Encryption + +=item * +World Wide Web, HTML, HTTP, CGI, MIME + +=item * +Server and Daemon Utilities + +=item * +Archiving and Compression + +=item * +Images, Pixmap and Bitmap Manipulation, Drawing, and Graphing + +=item * +Mail and Usenet News + +=item * +Control Flow Utilities (callbacks and exceptions etc) + +=item * +File Handle and Input/Output Stream Utilities + +=item * +Miscellaneous Modules + +=back + +Registered CPAN sites as of this writing include the following. +You should try to choose one close to you: + +=over + +=item Africa + + South Africa ftp://ftp.is.co.za/programming/perl/CPAN/ + ftp://ftp.saix.net/pub/CPAN/ + ftp://ftp.sun.ac.za/CPAN/ + ftp://ftpza.co.za/pub/mirrors/cpan/ + + +=item Asia + + China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/ + Hong Kong ftp://ftp.pacific.net.hk/pub/mirror/CPAN/ + Indonesia ftp://malone.piksi.itb.ac.id/pub/CPAN/ + Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/ + Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/ + ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/ + ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/ + ftp://ftp.meisei-u.ac.jp/pub/CPAN/ + ftp://ftp.ring.gr.jp/pub/lang/perl/CPAN/ + ftp://mirror.nucba.ac.jp/mirror/Perl/ + Saudi-Arabia ftp://ftp.isu.net.sa/pub/CPAN/ + Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/ + South Korea ftp://ftp.bora.net/pub/CPAN/ + ftp://ftp.kornet.net/pub/CPAN/ + ftp://ftp.nuri.net/pub/CPAN/ + Taiwan ftp://coda.nctu.edu.tw/computer-languages/perl/CPAN/ + ftp://ftp.ee.ncku.edu.tw/pub3/perl/CPAN/ + ftp://ftp1.sinica.edu.tw/pub1/perl/CPAN/ + Thailand ftp://ftp.nectec.or.th/pub/mirrors/CPAN/ + + +=item Australasia + + Australia ftp://cpan.topend.com.au/pub/CPAN/ + ftp://ftp.labyrinth.net.au/pub/perl-CPAN/ + ftp://ftp.sage-au.org.au/pub/compilers/perl/CPAN/ + ftp://mirror.aarnet.edu.au/pub/perl/CPAN/ + New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/ + ftp://sunsite.net.nz/pub/languages/perl/CPAN/ + + +=item Central America + + Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/ + + +=item Europe + + Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/ + Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/ + Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/ + Croatia ftp://ftp.linux.hr/pub/CPAN/ + Czech Republic ftp://ftp.fi.muni.cz/pub/perl/ + ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/ + Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/ + Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/ + Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/ + France ftp://ftp.grolier.fr/pub/perl/CPAN/ + ftp://ftp.lip6.fr/pub/perl/CPAN/ + ftp://ftp.oleane.net/pub/mirrors/CPAN/ + ftp://ftp.pasteur.fr/pub/computing/CPAN/ + ftp://ftp.uvsq.fr/pub/perl/CPAN/ + German ftp://ftp.gigabell.net/pub/CPAN/ + Germany ftp://ftp.archive.de.uu.net/pub/CPAN/ + ftp://ftp.freenet.de/pub/ftp.cpan.org/pub/ + ftp://ftp.gmd.de/packages/CPAN/ + ftp://ftp.gwdg.de/pub/languages/perl/CPAN/ + +ftp://ftp.leo.org/pub/comp/general/programming/languages/script/perl/CPAN/ + ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/ + ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/ + ftp://ftp.uni-erlangen.de/pub/source/CPAN/ + ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/ + Germany ftp://ftp.archive.de.uu.net/pub/CPAN/ + ftp://ftp.freenet.de/pub/ftp.cpan.org/pub/ + ftp://ftp.gmd.de/packages/CPAN/ + ftp://ftp.gwdg.de/pub/languages/perl/CPAN/ + +ftp://ftp.leo.org/pub/comp/general/programming/languages/script/perl/CPAN/ + ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/ + ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/ + ftp://ftp.uni-erlangen.de/pub/source/CPAN/ + ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/ + Greece ftp://ftp.ntua.gr/pub/lang/perl/ + Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/ + Iceland ftp://ftp.gm.is/pub/CPAN/ + Ireland ftp://cpan.indigo.ie/pub/CPAN/ + ftp://sunsite.compapp.dcu.ie/pub/perl/ + Italy ftp://cis.uniRoma2.it/CPAN/ + ftp://ftp.flashnet.it/pub/CPAN/ + ftp://ftp.unina.it/pub/Other/CPAN/ + ftp://ftp.unipi.it/pub/mirror/perl/CPAN/ + Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/ + ftp://ftp.nluug.nl/pub/languages/perl/CPAN/ + Norway ftp://ftp.uit.no/pub/languages/perl/cpan/ + ftp://sunsite.uio.no/pub/languages/perl/CPAN/ + Poland ftp://ftp.man.torun.pl/pub/CPAN/ + ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/ + ftp://sunsite.icm.edu.pl/pub/CPAN/ + Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/ + ftp://ftp.ist.utl.pt/pub/CPAN/ + ftp://ftp.ua.pt/pub/CPAN/ + Romania ftp://ftp.dnttm.ro/pub/CPAN/ + Russia ftp://ftp.chg.ru/pub/lang/perl/CPAN/ + ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/ + Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/ + Slovenia ftp://ftp.arnes.si/software/perl/CPAN/ + Spain ftp://ftp.etse.urv.es/pub/perl/ + ftp://ftp.rediris.es/mirror/CPAN/ + Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/ + Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/ + Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/ + United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/ + ftp://ftp.flirble.org/pub/languages/perl/CPAN/ + +ftp://ftp.mirror.ac.uk/sites/ftp.funet.fi/pub/languages/perl/CPAN/ + ftp://ftp.plig.org/pub/CPAN/ + ftp://sunsite.doc.ic.ac.uk/packages/CPAN/ + + +=item North America + + Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/ + California ftp://cpan.nas.nasa.gov/pub/perl/CPAN/ + ftp://cpan.valueclick.com/CPAN/ + ftp://ftp.cdrom.com/pub/perl/CPAN/ + http://download.sourceforge.net/mirrors/CPAN/ + Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ + Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/ + Georgia ftp://ftp.twoguys.org/CPAN/ + Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/ + Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/ + ftp://ftp.uwsg.indiana.edu/pub/perl/CPAN/ + Kentucky ftp://ftp.uky.edu/CPAN/ + Manitoba ftp://theoryx5.uwinnipeg.ca/pub/CPAN/ + Massachusetts +ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/ + ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/ + Mexico ftp://ftp.msg.com.mx/pub/CPAN/ + New York ftp://ftp.deao.net/pub/CPAN/ + ftp://ftp.rge.com/pub/languages/perl/ + North Carolina ftp://ftp.duke.edu/pub/perl/ + Nova Scotia ftp://cpan.chebucto.ns.ca/pub/CPAN/ + Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/ + Ontario ftp://ftp.crc.ca/pub/packages/lang/perl/CPAN/ + Oregon ftp://ftp.orst.edu/pub/packages/CPAN/ + Pennsylvania ftp://ftp.epix.net/pub/languages/perl/ + Tennessee ftp://ftp.sunsite.utk.edu/pub/CPAN/ + Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/ + ftp://jhcloos.com/pub/mirror/CPAN/ + Utah ftp://mirror.xmission.com/CPAN/ + Virginia ftp://ftp.perl.org/pub/perl/CPAN/ + ftp://ruff.cs.jmu.edu/pub/CPAN/ + Washington ftp://ftp-mirror.internap.com/pub/CPAN/ + ftp://ftp.llarian.net/pub/CPAN/ + ftp://ftp.spu.edu/pub/CPAN/ + + +=item South America + + Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/ + ftp://ftp.matrix.com.br/pub/perl/ + Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/PERL/ + +=back + +For an up-to-date listing of CPAN sites, +see http://www.perl.com/perl/CPAN/SITES or ftp://www.perl.com/CPAN/SITES . + +=head1 Modules: Creation, Use, and Abuse + +(The following section is borrowed directly from Tim Bunce's modules +file, available at your nearest CPAN site.) + +Perl implements a class using a package, but the presence of a +package doesn't imply the presence of a class. A package is just a +namespace. A class is a package that provides subroutines that can be +used as methods. A method is just a subroutine that expects, as its +first argument, either the name of a package (for "static" methods), +or a reference to something (for "virtual" methods). + +A module is a file that (by convention) provides a class of the same +name (sans the .pm), plus an import method in that class that can be +called to fetch exported symbols. This module may implement some of +its methods by loading dynamic C or C++ objects, but that should be +totally transparent to the user of the module. Likewise, the module +might set up an AUTOLOAD function to slurp in subroutine definitions on +demand, but this is also transparent. Only the F<.pm> file is required to +exist. See L<perlsub>, L<perltoot>, and L<AutoLoader> for details about +the AUTOLOAD mechanism. + +=head2 Guidelines for Module Creation + +=over 4 + +=item Do similar modules already exist in some form? + +If so, please try to reuse the existing modules either in whole or +by inheriting useful features into a new class. If this is not +practical try to get together with the module authors to work on +extending or enhancing the functionality of the existing modules. +A perfect example is the plethora of packages in perl4 for dealing +with command line options. + +If you are writing a module to expand an already existing set of +modules, please coordinate with the author of the package. It +helps if you follow the same naming scheme and module interaction +scheme as the original author. + +=item Try to design the new module to be easy to extend and reuse. + +Try to C<use warnings;> (or C<use warnings qw(...);>). +Remember that you can add C<no warnings qw(...);> to individual blocks +of code that need less warnings. + +Use blessed references. Use the two argument form of bless to bless +into the class name given as the first parameter of the constructor, +e.g.,: + + sub new { + my $class = shift; + return bless {}, $class; + } + +or even this if you'd like it to be used as either a static +or a virtual method. + + sub new { + my $self = shift; + my $class = ref($self) || $self; + return bless {}, $class; + } + +Pass arrays as references so more parameters can be added later +(it's also faster). Convert functions into methods where +appropriate. Split large methods into smaller more flexible ones. +Inherit methods from other modules if appropriate. + +Avoid class name tests like: C<die "Invalid" unless ref $ref eq 'FOO'>. +Generally you can delete the C<eq 'FOO'> part with no harm at all. +Let the objects look after themselves! Generally, avoid hard-wired +class names as far as possible. + +Avoid C<< $r->Class::func() >> where using C<@ISA=qw(... Class ...)> and +C<< $r->func() >> would work (see L<perlbot> for more details). + +Use autosplit so little used or newly added functions won't be a +burden to programs that don't use them. Add test functions to +the module after __END__ either using AutoSplit or by saying: + + eval join('',<main::DATA>) || die $@ unless caller(); + +Does your module pass the 'empty subclass' test? If you say +C<@SUBCLASS::ISA = qw(YOURCLASS);> your applications should be able +to use SUBCLASS in exactly the same way as YOURCLASS. For example, +does your application still work if you change: C<$obj = new YOURCLASS;> +into: C<$obj = new SUBCLASS;> ? + +Avoid keeping any state information in your packages. It makes it +difficult for multiple other packages to use yours. Keep state +information in objects. + +Always use B<-w>. + +Try to C<use strict;> (or C<use strict qw(...);>). +Remember that you can add C<no strict qw(...);> to individual blocks +of code that need less strictness. + +Always use B<-w>. + +Follow the guidelines in the perlstyle(1) manual. + +Always use B<-w>. + +=item Some simple style guidelines + +The perlstyle manual supplied with Perl has many helpful points. + +Coding style is a matter of personal taste. Many people evolve their +style over several years as they learn what helps them write and +maintain good code. Here's one set of assorted suggestions that +seem to be widely used by experienced developers: + +Use underscores to separate words. It is generally easier to read +$var_names_like_this than $VarNamesLikeThis, especially for +non-native speakers of English. It's also a simple rule that works +consistently with VAR_NAMES_LIKE_THIS. + +Package/Module names are an exception to this rule. Perl informally +reserves lowercase module names for 'pragma' modules like integer +and strict. Other modules normally begin with a capital letter and +use mixed case with no underscores (need to be short and portable). + +You may find it helpful to use letter case to indicate the scope +or nature of a variable. For example: + + $ALL_CAPS_HERE constants only (beware clashes with Perl vars) + $Some_Caps_Here package-wide global/static + $no_caps_here function scope my() or local() variables + +Function and method names seem to work best as all lowercase. +e.g., C<< $obj->as_string() >>. + +You can use a leading underscore to indicate that a variable or +function should not be used outside the package that defined it. + +=item Select what to export. + +Do NOT export method names! + +Do NOT export anything else by default without a good reason! + +Exports pollute the namespace of the module user. If you must +export try to use @EXPORT_OK in preference to @EXPORT and avoid +short or common names to reduce the risk of name clashes. + +Generally anything not exported is still accessible from outside the +module using the ModuleName::item_name (or C<< $blessed_ref->method >>) +syntax. By convention you can use a leading underscore on names to +indicate informally that they are 'internal' and not for public use. + +(It is actually possible to get private functions by saying: +C<my $subref = sub { ... }; &$subref;>. But there's no way to call that +directly as a method, because a method must have a name in the symbol +table.) + +As a general rule, if the module is trying to be object oriented +then export nothing. If it's just a collection of functions then +@EXPORT_OK anything but use @EXPORT with caution. + +=item Select a name for the module. + +This name should be as descriptive, accurate, and complete as +possible. Avoid any risk of ambiguity. Always try to use two or +more whole words. Generally the name should reflect what is special +about what the module does rather than how it does it. Please use +nested module names to group informally or categorize a module. +There should be a very good reason for a module not to have a nested name. +Module names should begin with a capital letter. + +Having 57 modules all called Sort will not make life easy for anyone +(though having 23 called Sort::Quick is only marginally better :-). +Imagine someone trying to install your module alongside many others. +If in any doubt ask for suggestions in comp.lang.perl.misc. + +If you are developing a suite of related modules/classes it's good +practice to use nested classes with a common prefix as this will +avoid namespace clashes. For example: Xyz::Control, Xyz::View, +Xyz::Model etc. Use the modules in this list as a naming guide. + +If adding a new module to a set, follow the original author's +standards for naming modules and the interface to methods in +those modules. + +To be portable each component of a module name should be limited to +11 characters. If it might be used on MS-DOS then try to ensure each is +unique in the first 8 characters. Nested modules make this easier. + +=item Have you got it right? + +How do you know that you've made the right decisions? Have you +picked an interface design that will cause problems later? Have +you picked the most appropriate name? Do you have any questions? + +The best way to know for sure, and pick up many helpful suggestions, +is to ask someone who knows. Comp.lang.perl.misc is read by just about +all the people who develop modules and it's the best place to ask. + +All you need to do is post a short summary of the module, its +purpose and interfaces. A few lines on each of the main methods is +probably enough. (If you post the whole module it might be ignored +by busy people - generally the very people you want to read it!) + +Don't worry about posting if you can't say when the module will be +ready - just say so in the message. It might be worth inviting +others to help you, they may be able to complete it for you! + +=item README and other Additional Files. + +It's well known that software developers usually fully document the +software they write. If, however, the world is in urgent need of +your software and there is not enough time to write the full +documentation please at least provide a README file containing: + +=over 10 + +=item * +A description of the module/package/extension etc. + +=item * +A copyright notice - see below. + +=item * +Prerequisites - what else you may need to have. + +=item * +How to build it - possible changes to Makefile.PL etc. + +=item * +How to install it. + +=item * +Recent changes in this release, especially incompatibilities + +=item * +Changes / enhancements you plan to make in the future. + +=back + +If the README file seems to be getting too large you may wish to +split out some of the sections into separate files: INSTALL, +Copying, ToDo etc. + +=over 4 + +=item Adding a Copyright Notice. + +How you choose to license your work is a personal decision. +The general mechanism is to assert your Copyright and then make +a declaration of how others may copy/use/modify your work. + +Perl, for example, is supplied with two types of licence: The GNU +GPL and The Artistic Licence (see the files README, Copying, and +Artistic). Larry has good reasons for NOT just using the GNU GPL. + +My personal recommendation, out of respect for Larry, Perl, and the +Perl community at large is to state something simply like: + + Copyright (c) 1995 Your Name. All rights reserved. + This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + +This statement should at least appear in the README file. You may +also wish to include it in a Copying file and your source files. +Remember to include the other words in addition to the Copyright. + +=item Give the module a version/issue/release number. + +To be fully compatible with the Exporter and MakeMaker modules you +should store your module's version number in a non-my package +variable called $VERSION. This should be a floating point +number with at least two digits after the decimal (i.e., hundredths, +e.g, C<$VERSION = "0.01">). Don't use a "1.3.2" style version. +See L<Exporter> for details. + +It may be handy to add a function or method to retrieve the number. +Use the number in announcements and archive file names when +releasing the module (ModuleName-1.02.tar.Z). +See perldoc ExtUtils::MakeMaker.pm for details. + +=item How to release and distribute a module. + +It's good idea to post an announcement of the availability of your +module (or the module itself if small) to the comp.lang.perl.announce +Usenet newsgroup. This will at least ensure very wide once-off +distribution. + +If possible, register the module with CPAN. You should +include details of its location in your announcement. + +Some notes about ftp archives: Please use a long descriptive file +name that includes the version number. Most incoming directories +will not be readable/listable, i.e., you won't be able to see your +file after uploading it. Remember to send your email notification +message as soon as possible after uploading else your file may get +deleted automatically. Allow time for the file to be processed +and/or check the file has been processed before announcing its +location. + +FTP Archives for Perl Modules: + +Follow the instructions and links on: + + http://www.perl.com/CPAN/modules/00modlist.long.html + http://www.perl.com/CPAN/modules/04pause.html + +or upload to one of these sites: + + https://pause.kbx.de/pause/ + http://pause.perl.org/pause/ + +and notify <modules@perl.org>. + +By using the WWW interface you can ask the Upload Server to mirror +your modules from your ftp or WWW site into your own directory on +CPAN! + +Please remember to send me an updated entry for the Module list! + +=item Take care when changing a released module. + +Always strive to remain compatible with previous released versions. +Otherwise try to add a mechanism to revert to the +old behavior if people rely on it. Document incompatible changes. + +=back + +=back + +=head2 Guidelines for Converting Perl 4 Library Scripts into Modules + +=over 4 + +=item There is no requirement to convert anything. + +If it ain't broke, don't fix it! Perl 4 library scripts should +continue to work with no problems. You may need to make some minor +changes (like escaping non-array @'s in double quoted strings) but +there is no need to convert a .pl file into a Module for just that. + +=item Consider the implications. + +All Perl applications that make use of the script will need to +be changed (slightly) if the script is converted into a module. Is +it worth it unless you plan to make other changes at the same time? + +=item Make the most of the opportunity. + +If you are going to convert the script to a module you can use the +opportunity to redesign the interface. The guidelines for module +creation above include many of the issues you should consider. + +=item The pl2pm utility will get you started. + +This utility will read *.pl files (given as parameters) and write +corresponding *.pm files. The pl2pm utilities does the following: + +=over 10 + +=item * +Adds the standard Module prologue lines + +=item * +Converts package specifiers from ' to :: + +=item * +Converts die(...) to croak(...) + +=item * +Several other minor changes + +=back + +Being a mechanical process pl2pm is not bullet proof. The converted +code will need careful checking, especially any package statements. +Don't delete the original .pl file till the new .pm one works! + +=back + +=head2 Guidelines for Reusing Application Code + +=over 4 + +=item Complete applications rarely belong in the Perl Module Library. + +=item Many applications contain some Perl code that could be reused. + +Help save the world! Share your code in a form that makes it easy +to reuse. + +=item Break-out the reusable code into one or more separate module files. + +=item Take the opportunity to reconsider and redesign the interfaces. + +=item In some cases the 'application' can then be reduced to a small + +fragment of code built on top of the reusable modules. In these cases +the application could invoked as: + + % perl -e 'use Module::Name; method(@ARGV)' ... +or + % perl -mModule::Name ... (in perl5.002 or higher) + +=back + +=head1 NOTE + +Perl does not enforce private and public parts of its modules as you may +have been used to in other languages like C++, Ada, or Modula-17. Perl +doesn't have an infatuation with enforced privacy. It would prefer +that you stayed out of its living room because you weren't invited, not +because it has a shotgun. + +The module and its user have a contract, part of which is common law, +and part of which is "written". Part of the common law contract is +that a module doesn't pollute any namespace it wasn't asked to. The +written contract for the module (A.K.A. documentation) may make other +provisions. But then you know when you C<use RedefineTheWorld> that +you're redefining the world and willing to take the consequences. +EOF + +close MANIFEST or warn "$0: failed to close MANIFEST (../MANIFEST): $!"; +close OUT or warn "$0: failed to close OUT (perlmodlib.tmp): $!"; + diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index 164cb643f7..1c5808058e 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -66,9 +66,9 @@ Establish IS-A relationship with base class at compile time Use MakeMaker's uninstalled version of a package -=item caller +=item bytes -Inherit pragmatic attributes from caller's context +Force byte semantics rather than character semantics =item charnames @@ -80,15 +80,15 @@ Declare constants =item diagnostics -Force verbose warning diagnostics +Perl compiler pragma to force verbose warning diagnostics =item fields -Declare a class's attribute fields at compile-time +Compile-time class fields =item filetest -Control the filetest operators like C<-r>, C<-w> for AFS, etc. +Control the filetest permission operators =item integer @@ -96,7 +96,7 @@ Compute arithmetic in integer instead of double =item less -Request less of something from the compiler (unimplemented) +Request less of something from the compiler =item lib @@ -104,7 +104,11 @@ Manipulate @INC at compile time =item locale -Use or avoid POSIX locales for built-in operations +Use and avoid POSIX locales for built-in operations + +=item open + +Set default disciplines for input and output =item ops @@ -112,11 +116,11 @@ Restrict unsafe operations when compiling =item overload -Overload Perl operations +Package for overloading perl operations =item re -Alter regular expression behavior +Alter regular expression behaviour =item sigtrap @@ -128,15 +132,15 @@ Restrict unsafe constructs =item subs -Predeclare subroutine names +Predeclare sub names =item utf8 -Turn on UTF-8 and Unicode support +Enable/disable UTF-8 in source code =item vars -Predeclare global variable names (obsoleted by our()) +Predeclare global variable names (obsolete) =item warnings @@ -154,7 +158,7 @@ Exporter module. See their own documentation for details. =item AnyDBM_File -Provide framework for multiple DBM libraries +Provide framework for multiple DBMs =item AutoLoader @@ -166,7 +170,7 @@ Split a package for autoloading =item B -Guts of the Perl code generator (aka compiler) +The Perl Compiler =item B::Asmdata @@ -198,7 +202,7 @@ Walk Perl syntax tree, printing debug info about ops =item B::Deparse -Perl compiler backend to produce Perl code +Perl compiler backend to produce perl code =item B::Disassembler @@ -206,7 +210,7 @@ Disassemble Perl bytecode =item B::Lint -Module to catch dubious constructs +Perl lint =item B::Showlex @@ -216,8 +220,6 @@ Show lexical variables used in functions or files Helper module for CC backend -B::Stash -- XXX NFI XXX - =item B::Terse Walk Perl syntax tree, printing terse info about ops @@ -228,19 +230,19 @@ Generates cross reference reports for Perl programs =item Benchmark -Benchmark running times of code +Benchmark running times of Perl code =item ByteLoader -Load byte-compiled Perl code +Load byte compiled perl code =item CGI -Simple Common Gateway Interface class +Simple Common Gateway Interface Class =item CGI::Apache -Make things work with CGI.pm against Perl-Apache API +Backward compatibility module for CGI.pm =item CGI::Carp @@ -264,15 +266,15 @@ Simple Interface to Server Push =item CGI::Switch -Try more than one constructors and return the first object available +Backward compatibility module for defunct CGI::Switch =item CPAN -Query, download, and build Perl modules from CPAN sites +Query, download and build perl modules from CPAN sites =item CPAN::FirstTime -Utility for CPAN::Config file initialization +Utility for CPAN::Config file Initialization =item CPAN::Nox @@ -280,7 +282,7 @@ Wrapper around CPAN.pm without using any XS module =item Carp -Act like warn/die from perspective of caller +Warn of errors (from perspective of caller) =item Carp::Heavy @@ -290,34 +292,18 @@ Carp guts Declare struct-like datatypes as Perl classes -=item Config - -Access Perl configuration information - =item Cwd Get pathname of current working directory =item DB -Programmatic interface to the Perl debugging API (experimental) +Programmatic interface to the Perl debugging API (draft, subject to =item DB_File Perl5 access to Berkeley DB version 1.x -=item Data::Dumper - -Serialize Perl data structures - -=item Devel::DProf - -A Perl execution profiler - -=item Devel::Peek - -A data debugging tool for the XS programmer - =item Devel::SelfStubber Generate stubs for a SelfLoading module @@ -328,27 +314,19 @@ Supply object methods for directory handles =item Dumpvalue -Provide screen dump of Perl data - -=item DynaLoader - -Dynamically load C libraries into Perl code +Provides screen dump of Perl data. =item English -Use English (or awk) names for ugly punctuation variables +Use nice English (or awk) names for ugly punctuation variables =item Env -Access environment variables as regular ones - -=item Errno - -Load the libc errno.h defines +Perl module that imports environment variables as scalars or arrays =item Exporter -Implement default import method for modules +Implements default import method for modules =item Exporter::Heavy @@ -356,11 +334,11 @@ Exporter guts =item ExtUtils::Command -Utilities to replace common Unix commands in Makefiles etc. +Utilities to replace common UNIX commands in Makefiles etc. =item ExtUtils::Embed -Utilities for embedding Perl in C/C++ programs +Utilities for embedding Perl in C/C++ applications =item ExtUtils::Install @@ -376,11 +354,11 @@ Determine libraries to use and how to use them =item ExtUtils::MM_Cygwin -Methods to override Unix behavior in ExtUtils::MakeMaker +Methods to override UN*X behaviour in ExtUtils::MakeMaker =item ExtUtils::MM_OS2 -Methods to override Unix behavior in ExtUtils::MakeMaker +Methods to override UN*X behaviour in ExtUtils::MakeMaker =item ExtUtils::MM_Unix @@ -388,11 +366,11 @@ Methods used by ExtUtils::MakeMaker =item ExtUtils::MM_VMS -Methods to override Unix behavior in ExtUtils::MakeMaker +Methods to override UN*X behaviour in ExtUtils::MakeMaker =item ExtUtils::MM_Win32 -Methods to override Unix behavior in ExtUtils::MakeMaker +Methods to override UN*X behaviour in ExtUtils::MakeMaker =item ExtUtils::MakeMaker @@ -402,8 +380,6 @@ Create an extension Makefile Utilities to write and check a MANIFEST file -ExtUtils::Miniperl, writemain - Write the C code for perlmain.c - =item ExtUtils::Mkbootstrap Make a bootstrap file for use by DynaLoader @@ -426,7 +402,7 @@ Replace functions with equivalents which succeed or die =item Fcntl -Load the libc fcntl.h defines +Load the C Fcntl.h defines =item File::Basename @@ -446,19 +422,15 @@ Copy files or filehandles =item File::DosGlob -DOS-like globbing and then some +DOS like globbing and then some =item File::Find -Traverse a file tree - -=item File::Glob - -Perl extension for BSD filename globbing +Traverse a file tree =item File::Path -Create or remove a series of directories +Create or remove directory trees =item File::Spec @@ -488,6 +460,10 @@ Methods for VMS file specs Methods for Win32 file specs +=item File::Temp + +Return name and handle of a temporary file safely + =item File::stat By-name interface to Perl's built-in stat() functions @@ -502,11 +478,7 @@ Supply object methods for filehandles =item FindBin -Locate installation directory of running Perl program - -=item GDBM_File - -Access to the gdbm library +Locate directory of original perl script =item Getopt::Long @@ -518,55 +490,11 @@ Process single-character switches with switch clustering =item I18N::Collate -Compare 8-bit scalar data according to current locale +Compare 8-bit scalar data according to the current locale =item IO -Front-end to load various IO modules - -=item IO::Dir - -Supply object methods for directory handles - -=item IO::File - -Supply object methods for filehandles - -=item IO::Handle - -Supply object methods for I/O handles - -=item IO::Pipe - -Supply object methods for pipes - -=item IO::Poll - -Object interface to system poll call - -=item IO::Seekable - -Supply seek based methods for I/O objects - -=item IO::Select - -OO interface to the select system call - -=item IO::Socket - -Object interface to socket communications - -=item IO::Socket::INET - -Object interface for AF_INET domain sockets - -=item IO::Socket::UNIX - -Object interface for AF_UNIX domain sockets - -=item IPC::Msg - -SysV Msg IPC object class +Load various IO modules =item IPC::Open2 @@ -576,14 +504,6 @@ Open a process for both reading and writing Open a process for reading, writing, and error handling -=item IPC::Semaphore - -SysV Semaphore IPC object class - -=item IPC::SysV - -SysV IPC constants - =item Math::BigFloat Arbitrary length float math package @@ -600,6 +520,10 @@ Complex numbers and associated mathematical functions Trigonometric functions +=item NDBM_File + +Tied access to ndbm files + =item Net::Ping Check a remote host for reachability @@ -624,34 +548,46 @@ By-name interface to Perl's built-in getserv*() functions Generic interface to Perl Compiler backends -=item Opcode +=item ODBM_File -Disable named opcodes when compiling Perl code +Tied access to odbm files -=item POSIX +=item Opcode -Perl interface to IEEE Std 1003.1 +Disable named opcodes when compiling perl code =item Pod::Checker Check pod documents for syntax errors +=item Pod::Find + +Find POD documents in directory trees + =item Pod::Html Module to convert pod files to HTML =item Pod::InputObjects -Manage POD objects +Objects representing POD input paragraphs, commands, etc. =item Pod::Man Convert POD data to formatted *roff input +=item Pod::ParseUtils + +Helpers for POD parsing and conversion + =item Pod::Parser Base class for creating POD filters and translators +=item Pod::Plainer + +Perl extension for converting Pod to old style Pod. + =item Pod::Select Extract selected sections of POD from input @@ -664,6 +600,10 @@ Convert POD data to formatted ASCII text Convert POD data to formatted color ASCII text +=item Pod::Text::Termcap + +Convert POD data to ASCII text with format escapes + =item Pod::Usage Print a usage message from embedded pod documentation @@ -690,35 +630,31 @@ Load functions only on demand =item Shell -Run shell commands transparently within Perl +Run shell commands transparently within perl =item Socket -Load the libc socket.h defines and structure manipulators +Load the C socket.h defines and structure manipulators =item Symbol Manipulate Perl symbols and their names -=item Sys::Hostname - -Try every conceivable way to get hostname +=item Term::ANSIColor -=item Sys::Syslog - -Interface to the libc syslog(3) calls +Color screen output using ANSI escape sequences =item Term::Cap -Termcap interface +Perl termcap interface =item Term::Complete -Word completion module +Perl word completion module =item Term::ReadLine -Interface to various `readline' packages. +Perl interface to various C<readline> packages. If =item Test @@ -726,7 +662,7 @@ Provides a simple framework for writing test scripts =item Test::Harness -Run Perl standard test scripts with statistics +Run perl standard test scripts with statistics =item Text::Abbrev @@ -734,13 +670,11 @@ Create an abbreviation table from a list =item Text::ParseWords -Parse text into a list of tokens or array of arrays +Parse text into an array of tokens or array of arrays =item Text::Soundex -Implementation of the Soundex Algorithm as described by Knuth - -Text::Tabs -- expand and unexpand tabs per expand(1) and unexpand(1) +Implementation of the Soundex Algorithm as Described by Knuth =item Text::Wrap @@ -801,29 +735,24 @@ By-name interface to Perl's built-in getpw*() functions =back To find out I<all> modules installed on your system, including -those without documentation or outside the standard release, -just do this: +those without documentation or outside the standard release, +jus tdo this: % find `perl -e 'print "@INC"'` -name '*.pm' -print -To get a log of all module distributions which have been installed -since perl was installed, just do: - - % perldoc perllocal - -Modules should all have their own documentation installed and accessible -via your system man(1) command, or via the C<perldoc> program. If you do -not have a B<find> +They should all have their own documentation installed and accessible +via your system man(1) command. If you do not have a B<find> program, you can use the Perl B<find2perl> program instead, which generates Perl code as output you can run through perl. If you have a B<man> program but it doesn't find your modules, you'll have -to fix your manpath. See L<perl> for details. +to fix your manpath. See L<perl> for details. If you have no +system B<man> command, you might try the B<perldoc> program. =head2 Extension Modules Extension modules are written in C (or a mix of Perl and C). They are usually dynamically loaded into Perl if and when you need them, -but may also be linked in statically. Supported extension modules +but may also be be linked in statically. Supported extension modules include Socket, Fcntl, and POSIX. Many popular C extension modules do not come bundled (at least, not @@ -837,7 +766,7 @@ like Alta Vista or Deja News. CPAN stands for Comprehensive Perl Archive Network; it's a globally replicated trove of Perl materials, including documentation, style -guides, tricks and trap, alternate ports to non-Unix systems and +guides, tricks and traps, alternate ports to non-Unix systems and occasional binary distributions for these. Search engines for CPAN can be found at http://cpan.perl.com/ and at http://theory.uwinnipeg.ca/mod_perl/cpan-search.pl . @@ -985,7 +914,8 @@ You should try to choose one close to you: ftp://ftp.freenet.de/pub/ftp.cpan.org/pub/ ftp://ftp.gmd.de/packages/CPAN/ ftp://ftp.gwdg.de/pub/languages/perl/CPAN/ - ftp://ftp.leo.org/pub/comp/general/programming/languages/script/perl/CPAN/ + +ftp://ftp.leo.org/pub/comp/general/programming/languages/script/perl/CPAN/ ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/ ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/ ftp://ftp.uni-erlangen.de/pub/source/CPAN/ @@ -994,7 +924,8 @@ You should try to choose one close to you: ftp://ftp.freenet.de/pub/ftp.cpan.org/pub/ ftp://ftp.gmd.de/packages/CPAN/ ftp://ftp.gwdg.de/pub/languages/perl/CPAN/ - ftp://ftp.leo.org/pub/comp/general/programming/languages/script/perl/CPAN/ + +ftp://ftp.leo.org/pub/comp/general/programming/languages/script/perl/CPAN/ ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/ ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/ ftp://ftp.uni-erlangen.de/pub/source/CPAN/ @@ -1030,7 +961,8 @@ You should try to choose one close to you: Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/ United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/ ftp://ftp.flirble.org/pub/languages/perl/CPAN/ - ftp://ftp.mirror.ac.uk/sites/ftp.funet.fi/pub/languages/perl/CPAN/ + +ftp://ftp.mirror.ac.uk/sites/ftp.funet.fi/pub/languages/perl/CPAN/ ftp://ftp.plig.org/pub/CPAN/ ftp://sunsite.doc.ic.ac.uk/packages/CPAN/ @@ -1050,7 +982,8 @@ You should try to choose one close to you: ftp://ftp.uwsg.indiana.edu/pub/perl/CPAN/ Kentucky ftp://ftp.uky.edu/CPAN/ Manitoba ftp://theoryx5.uwinnipeg.ca/pub/CPAN/ - Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/ + Massachusetts +ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/ ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/ Mexico ftp://ftp.msg.com.mx/pub/CPAN/ New York ftp://ftp.deao.net/pub/CPAN/ @@ -1102,7 +1035,7 @@ its methods by loading dynamic C or C++ objects, but that should be totally transparent to the user of the module. Likewise, the module might set up an AUTOLOAD function to slurp in subroutine definitions on demand, but this is also transparent. Only the F<.pm> file is required to -exist. See L<perlsub>, L<perltoot>, and L<AutoLoader> for details about +exist. See L<perlsub>, L<perltoot>, and L<AutoLoader> for details about the AUTOLOAD mechanism. =head2 Guidelines for Module Creation @@ -1127,24 +1060,24 @@ scheme as the original author. Try to C<use warnings;> (or C<use warnings qw(...);>). Remember that you can add C<no warnings qw(...);> to individual blocks -of code that need less warnings. +of code that need less warnings. Use blessed references. Use the two argument form of bless to bless into the class name given as the first parameter of the constructor, e.g.,: sub new { - my $class = shift; - return bless {}, $class; + my $class = shift; + return bless {}, $class; } or even this if you'd like it to be used as either a static or a virtual method. sub new { - my $self = shift; - my $class = ref($self) || $self; - return bless {}, $class; + my $self = shift; + my $class = ref($self) || $self; + return bless {}, $class; } Pass arrays as references so more parameters can be added later @@ -1176,13 +1109,13 @@ Avoid keeping any state information in your packages. It makes it difficult for multiple other packages to use yours. Keep state information in objects. -Always use B<-w>. +Always use B<-w>. Try to C<use strict;> (or C<use strict qw(...);>). Remember that you can add C<no strict qw(...);> to individual blocks -of code that need less strictness. +of code that need less strictness. -Always use B<-w>. +Always use B<-w>. Follow the guidelines in the perlstyle(1) manual. @@ -1371,7 +1304,7 @@ module (or the module itself if small) to the comp.lang.perl.announce Usenet newsgroup. This will at least ensure very wide once-off distribution. -If possible, register the module with CPAN. You should +If possible, register the module with CPAN. You should include details of its location in your announcement. Some notes about ftp archives: Please use a long descriptive file diff --git a/pod/perlnewmod.pod b/pod/perlnewmod.pod new file mode 100644 index 0000000000..1e4a9c3b29 --- /dev/null +++ b/pod/perlnewmod.pod @@ -0,0 +1,282 @@ +=head1 NAME + +perlnewmod - preparing a new module for distribution + +=head1 DESCRIPTION + +This document gives you some suggestions about how to go about writing +Perl modules, preparing them for distribution, and making them available +via CPAN. + +One of the things that makes Perl really powerful is the fact that Perl +hackers tend to want to share the solutions to problems they've faced, +so you and I don't have to battle with the same problem again. + +The main way they do this is by abstracting the solution into a Perl +module. If you don't know what one of these is, the rest of this +document isn't going to be much use to you. You're also missing out on +an awful lot of useful code; consider having a look at L<perlmod>, +L<perlmodlib> and L<perlmodinstall> before coming back here. + +When you've found that there isn't a module available for what you're +trying to do, and you've had to write the code yourself, consider +packaging up the solution into a module and uploading it to CPAN so that +others can benefit. + +=head2 Warning + +We're going to primarily concentrate on Perl-only modules here, rather +than XS modules. XS modules serve a rather different purpose, and +you should consider different things before distributing them - the +popularity of the library you are gluing, the portability to other +operating systems, and so on. However, the notes on preparing the Perl +side of the module and packaging and distributing it will apply equally +well to an XS module as a pure-Perl one. + +=head2 What should I make into a module? + +You should make a module out of any code that you think is going to be +useful to others. Anything that's likely to fill a hole in the communal +library and which someone else can slot directly into their program. Any +part of your code which you can isolate and extract and plug into +something else is a likely candidate. + +Let's take an example. Suppose you're reading in data from a local +format into a hash-of-hashes in Perl, turning that into a tree, walking +the tree and then piping each node to an Acme Transmogrifier Server. + +Now, quite a few people have the Acme Transmogrifier, and you've had to +write something to talk the protocol from scratch - you'd almost +certainly want to make that into a module. The level at which you pitch +it is up to you: you might want protocol-level modules analogous to +L<Net::SMTP|Net::SMTP> which then talk to higher level modules analogous +to L<Mail::Send|Mail::Send>. The choice is yours, but you do want to get +a module out for that server protocol. + +Nobody else on the planet is going to talk your local data format, so we +can ignore that. But what about the thing in the middle? Building tree +structures from Perl variables and then traversing them is a nice, +general problem, and if nobody's already written a module that does +that, you might want to modularise that code too. + +So hopefully you've now got a few ideas about what's good to modularise. +Let's now see how it's done. + +=head2 Step-by-step: Preparing the ground + +Before we even start scraping out the code, there are a few things we'll +want to do in advance. + +=over 3 + +=item Look around + +Dig into a bunch of modules to see how they're written. I'd suggest +starting with L<Text::Tabs|Text::Tabs>, since it's in the standard +library and is nice and simple, and then looking at something like +L<Time::Zone|Time::Zone>, L<File::Copy|File::Copy> and then some of the +C<Mail::*> modules if you're planning on writing object oriented code. + +These should give you an overall feel for how modules are laid out and +written. + +=item Check it's new + +There are a lot of modules on CPAN, and it's easy to miss one that's +similar to what you're planning on contributing. Have a good plough +through the modules list and the F<by-module> directories, and make sure +you're not the one reinventing the wheel! + +=item Discuss the need + +You might love it. You might feel that everyone else needs it. But there +might not actually be any real demand for it out there. If you're unsure +about the demand you're module will have, consider sending out feelers +on the C<comp.lang.perl.modules> newsgroup, or as a last resort, ask the +modules list at C<modules@perl.org>. Remember that this is a closed list +with a very long turn-around time - be prepared to wait a good while for +a response from them. + +=item Choose a name + +Perl modules included on CPAN have a naming hierarchy you should try to +fit in with. See L<perlmodlib> for more details on how this works, and +browse around CPAN and the modules list to get a feel of it. At the very +least, remember this: modules should be title capitalised, (This::Thing) +fit in with a category, and explain their purpose succinctly. + +=item Check again + +While you're doing that, make really sure you haven't missed a module +similar to the one you're about to write. + +When you've got your name sorted out and you're sure that your module is +wanted and not currently available, it's time to start coding. + +=back + +=head2 Step-by-step: Making the module + +=over 3 + +=item Start with F<h2xs> + +Originally a utility to convert C header files into XS modules, +L<h2xs|h2xs> has become a useful utility for churning out skeletons for +Perl-only modules as well. If you don't want to use the +L<Autoloader|Autoloader> which splits up big modules into smaller +subroutine-sized chunks, you'll say something like this: + + h2xs -AX -n Net::Acme + +The C<-A> omits the Autoloader code, C<-X> omits XS elements, and C<-n> +specifies the name of the module. + +=item Use L<strict|strict> and L<warnings|warnings> + +A module's code has to be warning and strict-clean, since you can't +guarantee the conditions that it'll be used under. Besides, you wouldn't +want to distribute code that wasn't warning or strict-clean anyway, +right? + +=item Use L<Carp|Carp> + +The L<Carp|Carp> module allows you to present your error messages from +the caller's perspective; this gives you a way to signal a problem with +the caller and not your module. For instance, if you say this: + + warn "No hostname given"; + +the user will see something like this: + + No hostname given at /usr/local/lib/perl5/site_perl/5.6.0/Net/Acme.pm + line 123. + +which looks like your module is doing something wrong. Instead, you want +to put the blame on the user, and say this: + + No hostname given at bad_code, line 10. + +You do this by using L<Carp|Carp> and replacing your C<warn>s with +C<carp>s. If you need to C<die>, say C<croak> instead. However, keep +C<warn> and C<die> in place for your sanity checks - where it really is +your module at fault. + +=item Use L<Exporter|Exporter> - wisely! + +C<h2xs> provides stubs for L<Exporter|Exporter>, which gives you a +standard way of exporting symbols and subroutines from your module into +the caller's namespace. For instance, saying C<use Net::Acme qw(&frob)> +would import the C<frob> subroutine. + +The package variable C<@EXPORT> will determine which symbols will get +exported when the caller simply says C<use Net::Acme> - you will hardly +ever want to put anything in there. C<@EXPORT_OK>, on the other hand, +specifies which symbols you're willing to export. If you do want to +export a bunch of symbols, use the C<%EXPORT_TAGS> and define a standard +export set - look at L<Exporter> for more details. + +=item Use L<plain old documentation|perlpod> + +The work isn't over until the paperwork is done, and you're going to +need to put in some time writing some documentation for your module. +C<h2xs> will provide a stub for you to fill in; if you're not sure about +the format, look at L<perlpod> for an introduction. Provide a good +synopsis of how your module is used in code, a description, and then +notes on the syntax and function of the individual subroutines or +methods. Use Perl comments for developer notes and POD for end-user +notes. + +=item Write tests + +You're encouraged to create self-tests for your module to ensure it's +working as intended on the myriad platforms Perl supports; if you upload +your module to CPAN, a host of testers will build your module and send +you the results of the tests. Again, C<h2xs> provides a test framework +which you can extend - you should do something more than just checking +your module will compile. + +=item Write the README + +If you're uploading to CPAN, the automated gremlins will extract the +README file and place that in your CPAN directory. It'll also appear in +the main F<by-module> and F<by-category> directories if you make it onto +the modules list. It's a good idea to put here what the module actually +does in detail, and the user-visible changes since the last release. + +=back + +=head2 Step-by-step: Distributing your module + +=over 3 + +=item Get a CPAN user ID + +Every developer publishing modules on CPAN needs a CPAN ID. See the +instructions at C<http://www.cpan.org/modules/04pause.html> (or +equivalent on your nearest mirror) to find out how to do this. + +=item C<perl Makefile.PL; make test; make dist> + +Once again, C<h2xs> has done all the work for you. It produces the +standard C<Makefile.PL> you'll have seen when you downloaded and +installs modules, and this produces a Makefile with a C<dist> target. + +Once you've ensured that your module passes its own tests - always a +good thing to make sure - you can C<make dist>, and the Makefile will +hopefully produce you a nice tarball of your module, ready for upliad. + +=item Upload the tarball + +The email you got when you received your CPAN ID will tell you how to +log in to PAUSE, the Perl Authors Upload SErver. From the menus there, +you can upload your module to CPAN. + +=item Announce to the modules list + +Once uploaded, it'll sit unnoticed in your author directory. If you want +it connected to the rest of the CPAN, you'll need to tell the modules +list about it. The best way to do this is to email them a line in the +style of the modules list, like this: + + Net::Acme bdpO Interface to Acme Frobnicator servers FOOBAR + ^ ^^^^ ^ ^ + | |||| Module description Your ID + | |||| + | |||\- Interface: (O)OP, (r)eferences, (h)ybrid, (f)unctions + | ||| + | ||\-- Language: (p)ure Perl, C(+)+, (h)ybrid, (C), (o)ther + | || + Module |\--- Support: (d)eveloper, (m)ailing list, (u)senet, (n)one + Name | + \---- Maturity: (i)dea, (c)onstructions, (a)lpha, (b)eta, + (R)eleased, (M)ature, (S)tandard + +plus a description of the module and why you think it should be +included. If you hear nothing back, that means your module will +probably appear on the modules list at the next update. Don't try +subscribing to C<modules@perl.org>; it's not another mailing list. Just +have patience. + +=item Announce to clpa + +If you have a burning desire to tell the world about your release, post +an announcement to the moderated C<comp.lang.perl.announce> newsgroup. + +=item Fix bugs! + +Once you start accumulating users, they'll send you bug reports. If +you're lucky, they'll even send you patches. Welcome to the joys of +maintaining a software project... + +=back + +=head1 AUTHOR + +Simon Cozens, C<simon@cpan.org> + +=head1 SEE ALSO + +L<perlmod>, L<perlmodlib>, L<perlmodinstall>, L<h2xs>, L<strict>, +L<Carp>, L<Exporter>, L<perlpod>, L<Test>, L<ExtUtils::MakeMaker>, +http://www.cpan.org/ diff --git a/pod/perlobj.pod b/pod/perlobj.pod index 4e45aff7c6..9a9bda94d9 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -168,6 +168,12 @@ the method that was intended to be called. If none of that works, Perl finally gives up and complains. +If you want to stop the AUTOLOAD inheritance say simply + + sub AUTOLOAD; + +and the call will die using the name of the sub being called. + Perl classes do method inheritance only. Data inheritance is left up to the class itself. By and large, this is not a problem in Perl, because most classes model the attributes of their object using an diff --git a/pod/perlop.pod b/pod/perlop.pod index b4caed9155..3c84e60801 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1207,9 +1207,9 @@ to occur that you might want. Here are two common cases: # expand tabs to 8-column spacing 1 while s/\t+/' ' x (length($&)*8 - length($`)%8)/e; -=item tr/SEARCHLIST/REPLACEMENTLIST/cdsUC +=item tr/SEARCHLIST/REPLACEMENTLIST/cds -=item y/SEARCHLIST/REPLACEMENTLIST/cdsUC +=item y/SEARCHLIST/REPLACEMENTLIST/cds Transliterates all occurrences of the characters found in the search list with the corresponding character in the replacement list. It returns @@ -1243,8 +1243,6 @@ Options: c Complement the SEARCHLIST. d Delete found but unreplaced characters. s Squash duplicate replaced characters. - U Translate to/from UTF-8. - C Translate to/from 8-bit char (octet). If the C</c> modifier is specified, the SEARCHLIST character set is complemented. If the C</d> modifier is specified, any characters @@ -1262,10 +1260,6 @@ enough. If the REPLACEMENTLIST is empty, the SEARCHLIST is replicated. This latter is useful for counting characters in a class or for squashing character sequences in a class. -The first C</U> or C</C> modifier applies to the left side of the translation. -The second one applies to the right side. If present, these modifiers override -the current utf8 state. - Examples: $ARGV[1] =~ tr/A-Z/a-z/; # canonicalize to lower case @@ -1285,9 +1279,6 @@ Examples: tr [\200-\377] [\000-\177]; # delete 8th bit - tr/\0-\xFF//CU; # change Latin-1 to Unicode - tr/\0-\x{FF}//UC; # change Unicode to Latin-1 - If multiple transliterations are given for a character, only the first one is used: diff --git a/pod/perlport.pod b/pod/perlport.pod index 7f779c955e..ee147e902c 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1640,6 +1640,10 @@ Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS, VM/ESA) =item stat +Platforms that do not have rdev, blksize, or blocks will return these +as '', so numeric comparison or manipulation of these fields may cause +'not numeric' warnings. + mtime and atime are the same thing, and ctime is creation time instead of inode change time. (S<Mac OS>) @@ -1650,6 +1654,9 @@ device and inode are not necessarily reliable. (VMS) mtime, atime and ctime all return the last modification time. Device and inode are not necessarily reliable. (S<RISC OS>) +dev, rdev, blksize, and blocks are not available. inode is not +meaningful and will differ between stat calls on the same file. (os2) + =item symlink OLDFILE,NEWFILE Not implemented. (Win32, VMS, S<RISC OS>) diff --git a/pod/perlre.pod b/pod/perlre.pod index 2db4139c30..c964be8b8f 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -169,7 +169,7 @@ You'll need to write something like C<m/\Quser\E\@\Qhost/>. In addition, Perl defines the following: \w Match a "word" character (alphanumeric plus "_") - \W Match a non-word character + \W Match a non-"word" character \s Match a whitespace character \S Match a non-whitespace character \d Match a digit character @@ -180,7 +180,7 @@ In addition, Perl defines the following: equivalent to C<(?:\PM\pM*)> \C Match a single C char (octet) even under utf8. -A C<\w> matches a single alphanumeric character, not a whole word. +A C<\w> matches a single alphanumeric character or C<_>, not a whole word. Use C<\w+> to match a string of Perl-identifier characters (which isn't the same as matching an English word). If C<use locale> is in effect, the list of alphabetic characters generated by C<\w> is taken from the @@ -216,7 +216,7 @@ character class. For example: [01[:alpha:]%] -matches one, zero, any alphabetic character, and the percentage sign. +matches zero, one, any alphabetic character, and the percentage sign. If the C<utf8> pragma is used, the following equivalences to Unicode \p{} constructs hold: @@ -250,23 +250,24 @@ The assumedly non-obviously named classes are: Any control character. Usually characters that don't produce output as such but instead control the terminal somehow: for example newline and backspace are control characters. All characters with ord() less than -32 are most often classified as control characters. +32 are most often classified as control characters (assuming ASCII, +the ISO Latin character sets, and Unicode). =item graph -Any alphanumeric or punctuation character. +Any alphanumeric or punctuation (special) character. =item print -Any alphanumeric or punctuation character or space. +Any alphanumeric or punctuation (special) character or space. =item punct -Any punctuation character. +Any punctuation (special) character. =item xdigit -Any hexadecimal digit. Though this may feel silly (/0-9a-f/i would +Any hexadecimal digit. Though this may feel silly ([0-9A-Fa-f] would work just fine) it is included for completeness. =back @@ -377,10 +378,11 @@ that looks like \\, \(, \), \<, \>, \{, or \} is always interpreted as a literal character, not a metacharacter. This was once used in a common idiom to disable or quote the special meanings of regular expression metacharacters in a string that you want to -use for a pattern. Simply quote all non-alphanumeric characters: +use for a pattern. Simply quote all non-"word" characters: $pattern =~ s/(\W)/\\$1/g; +(If C<use locale> is set, then this depends on the current locale.) Today it is more common to use the quotemeta() function or the C<\Q> metaquoting escape sequence to disable all metacharacters' special meanings like this: diff --git a/pod/perlrequick.pod b/pod/perlrequick.pod index d151e26a0c..a14229c303 100644 --- a/pod/perlrequick.pod +++ b/pod/perlrequick.pod @@ -5,22 +5,23 @@ perlrequick - Perl regular expressions quick start =head1 DESCRIPTION This page covers the very basics of understanding, creating and -using regular expressions ('regexps') in Perl. +using regular expressions ('regexes') in Perl. + =head1 The Guide =head2 Simple word matching -The simplest regexp is simply a word, or more generally, a string of -characters. A regexp consisting of a word matches any string that +The simplest regex is simply a word, or more generally, a string of +characters. A regex consisting of a word matches any string that contains that word: "Hello World" =~ /World/; # matches -In this statement, C<World> is a regexp and the C<//> enclosing +In this statement, C<World> is a regex and the C<//> enclosing C</World/> tells perl to search a string for a match. The operator -C<=~> associates the string with the regexp match and produces a true -value if the regexp matched, or false if the regexp did not match. In +C<=~> associates the string with the regex match and produces a true +value if the regex matched, or false if the regex did not match. In our case, C<World> matches the second word in C<"Hello World">, so the expression is true. This idea has several variations. @@ -32,7 +33,7 @@ The sense of the match can be reversed by using C<!~> operator: print "It doesn't match\n" if "Hello World" !~ /World/; -The literal string in the regexp can be replaced by a variable: +The literal string in the regex can be replaced by a variable: $greeting = "World"; print "It matches\n" if "Hello World" =~ /$greeting/; @@ -50,7 +51,7 @@ arbitrary delimiters by putting an C<'m'> out front: "/usr/bin/perl" =~ m"/perl"; # matches after '/usr/bin', # '/' becomes an ordinary char -Regexps must match a part of the string I<exactly> in order for the +Regexes must match a part of the string I<exactly> in order for the statement to be true: "Hello World" =~ /world/; # doesn't match, case sensitive @@ -63,7 +64,7 @@ perl will always match at the earliest possible point in the string: "That hat is red" =~ /hat/; # matches 'hat' in 'That' Not all characters can be used 'as is' in a match. Some characters, -called B<metacharacters>, are reserved for use in regexp notation. +called B<metacharacters>, are reserved for use in regex notation. The metacharacters are {}[]()^$.|*+?\ @@ -75,8 +76,8 @@ A metacharacter can be matched by putting a backslash before it: 'C:\WIN32' =~ /C:\\WIN/; # matches "/usr/bin/perl" =~ /\/usr\/local\/bin\/perl/; # matches -In the last regexp, the forward slash C<'/'> is also backslashed, -because it is used to delimit the regexp. +In the last regex, the forward slash C<'/'> is also backslashed, +because it is used to delimit the regex. Non-printable ASCII characters are represented by B<escape sequences>. Common examples are C<\t> for a tab, C<\n> for a newline, and C<\r> @@ -87,38 +88,39 @@ e.g., C<\x1B>: "1000\t2000" =~ m(0\t2) # matches "cat" =~ /\143\x61\x74/ # matches, but a weird way to spell cat -Regexps are treated mostly as double quoted strings, so variable +Regexes are treated mostly as double quoted strings, so variable substitution works: $foo = 'house'; 'cathouse' =~ /cat$foo/; # matches 'housecat' =~ /${foo}cat/; # matches -With all of the regexps above, if the regexp matched anywhere in the +With all of the regexes above, if the regex matched anywhere in the string, it was considered a match. To specify I<where> it should match, we would use the B<anchor> metacharacters C<^> and C<$>. The anchor C<^> means match at the beginning of the string and the anchor C<$> means match at the end of the string, or before a newline at the end of the string. Some examples: - "housekeeper" =~ /keeper/; # matches - "housekeeper" =~ /^keeper/; # doesn't match - "housekeeper" =~ /keeper$/; # matches - "housekeeper\n" =~ /keeper$/; # matches + "housekeeper" =~ /keeper/; # matches + "housekeeper" =~ /^keeper/; # doesn't match + "housekeeper" =~ /keeper$/; # matches + "housekeeper\n" =~ /keeper$/; # matches + "housekeeper" =~ /^housekeeper$/; # matches =head2 Using character classes A B<character class> allows a set of possible characters, rather than -just a single character, to match at a particular point in a regexp. +just a single character, to match at a particular point in a regex. Character classes are denoted by brackets C<[...]>, with the set of characters to be possibly matched inside. Here are some examples: /cat/; # matches 'cat' - /[bcr]at/; # matches 'bat, 'cat', or 'rat' + /[bcr]at/; # matches 'bat', 'cat', or 'rat' "abc" =~ /[cab]/; # matches 'a' In the last statement, even though C<'c'> is the first character in -the class, the earliest point at which the regexp can match is C<'a'>. +the class, the earliest point at which the regex can match is C<'a'>. /[yY][eE][sS]/; # match 'yes' in a case-insensitive way # 'yes', 'Yes', 'YES', etc. @@ -151,7 +153,7 @@ treated as an ordinary character. The special character C<^> in the first position of a character class denotes a B<negated character class>, which matches any character but -those in the bracket. Both C<[...]> and C<[^...]> must match a +those in the brackets. Both C<[...]> and C<[^...]> must match a character, or the match fails. Then /[^a]at/; # doesn't match 'aat' or 'at', but matches @@ -211,8 +213,8 @@ boundary. =head2 Matching this or that We can match match different character strings with the B<alternation> -metacharacter C<'|'>. To match C<dog> or C<cat>, we form the regexp -C<dog|cat>. As before, perl will try to match the regexp at the +metacharacter C<'|'>. To match C<dog> or C<cat>, we form the regex +C<dog|cat>. As before, perl will try to match the regex at the earliest possible point in the string. At each character position, perl will first try to match the the first alternative, C<dog>. If C<dog> doesn't match, perl will then try the next alternative, C<cat>. @@ -222,21 +224,21 @@ the next position in the string. Some examples: "cats and dogs" =~ /cat|dog|bird/; # matches "cat" "cats and dogs" =~ /dog|cat|bird/; # matches "cat" -Even though C<dog> is the first alternative in the second regexp, +Even though C<dog> is the first alternative in the second regex, C<cat> is able to match earlier in the string. "cats" =~ /c|ca|cat|cats/; # matches "c" "cats" =~ /cats|cat|ca|c/; # matches "cats" At a given character position, the first alternative that allows the -regexp match to succeed wil be the one that matches. Here, all the +regex match to succeed wil be the one that matches. Here, all the alternatives match at the first string position, so th first matches. =head2 Grouping things and hierarchical matching -The B<grouping> metacharacters C<()> allow a part of a regexp to be -treated as a single unit. Parts of a regexp are grouped by enclosing -them in parentheses. The regexp C<house(cat|keeper)> means match +The B<grouping> metacharacters C<()> allow a part of a regex to be +treated as a single unit. Parts of a regex are grouped by enclosing +them in parentheses. The regex C<house(cat|keeper)> means match C<house> followed by either C<cat> or C<keeper>. Some more examples are @@ -263,14 +265,14 @@ They can be used just as ordinary variables: $minutes = $2; $seconds = $3; -In list context, a match C</regexp/ with groupings will return the +In list context, a match C</regex/> with groupings will return the list of matched values C<($1,$2,...)>. So we could rewrite it as ($hours, $minutes, $second) = ($time =~ /(\d\d):(\d\d):(\d\d)/); -If the groupings in a regexp are nested, C<$1> gets the group with the +If the groupings in a regex are nested, C<$1> gets the group with the leftmost opening parenthesis, C<$2> the next opening parenthesis, -etc. For example, here is a complex regexp and the matching variables +etc. For example, here is a complex regex and the matching variables indicated below it: /(ab(cd|ef)((gi)|j))/; @@ -278,17 +280,17 @@ indicated below it: Associated with the matching variables C<$1>, C<$2>, ... are the B<backreferences> C<\1>, C<\2>, ... Backreferences are -matching variables that can be used I<inside> a regexp: +matching variables that can be used I<inside> a regex: /(\w\w\w)\s\1/; # find sequences like 'the the' in string -C<$1>, C<$2>, ... should only be used outside of a regexp, and C<\1>, -C<\2>, ... only inside a regexp. +C<$1>, C<$2>, ... should only be used outside of a regex, and C<\1>, +C<\2>, ... only inside a regex. =head2 Matching repetitions The B<quantifier> metacharacters C<?>, C<*>, C<+>, and C<{}> allow us -to determine the number of repeats of a portion of a regexp we +to determine the number of repeats of a portion of a regex we consider to be a match. Quantifiers are put immediately after the character, character class, or grouping that we want to specify. They have the following meanings: @@ -320,15 +322,16 @@ Here are some examples: $year =~ /\d{4}|\d{2}/; # better match; throw out 3 digit dates These quantifiers will try to match as much of the string as possible, -while still allowing the regexp to match. So we have +while still allowing the regex to match. So we have + $x = 'the cat in the hat'; $x =~ /^(.*)(at)(.*)$/; # matches, # $1 = 'the cat in the h' # $2 = 'at' # $3 = '' (0 matches) The first quantifier C<.*> grabs as much of the string as possible -while still having the regexp match. The second quantifier C<.*> has +while still having the regex match. The second quantifier C<.*> has no string left to it, so it matches 0 times. =head2 More matching @@ -369,10 +372,10 @@ prints A failed match or changing the target string resets the position. If you don't want the position reset after failure to match, add the -C<//c>, as in C</regexp/gc>. +C<//c>, as in C</regex/gc>. In list context, C<//g> returns a list of matched groupings, or if -there are no groupings, a list of matches to the whole regexp. So +there are no groupings, a list of matches to the whole regex. So @words = ($x =~ /(\w+)/g); # matches, # $word[0] = 'cat' @@ -381,9 +384,9 @@ there are no groupings, a list of matches to the whole regexp. So =head2 Search and replace -Search and replace is perform using C<s/regexp/replacement/modifiers>. +Search and replace is performed using C<s/regex/replacement/modifiers>. The C<replacement> is a Perl double quoted string that replaces in the -string whatever is matched with the C<regexp>. The operator C<=~> is +string whatever is matched with the C<regex>. The operator C<=~> is also used here to associate a string with C<s///>. If matching against C<$_>, the S<C<$_ =~> > can be dropped. If there is a match, C<s///> returns the number of substitutions made, otherwise it returns @@ -398,7 +401,7 @@ false. Here are a few examples: With the C<s///> operator, the matched variables C<$1>, C<$2>, etc. are immediately available for use in the replacement expression. With the global modifier, C<s///g> will search and replace all occurrences -of the regexp in the string: +of the regex in the string: $x = "I batted 4 for 4"; $x =~ s/4/four/; # $x contains "I batted four for 4" @@ -407,40 +410,42 @@ of the regexp in the string: The evaluation modifier C<s///e> wraps an C<eval{...}> around the replacement string and the evaluated result is substituted for the -matched substring. This counts character frequencies in a line: - - $x = "the cat"; - $x =~ s/(.)/$chars{$1}++;$1/eg; # final $1 replaces char with itself - print "frequency of '$_' is $chars{$_}\n" - foreach (sort {$chars{$b} <=> $chars{$a}} keys %chars); +matched substring. Some examples: -This prints + # reverse all the words in a string + $x = "the cat in the hat"; + $x =~ s/(\w+)/reverse $1/ge; # $x contains "eht tac ni eht tah" - frequency of 't' is 2 - frequency of 'e' is 1 - frequency of ' ' is 1 - frequency of 'h' is 1 - frequency of 'a' is 1 - frequency of 'c' is 1 + # convert percentage to decimal + $x = "A 39% hit rate"; + $x =~ s!(\d+)%!$1/100!e; # $x contains "A 0.39 hit rate" -C<s///> can use other delimiters, such as C<s!!!> and C<s{}{}>, and -even C<s{}//>. If single quotes are used C<s'''>, then the regexp and -replacement are treated as single quoted strings. +The last example shows that C<s///> can use other delimiters, such as +C<s!!!> and C<s{}{}>, and even C<s{}//>. If single quotes are used +C<s'''>, then the regex and replacement are treated as single quoted +strings. =head2 The split operator -C<split /regexp/, string> splits C<string> into a list of substrings -and returns that list. The regexp determines the character sequence +C<split /regex/, string> splits C<string> into a list of substrings +and returns that list. The regex determines the character sequence that C<string> is split with respect to. For example, to split a string into words, use $x = "Calvin and Hobbes"; - @words = split /\s+/, $x; # $word[0] = 'Calvin' - # $word[1] = 'and' - # $word[2] = 'Hobbes' + @word = split /\s+/, $x; # $word[0] = 'Calvin' + # $word[1] = 'and' + # $word[2] = 'Hobbes' + +To extract a comma-delimited list of numbers, use -If the empty regexp C<//> is used, the string is split into individual -characters. If the regexp has groupings, then list produced contains + $x = "1.618,2.718, 3.142"; + @const = split /,\s*/, $x; # $const[0] = '1.618' + # $const[1] = '2.718' + # $const[2] = '3.142' + +If the empty regex C<//> is used, the string is split into individual +characters. If the regex has groupings, then list produced contains the matched substrings from the groupings as well: $x = "/usr/bin"; @@ -450,7 +455,7 @@ the matched substrings from the groupings as well: # $parts[3] = '/' # $parts[4] = 'bin' -Since the first character of $x matched the regexp, C<split> prepended +Since the first character of $x matched the regex, C<split> prepended an empty initial element to the list. =head1 BUGS @@ -460,7 +465,7 @@ None. =head1 SEE ALSO This is just a quick start guide. For a more in-depth tutorial on -regexps, see L<perlretut> and for the reference page, see L<perlre>. +regexes, see L<perlretut> and for the reference page, see L<perlre>. =head1 AUTHOR AND COPYRIGHT @@ -469,5 +474,11 @@ All rights reserved. This document may be distributed under the same terms as Perl itself. +=head2 Acknowledgments + +The author would like to thank Mark-Jason Dominus, Tom Christiansen, +Ilya Zakharevich, Brad Hughes, and Mike Giroux for all their helpful +comments. + =cut diff --git a/pod/perlretut.pod b/pod/perlretut.pod index 5ff4298012..66f8179ab6 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -344,7 +344,7 @@ become the svelte C<[0-9]> and C<[a-z]>. Some examples are /[0-9bx-z]aa/; # matches '0aa', ..., '9aa', # 'baa', 'xaa', 'yaa', or 'zaa' /[0-9a-fA-F]/; # matches a hexadecimal digit - /[0-9a-zA-Z_]/; # matches an alphanumeric character, + /[0-9a-zA-Z_]/; # matches a "word" character, # like those in a perl variable name If C<'-'> is the first or last character in a character class, it is diff --git a/pod/perlsub.pod b/pod/perlsub.pod index f1b87923ef..997631674f 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -39,7 +39,7 @@ To call subroutines: Like many languages, Perl provides for user-defined subroutines. These may be located anywhere in the main program, loaded in from other files via the C<do>, C<require>, or C<use> keywords, or -generated on the fly using C<eval> or anonymous subroutines (closures). +generated on the fly using C<eval> or anonymous subroutines. You can even call a function indirectly using a variable containing its name or a CODE reference. @@ -357,7 +357,7 @@ A compilation error results otherwise. An inner block may countermand this with C<no strict 'vars'>. A C<my> has both a compile-time and a run-time effect. At compile -time, the compiler takes notice of it. The principle usefulness +time, the compiler takes notice of it. The principal usefulness of this is to quiet C<use strict 'vars'>, but it is also essential for generation of closures as detailed in L<perlref>. Actual initialization is delayed until run time, though, so it gets executed diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index dfded2ecde..6d820b6882 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -53,8 +53,8 @@ subroutine without defining it by saying C<sub name>, thus: sub myname; $me = myname $0 or die "can't get myname"; -Note that my() functions as a list operator, not as a unary operator; so -be careful to use C<or> instead of C<||> in this case. However, if +Note that myname() functions as a list operator, not as a unary operator; +so be careful to use C<or> instead of C<||> in this case. However, if you were to declare the subroutine as C<sub myname ($)>, then C<myname> would function as a unary operator, so either C<or> or C<||> would work. @@ -598,6 +598,11 @@ C</^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/> with C<$1> being the line number for the next line, and C<$2> being the optional filename (specified within quotes). +There is a fairly obvious gotcha included with the line directive: +Debuggers and profilers will only show the last source line to appear +at a particular line number in a given file. Care should be taken not +to cause line number collisions in code you'd like to debug later. + Here are some examples that you should be able to type into your command shell: diff --git a/pod/perltie.pod b/pod/perltie.pod index 95de3bb928..b39d7d5336 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -260,6 +260,10 @@ index whose value we're trying to fetch. return $self->{ARRAY}[$idx]; } +If a negative array index is used to read from an array, the index +will be translated to a positive one internally by calling FETCHSIZE +before being passed to FETCH. + As you may have noticed, the name of the FETCH method (et al.) is the same for all accesses, even though the constructors differ in names (TIESCALAR vs TIEARRAY). While in theory you could have the same class servicing @@ -281,6 +285,8 @@ there. For example: } return $self->{ARRAY}[$idx] = $value; } + +Negative indexes are treated the same as with FETCH. =item DESTROY this @@ -304,14 +310,14 @@ the following output demonstrates: =head2 Tying Hashes -As the first Perl data type to be tied (see dbmopen()), hashes have the -most complete and useful tie() implementation. A class implementing a -tied hash should define the following methods: TIEHASH is the constructor. -FETCH and STORE access the key and value pairs. EXISTS reports whether a -key is present in the hash, and DELETE deletes one. CLEAR empties the -hash by deleting all the key and value pairs. FIRSTKEY and NEXTKEY -implement the keys() and each() functions to iterate over all the keys. -And DESTROY is called when the tied variable is garbage collected. +Hashes were the first Perl data type to be tied (see dbmopen()). A class +implementing a tied hash should define the following methods: TIEHASH is +the constructor. FETCH and STORE access the key and value pairs. EXISTS +reports whether a key is present in the hash, and DELETE deletes one. +CLEAR empties the hash by deleting all the key and value pairs. FIRSTKEY +and NEXTKEY implement the keys() and each() functions to iterate over all +the keys. And DESTROY is called when the tied variable is garbage +collected. If this seems like a lot, then feel free to inherit from merely the standard Tie::Hash module for most of your methods, redefining only the diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 6397388e5d..74c1f4ed91 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -116,7 +116,7 @@ How do I reformat a paragraph?, How can I access/change the first N letters of a string?, How do I change the Nth occurrence of something?, How can I count the number of occurrences of a substring within a string?, How do I capitalize all the words on one line?, How can I split a [character] -delimited string except when inside[character]? (Comma-separated files), +delimited string except when inside [character]? (Comma-separated files), How do I strip blank space from the beginning/end of a string?, How do I pad a string with blanks or pad a number with zeroes?, How do I extract selected columns from a string?, How do I find the soundex value of a @@ -301,6 +301,2198 @@ authors =back +=head2 perltoc - perl documentation table of contents + +=over + +=item DESCRIPTION + +=item BASIC DOCUMENTATION + +=over + +=item perl - Practical Extraction and Report Language + +SYNOPSIS, DESCRIPTION, AVAILABILITY, ENVIRONMENT, AUTHOR, FILES, SEE ALSO, +DIAGNOSTICS, BUGS, NOTES + +=item perlfaq - frequently asked questions about Perl ($Date: 1999/05/23 +20:38:02 $) + +DESCRIPTION + +=back + +=back + +=head2 perlbook - Perl book information + +=over + +=item DESCRIPTION + +=back + +=head2 perlsyn - Perl syntax + +=over + +=item DESCRIPTION + +=over + +=item Declarations + +=item Simple statements + +=item Compound statements + +=item Loop Control + +=item For Loops + +=item Foreach Loops + +=item Basic BLOCKs and Switch Statements + +=item Goto + +=item PODs: Embedded Documentation + +=item Plain Old Comments (Not!) + +=back + +=back + +=head2 perldata - Perl data types + +=over + +=item DESCRIPTION + +=over + +=item Variable names + +=item Context + +=item Scalar values + +=item Scalar value constructors + +=item List value constructors + +=item Slices + +=item Typeglobs and Filehandles + +=back + +=item SEE ALSO + +=back + +=head2 perlop - Perl operators and precedence + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Terms and List Operators (Leftward) + +=item The Arrow Operator + +=item Auto-increment and Auto-decrement + +=item Exponentiation + +=item Symbolic Unary Operators + +=item Binding Operators + +=item Multiplicative Operators + +=item Additive Operators + +=item Shift Operators + +=item Named Unary Operators + +=item Relational Operators + +=item Equality Operators + +=item Bitwise And + +=item Bitwise Or and Exclusive Or + +=item C-style Logical And + +=item C-style Logical Or + +=item Range Operators + +=item Conditional Operator + +=item Assignment Operators + +=item Comma Operator + +=item List Operators (Rightward) + +=item Logical Not + +=item Logical And + +=item Logical or and Exclusive Or + +=item C Operators Missing From Perl + +unary &, unary *, (TYPE) + +=item Quote and Quote-like Operators + +=item Regexp Quote-Like Operators + +?PATTERN?, m/PATTERN/cgimosx, /PATTERN/cgimosx, q/STRING/, C<'STRING'>, +qq/STRING/, "STRING", qr/STRING/imosx, qx/STRING/, `STRING`, qw/STRING/, +s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds, +y/SEARCHLIST/REPLACEMENTLIST/cds + +=item Gory details of parsing quoted constructs + +Finding the end, Removal of backslashes before delimiters, Interpolation, +C<<<'EOF'>, C<m''>, C<s'''>, C<tr///>, C<y///>, C<''>, C<q//>, C<"">, +C<``>, C<qq//>, C<qx//>, C<< <file*glob> >>, C<?RE?>, C</RE/>, C<m/RE/>, +C<s/RE/foo/>,, Interpolation of regular expressions, Optimization of +regular expressions + +=item I/O Operators + +=item Constant Folding + +=item Bitwise String Operators + +=item Integer Arithmetic + +=item Floating-point Arithmetic + +=item Bigger Numbers + +=back + +=back + +=head2 perlsub - Perl subroutines + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Private Variables via my() + +=item Persistent Private Variables + +=item Temporary Values via local() + +=item Lvalue subroutines + +=item Passing Symbol Table Entries (typeglobs) + +=item When to Still Use local() + +1. You need to give a global variable a temporary value, especially $_, 2. +You need to create a local file or directory handle or a local function, 3. +You want to temporarily change just one element of an array or hash + +=item Pass by Reference + +=item Prototypes + +=item Constant Functions + +=item Overriding Built-in Functions + +=item Autoloading + +=item Subroutine Attributes + +=back + +=item SEE ALSO + +=back + +=head2 perlfunc - Perl builtin functions + +=over + +=item DESCRIPTION + +=over + +=item Perl Functions by Category + +Functions for SCALARs or strings, Regular expressions and pattern matching, +Numeric functions, Functions for real @ARRAYs, Functions for list data, +Functions for real %HASHes, Input and output functions, Functions for fixed +length data or records, Functions for filehandles, files, or directories, +Keywords related to the control flow of your perl program, Keywords related +to scoping, Miscellaneous functions, Functions for processes and process +groups, Keywords related to perl modules, Keywords related to classes and +object-orientedness, Low-level socket functions, System V interprocess +communication functions, Fetching user and group info, Fetching network +info, Time-related functions, Functions new in perl5, Functions obsoleted +in perl5 + +=item Portability + +=item Alphabetical Listing of Perl Functions + +I<-X> FILEHANDLE, I<-X> EXPR, I<-X>, abs VALUE, abs, accept +NEWSOCKET,GENERICSOCKET, alarm SECONDS, alarm, atan2 Y,X, bind SOCKET,NAME, +binmode FILEHANDLE, DISCIPLINE, binmode FILEHANDLE, bless REF,CLASSNAME, +bless REF, caller EXPR, caller, chdir EXPR, chmod LIST, chomp VARIABLE, +chomp LIST, chomp, chop VARIABLE, chop LIST, chop, chown LIST, chr NUMBER, +chr, chroot FILENAME, chroot, close FILEHANDLE, close, closedir DIRHANDLE, +connect SOCKET,NAME, continue BLOCK, cos EXPR, crypt PLAINTEXT,SALT, +dbmclose HASH, dbmopen HASH,DBNAME,MASK, defined EXPR, defined, delete +EXPR, die LIST, do BLOCK, do SUBROUTINE(LIST), do EXPR, dump LABEL, dump, +each HASH, eof FILEHANDLE, eof (), eof, eval EXPR, eval BLOCK, exec LIST, +exec PROGRAM LIST, exists EXPR, exit EXPR, exp EXPR, exp, fcntl +FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock FILEHANDLE,OPERATION, +fork, format, formline PICTURE,LIST, getc FILEHANDLE, getc, getlogin, +getpeername SOCKET, getpgrp PID, getppid, getpriority WHICH,WHO, getpwnam +NAME, getgrnam NAME, gethostbyname NAME, getnetbyname NAME, getprotobyname +NAME, getpwuid UID, getgrgid GID, getservbyname NAME,PROTO, gethostbyaddr +ADDR,ADDRTYPE, getnetbyaddr ADDR,ADDRTYPE, getprotobynumber NUMBER, +getservbyport PORT,PROTO, getpwent, getgrent, gethostent, getnetent, +getprotoent, getservent, setpwent, setgrent, sethostent STAYOPEN, setnetent +STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN, endpwent, endgrent, +endhostent, endnetent, endprotoent, endservent, getsockname SOCKET, +getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, gmtime EXPR, goto LABEL, +goto EXPR, goto &NAME, grep BLOCK LIST, grep EXPR,LIST, hex EXPR, hex, +import, index STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl +FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill SIGNAL, LIST, +last LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length, +link OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR, +lock, log EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK +LIST, map EXPR,LIST, mkdir FILENAME,MASK, mkdir FILENAME, msgctl +ID,CMD,ARG, msgget KEY,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, msgsnd +ID,MSG,FLAGS, my EXPR, my EXPR : ATTRIBUTES, next LABEL, next, no Module +LIST, oct EXPR, oct, open FILEHANDLE,MODE,LIST, open FILEHANDLE,EXPR, open +FILEHANDLE, opendir DIRHANDLE,EXPR, ord EXPR, ord, our EXPR, pack +TEMPLATE,LIST, package, package NAMESPACE, pipe READHANDLE,WRITEHANDLE, pop +ARRAY, pop, pos SCALAR, pos, print FILEHANDLE LIST, print LIST, print, +printf FILEHANDLE FORMAT, LIST, printf FORMAT, LIST, prototype FUNCTION, +push ARRAY,LIST, q/STRING/, qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/, +quotemeta EXPR, quotemeta, rand EXPR, rand, read +FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir +DIRHANDLE, readline EXPR, readlink EXPR, readlink, readpipe EXPR, recv +SOCKET,SCALAR,LENGTH,FLAGS, redo LABEL, redo, ref EXPR, ref, rename +OLDNAME,NEWNAME, require VERSION, require EXPR, require, reset EXPR, reset, +return EXPR, return, reverse LIST, rewinddir DIRHANDLE, rindex +STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar +EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select +FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl +ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send +SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority +WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shift ARRAY, +shift, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE, +shmwrite ID,STRING,POS,SIZE, shutdown SOCKET,HOW, sin EXPR, sin, sleep +EXPR, sleep, socket SOCKET,DOMAIN,TYPE,PROTOCOL, socketpair +SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, sort SUBNAME LIST, sort BLOCK LIST, +sort LIST, splice ARRAY,OFFSET,LENGTH,LIST, splice ARRAY,OFFSET,LENGTH, +splice ARRAY,OFFSET, splice ARRAY, split /PATTERN/,EXPR,LIMIT, split +/PATTERN/,EXPR, split /PATTERN/, split, sprintf FORMAT, LIST, sqrt EXPR, +sqrt, srand EXPR, srand, stat FILEHANDLE, stat EXPR, stat, study SCALAR, +study, sub BLOCK, sub NAME, sub NAME BLOCK, substr +EXPR,OFFSET,LENGTH,REPLACEMENT, substr EXPR,OFFSET,LENGTH, substr +EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST, sysopen +FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS, sysread +FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, sysseek +FILEHANDLE,POSITION,WHENCE, system LIST, system PROGRAM LIST, syswrite +FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite FILEHANDLE,SCALAR,LENGTH, +syswrite FILEHANDLE,SCALAR, tell FILEHANDLE, tell, telldir DIRHANDLE, tie +VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate +FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, +ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack +TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module VERSION LIST, +use Module VERSION, use Module LIST, use Module, use VERSION, utime LIST, +values HASH, vec EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn +LIST, write FILEHANDLE, write EXPR, write, y/// + +=back + +=back + +=head2 perlreftut - Mark's very short tutorial about references + +=over + +=item DESCRIPTION + +=item Who Needs Complicated Data Structures? + +=item The Solution + +=item Syntax + +=over + +=item Making References + +=item Using References + +=back + +=item An Example + +=item Arrow Rule + +=item Solution + +=item The Rest + +=item Summary + +=item Credits + +=over + +=item Distribution Conditions + +=back + +=back + +=head2 perldsc - Perl Data Structures Cookbook + +=over + +=item DESCRIPTION + +arrays of arrays, hashes of arrays, arrays of hashes, hashes of hashes, +more elaborate constructs + +=item REFERENCES + +=item COMMON MISTAKES + +=item CAVEAT ON PRECEDENCE + +=item WHY YOU SHOULD ALWAYS C<use strict> + +=item DEBUGGING + +=item CODE EXAMPLES + +=item ARRAYS OF ARRAYS + +=over + +=item Declaration of a ARRAY OF ARRAYS + +=item Generation of a ARRAY OF ARRAYS + +=item Access and Printing of a ARRAY OF ARRAYS + +=back + +=item HASHES OF ARRAYS + +=over + +=item Declaration of a HASH OF ARRAYS + +=item Generation of a HASH OF ARRAYS + +=item Access and Printing of a HASH OF ARRAYS + +=back + +=item ARRAYS OF HASHES + +=over + +=item Declaration of a ARRAY OF HASHES + +=item Generation of a ARRAY OF HASHES + +=item Access and Printing of a ARRAY OF HASHES + +=back + +=item HASHES OF HASHES + +=over + +=item Declaration of a HASH OF HASHES + +=item Generation of a HASH OF HASHES + +=item Access and Printing of a HASH OF HASHES + +=back + +=item MORE ELABORATE RECORDS + +=over + +=item Declaration of MORE ELABORATE RECORDS + +=item Declaration of a HASH OF COMPLEX RECORDS + +=item Generation of a HASH OF COMPLEX RECORDS + +=back + +=item Database Ties + +=item SEE ALSO + +=item AUTHOR + +=back + +=head2 perlrequick - Perl regular expressions quick start + +=over + +=item DESCRIPTION + +=item The Guide + +=over + +=item Simple word matching + +=item Using character classes + +\d is a digit and represents [0-9], \s is a whitespace character and +represents [\ \t\r\n\f], \w is a word character (alphanumeric or _) and +represents [0-9a-zA-Z_], \D is a negated \d; it represents any character +but a digit [^0-9], \S is a negated \s; it represents any non-whitespace +character [^\s], \W is a negated \w; it represents any non-word character +[^\w], The period '.' matches any character but "\n" + +=item Matching this or that + +=item Grouping things and hierarchical matching + +=item Extracting matches + +=item Matching repetitions + +C<a?> = match 'a' 1 or 0 times, C<a*> = match 'a' 0 or more times, i.e., +any number of times, C<a+> = match 'a' 1 or more times, i.e., at least +once, C<a{n,m}> = match at least C<n> times, but not more than C<m> times, +C<a{n,}> = match at least C<n> or more times, C<a{n}> = match exactly C<n> +times + +=item More matching + +=item Search and replace + +=item The split operator + +=back + +=item BUGS + +=item SEE ALSO + +=item AUTHOR AND COPYRIGHT + +=over + +=item Acknowledgments + +=back + +=back + +=head2 perlpod - plain old documentation + +=over + +=item DESCRIPTION + +=over + +=item Verbatim Paragraph + +=item Command Paragraph + +=item Ordinary Block of Text + +=item The Intent + +=item Embedding Pods in Perl Modules + +=item Common Pod Pitfalls + +=back + +=item SEE ALSO + +=item AUTHOR + +=back + +=head2 perlstyle - Perl style guide + +=over + +=item DESCRIPTION + +=back + +=head2 perltrap - Perl traps for the unwary + +=over + +=item DESCRIPTION + +=over + +=item Awk Traps + +=item C Traps + +=item Sed Traps + +=item Shell Traps + +=item Perl Traps + +=item Perl4 to Perl5 Traps + +Discontinuance, Deprecation, and BugFix traps, Parsing Traps, Numerical +Traps, General data type traps, Context Traps - scalar, list contexts, +Precedence Traps, General Regular Expression Traps using s///, etc, +Subroutine, Signal, Sorting Traps, OS Traps, DBM Traps, Unclassified Traps + +=item Discontinuance, Deprecation, and BugFix traps + +Discontinuance, Deprecation, BugFix, Discontinuance, Discontinuance, +Discontinuance, BugFix, Discontinuance, Discontinuance, BugFix, +Discontinuance, Deprecation, Discontinuance, Discontinuance + +=item Parsing Traps + +Parsing, Parsing, Parsing, Parsing + +=item Numerical Traps + +Numerical, Numerical, Numerical, Bitwise string ops + +=item General data type traps + +(Arrays), (Arrays), (Hashes), (Globs), (Globs), (Scalar String), +(Constants), (Scalars), (Variable Suicide) + +=item Context Traps - scalar, list contexts + +(list context), (scalar context), (scalar context), (list, builtin) + +=item Precedence Traps + +Precedence, Precedence, Precedence, Precedence, Precedence, Precedence, +Precedence + +=item General Regular Expression Traps using s///, etc. + +Regular Expression, Regular Expression, Regular Expression, Regular +Expression, Regular Expression, Regular Expression, Regular Expression, +Regular Expression + +=item Subroutine, Signal, Sorting Traps + +(Signals), (Sort Subroutine), warn() won't let you specify a filehandle + +=item OS Traps + +(SysV), (SysV) + +=item Interpolation Traps + +Interpolation, Interpolation, Interpolation, Interpolation, Interpolation, +Interpolation, Interpolation, Interpolation, Interpolation + +=item DBM Traps + +DBM, DBM + +=item Unclassified Traps + +C<require>/C<do> trap using returned value, C<split> on empty string with +LIMIT specified + +=back + +=back + +=head2 perlrun - how to execute the Perl interpreter + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item #! and quoting on non-Unix systems + +OS/2, MS-DOS, Win95/NT, Macintosh, VMS + +=item Location of Perl + +=item Command Switches + +B<-0>[I<digits>], B<-a>, B<-C>, B<-c>, B<-d>, B<-d:>I<foo>, +B<-D>I<letters>, B<-D>I<number>, B<-e> I<commandline>, B<-F>I<pattern>, +B<-h>, B<-i>[I<extension>], B<-I>I<directory>, B<-l>[I<octnum>], +B<-m>[B<->]I<module>, B<-M>[B<->]I<module>, B<-M>[B<->]I<'module ...'>, +B<-[mM]>[B<->]I<module=arg[,arg]...>, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>, +B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<name>, B<-w>, B<-W>, B<-X>, +B<-x> I<directory> + +=back + +=item ENVIRONMENT + +HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, PERL5SHELL +(specific to the Win32 port), PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL, +PERL_ROOT (specific to the VMS port), SYS$LOGIN (specific to the VMS port) + +=back + +=head2 perldiag - various Perl diagnostics + +=over + +=item DESCRIPTION + +=back + +=head2 perllexwarn - Perl Lexical Warnings + +=over + +=item DESCRIPTION + +=over + +=item Default Warnings and Optional Warnings + +=item What's wrong with B<-w> and C<$^W> + +=item Controlling Warnings from the Command Line + +B<-w>, B<-W>, B<-X> + +=item Backward Compatibility + +=item Category Hierarchy + +=item Fatal Warnings + +=item Reporting Warnings from a Module + +=back + +=item TODO + +=item SEE ALSO + +=item AUTHOR + +=back + +=head2 perldebug - Perl debugging + +=over + +=item DESCRIPTION + +=item The Perl Debugger + +=over + +=item Debugger Commands + +h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n +[expr], r, <CR>, c [line|sub], l, l min+incr, l min-max, l line, l subname, +-, w [line], f filename, /pattern/, ?pattern?, L, S [[!]regex], t, t expr, +b [line] [condition], b subname [condition], b postpone subname +[condition], b load filename, b compile subname, d [line], D, a [line] +command, a [line], A, W expr, W, O booloption .., O anyoption? .., O +option=value .., < ?, < [ command ], << command, > ?, > command, >> +command, { ?, { [ command ], {{ command, ! number, ! -number, ! pattern, !! +cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd, command, m expr, man [manpage] + +=item Configurable Options + +C<recallCommand>, C<ShellBang>, C<pager>, C<tkRunning>, C<signalLevel>, +C<warnLevel>, C<dieLevel>, C<AutoTrace>, C<LineInfo>, C<inhibit_exit>, +C<PrintRet>, C<ornaments>, C<frame>, C<maxTraceLen>, C<arrayDepth>, +C<hashDepth>, C<compactDump>, C<veryCompact>, C<globPrint>, C<DumpDBFiles>, +C<DumpPackages>, C<DumpReused>, C<quote>, C<HighBit>, C<undefPrint>, +C<UsageOnly>, C<TTY>, C<noTTY>, C<ReadLine>, C<NonStop> + +=item Debugger input/output + +Prompt, Multiline commands, Stack backtrace, Line Listing Format, Frame +listing + +=item Debugging compile-time statements + +=item Debugger Customization + +=item Readline Support + +=item Editor Support for Debugging + +=item The Perl Profiler + +=back + +=item Debugging regular expressions + +=item Debugging memory usage + +=item SEE ALSO + +=item BUGS + +=back + +=head2 perlvar - Perl predefined variables + +=over + +=item DESCRIPTION + +=over + +=item Predefined Names + +$ARG, $_, $<I<digits>>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $', +$LAST_PAREN_MATCH, $+, @LAST_MATCH_END, @+, $MULTILINE_MATCHING, $*, +input_line_number HANDLE EXPR, $INPUT_LINE_NUMBER, $NR, $, +input_record_separator HANDLE EXPR, $INPUT_RECORD_SEPARATOR, $RS, $/, +autoflush HANDLE EXPR, $OUTPUT_AUTOFLUSH, $|, output_field_separator HANDLE +EXPR, $OUTPUT_FIELD_SEPARATOR, $OFS, $,, output_record_separator HANDLE +EXPR, $OUTPUT_RECORD_SEPARATOR, $ORS, $\, $LIST_SEPARATOR, $", +$SUBSCRIPT_SEPARATOR, $SUBSEP, $;, $OFMT, $#, format_page_number HANDLE +EXPR, $FORMAT_PAGE_NUMBER, $%, format_lines_per_page HANDLE EXPR, +$FORMAT_LINES_PER_PAGE, $=, format_lines_left HANDLE EXPR, +$FORMAT_LINES_LEFT, $-, @LAST_MATCH_START, @-, C<$`> is the same as +C<substr($var, 0, $-[0])>, C<$&> is the same as C<substr($var, $-[0], $+[0] +- $-[0])>, C<$'> is the same as C<substr($var, $+[0])>, C<$1> is the same +as C<substr($var, $-[1], $+[1] - $-[1])>, C<$2> is the same as +C<substr($var, $-[2], $+[2] - $-[2])>, C<$3> is the same as C<substr $var, +$-[3], $+[3] - $-[3])>, format_name HANDLE EXPR, $FORMAT_NAME, $~, +format_top_name HANDLE EXPR, $FORMAT_TOP_NAME, $^, +format_line_break_characters HANDLE EXPR, $FORMAT_LINE_BREAK_CHARACTERS, +$:, format_formfeed HANDLE EXPR, $FORMAT_FORMFEED, $^L, $ACCUMULATOR, $^A, +$CHILD_ERROR, $?, $OS_ERROR, $ERRNO, $!, $EXTENDED_OS_ERROR, $^E, +$EVAL_ERROR, $@, $PROCESS_ID, $PID, $$, $REAL_USER_ID, $UID, $<, +$EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(, +$EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $], $COMPILING, $^C, +$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, %^H, $INPLACE_EDIT, $^I, $^M, +$OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, +0x100, 0x200, $LAST_REGEXP_CODE_RESULT, $^R, $EXCEPTIONS_BEING_CAUGHT, $^S, +$BASETIME, $^T, $PERL_VERSION, $^V, $WARNING, $^W, ${^WARNING_BITS}, +${^WIDE_SYSTEM_CALLS}, $EXECUTABLE_NAME, $^X, $ARGV, @ARGV, @INC, @_, %INC, +%ENV, $ENV{expr}, %SIG, $SIG{expr} + +=item Error Indicators + +=item Technical Note on the Syntax of Variable Names + +=back + +=item BUGS + +=back + +=head2 perllol - Manipulating Arrays of Arrays in Perl + +=over + +=item DESCRIPTION + +=item Declaration and Access of Arrays of Arrays + +=item Growing Your Own + +=item Access and Printing + +=item Slices + +=item SEE ALSO + +=item AUTHOR + +=back + +=head2 perlopentut - tutorial on opening things in Perl + +=over + +=item DESCRIPTION + +=item Open E<agrave> la shell + +=over + +=item Simple Opens + +=item Pipe Opens + +=item The Minus File + +=item Mixing Reads and Writes + +=item Filters + +=back + +=item Open E<agrave> la C + +=over + +=item Permissions E<agrave> la mode + +=back + +=item Obscure Open Tricks + +=over + +=item Re-Opening Files (dups) + +=item Dispelling the Dweomer + +=item Paths as Opens + +=item Single Argument Open + +=item Playing with STDIN and STDOUT + +=back + +=item Other I/O Issues + +=over + +=item Opening Non-File Files + +=item Binary Files + +=item File Locking + +=back + +=item SEE ALSO + +=item AUTHOR and COPYRIGHT + +=item HISTORY + +=back + +=head2 perlretut - Perl regular expressions tutorial + +=over + +=item DESCRIPTION + +=item Part 1: The basics + +=over + +=item Simple word matching + +=item Using character classes + +\d is a digit and represents [0-9], \s is a whitespace character and +represents [\ \t\r\n\f], \w is a word character (alphanumeric or _) and +represents [0-9a-zA-Z_], \D is a negated \d; it represents any character +but a digit [^0-9], \S is a negated \s; it represents any non-whitespace +character [^\s], \W is a negated \w; it represents any non-word character +[^\w], The period '.' matches any character but "\n", no modifiers (//): +Default behavior. C<'.'> matches any character except C<"\n">. C<^> +matches only at the beginning of the string and C<$> matches only at the +end or before a newline at the end, s modifier (//s): Treat string as a +single long line. C<'.'> matches any character, even C<"\n">. C<^> +matches only at the beginning of the string and C<$> matches only at the +end or before a newline at the end, m modifier (//m): Treat string as a set +of multiple lines. C<'.'> matches any character except C<"\n">. C<^> and +C<$> are able to match at the start or end of I<any> line within the +string, both s and m modifiers (//sm): Treat string as a single long line, +but detect multiple lines. C<'.'> matches any character, even C<"\n">. +C<^> and C<$>, however, are able to match at the start or end of I<any> +line within the string + +=item Matching this or that + +=item Grouping things and hierarchical matching + +0 Start with the first letter in the string 'a', 1 Try the first +alternative in the first group 'abd', 2 Match 'a' followed by 'b'. So far +so good, 3 'd' in the regexp doesn't match 'c' in the string - a dead end. +So backtrack two characters and pick the second alternative in the first +group 'abc', 4 Match 'a' followed by 'b' followed by 'c'. We are on a roll +and have satisfied the first group. Set $1 to 'abc', 5 Move on to the +second group and pick the first alternative 'df', 6 Match the 'd', 7 'f' in +the regexp doesn't match 'e' in the string, so a dead end. Backtrack one +character and pick the second alternative in the second group 'd', 8 'd' +matches. The second grouping is satisfied, so set $2 to 'd', 9 We are at +the end of the regexp, so we are done! We have matched 'abcd' out of the +string "abcde" + +=item Extracting matches + +=item Matching repetitions + +C<a?> = match 'a' 1 or 0 times, C<a*> = match 'a' 0 or more times, i.e., +any number of times, C<a+> = match 'a' 1 or more times, i.e., at least +once, C<a{n,m}> = match at least C<n> times, but not more than C<m> times, +C<a{n,}> = match at least C<n> or more times, C<a{n}> = match exactly C<n> +times, Principle 0: Taken as a whole, any regexp will be matched at the +earliest possible position in the string, Principle 1: In an alternation +C<a|b|c...>, the leftmost alternative that allows a match for the whole +regexp will be the one used, Principle 2: The maximal matching quantifiers +C<?>, C<*>, C<+> and C<{n,m}> will in general match as much of the string +as possible while still allowing the whole regexp to match, Principle 3: If +there are two or more elements in a regexp, the leftmost greedy quantifier, +if any, will match as much of the string as possible while still allowing +the whole regexp to match. The next leftmost greedy quantifier, if any, +will try to match as much of the string remaining available to it as +possible, while still allowing the whole regexp to match. And so on, until +all the regexp elements are satisfied, C<a??> = match 'a' 0 or 1 times. Try +0 first, then 1, C<a*?> = match 'a' 0 or more times, i.e., any number of +times, but as few times as possible, C<a+?> = match 'a' 1 or more times, +i.e., at least once, but as few times as possible, C<a{n,m}?> = match at +least C<n> times, not more than C<m> times, as few times as possible, +C<a{n,}?> = match at least C<n> times, but as few times as possible, +C<a{n}?> = match exactly C<n> times. Because we match exactly C<n> times, +C<a{n}?> is equivalent to C<a{n}> and is just there for notational +consistency, Principle 3: If there are two or more elements in a regexp, +the leftmost greedy (non-greedy) quantifier, if any, will match as much +(little) of the string as possible while still allowing the whole regexp to +match. The next leftmost greedy (non-greedy) quantifier, if any, will try +to match as much (little) of the string remaining available to it as +possible, while still allowing the whole regexp to match. And so on, until +all the regexp elements are satisfied, 0 Start with the first letter in the +string 't', 1 The first quantifier '.*' starts out by matching the whole +string 'the cat in the hat', 2 'a' in the regexp element 'at' doesn't match +the end of the string. Backtrack one character, 3 'a' in the regexp +element 'at' still doesn't match the last letter of the string 't', so +backtrack one more character, 4 Now we can match the 'a' and the 't', 5 +Move on to the third element '.*'. Since we are at the end of the string +and '.*' can match 0 times, assign it the empty string, 6 We are done! + +=item Building a regexp + +specifying the task in detail,, breaking down the problem into smaller +parts,, translating the small parts into regexps,, combining the regexps,, +and optimizing the final combined regexp + +=item Using regular expressions in Perl + +=back + +=item Part 2: Power tools + +=over + +=item More on characters, strings, and character classes + +=item Compiling and saving regular expressions + +=item Embedding comments and modifiers in a regular expression + +=item Non-capturing groupings + +=item Looking ahead and looking behind + +=item Using independent subexpressions to prevent backtracking + +=item Conditional expressions + +=item A bit of magic: executing Perl code in a regular expression + +=item Pragmas and debugging + +=back + +=item BUGS + +=item SEE ALSO + +=item AUTHOR AND COPYRIGHT + +=over + +=item Acknowledgments + +=back + +=back + +=head2 perlref - Perl references and nested data structures + +=over + +=item NOTE + +=item DESCRIPTION + +=over + +=item Making References + +=item Using References + +=item Symbolic references + +=item Not-so-symbolic references + +=item Pseudo-hashes: Using an array as a hash + +=item Function Templates + +=back + +=item WARNING + +=item SEE ALSO + +=back + +=head2 perlre - Perl regular expressions + +=over + +=item DESCRIPTION + +i, m, s, x + +=over + +=item Regular Expressions + +cntrl, graph, print, punct, xdigit + +=item Extended Patterns + +C<(?#text)>, C<(?imsx-imsx)>, C<(?:pattern)>, C<(?imsx-imsx:pattern)>, +C<(?=pattern)>, C<(?!pattern)>, C<(?<=pattern)>, C<(?<!pattern)>, C<(?{ +code })>, C<(??{ code })>, C<< (?>pattern) >>, +C<(?(condition)yes-pattern|no-pattern)>, C<(?(condition)yes-pattern)> + +=item Backtracking + +=item Version 8 Regular Expressions + +=item Warning on \1 vs $1 + +=item Repeated patterns matching zero-length substring + +=item Combining pieces together + +C<ST>, C<S|T>, C<S{REPEAT_COUNT}>, C<S{min,max}>, C<S{min,max}?>, C<S?>, +C<S*>, C<S+>, C<S??>, C<S*?>, C<S+?>, C<< (?>S) >>, C<(?=S)>, C<(?<=S)>, +C<(?!S)>, C<(?<!S)>, C<(??{ EXPR })>, +C<(?(condition)yes-pattern|no-pattern)> + +=item Creating custom RE engines + +=back + +=item BUGS + +=item SEE ALSO + +=back + +=head2 perlform - Perl formats + +=over + +=item DESCRIPTION + +=over + +=item Format Variables + +=back + +=item NOTES + +=over + +=item Footers + +=item Accessing Formatting Internals + +=back + +=item WARNINGS + +=back + +=head2 perllocale - Perl locale handling (internationalization and +localization) + +=over + +=item DESCRIPTION + +=item PREPARING TO USE LOCALES + +=item USING LOCALES + +=over + +=item The use locale pragma + +=item The setlocale function + +=item Finding locales + +=item LOCALE PROBLEMS + +=item Temporarily fixing locale problems + +=item Permanently fixing locale problems + +=item Permanently fixing your system's locale configuration + +=item Fixing system locale configuration + +=item The localeconv function + +=back + +=item LOCALE CATEGORIES + +=over + +=item Category LC_COLLATE: Collation + +=item Category LC_CTYPE: Character Types + +=item Category LC_NUMERIC: Numeric Formatting + +=item Category LC_MONETARY: Formatting of monetary amounts + +=item LC_TIME + +=item Other categories + +=back + +=item SECURITY + +B<Comparison operators> (C<lt>, C<le>, C<ge>, C<gt> and C<cmp>):, +B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or C<\U>), +B<Matching operator> (C<m//>):, B<Substitution operator> (C<s///>):, +B<Output formatting functions> (printf() and write()):, B<Case-mapping +functions> (lc(), lcfirst(), uc(), ucfirst()):, B<POSIX locale-dependent +functions> (localeconv(), strcoll(), strftime(), strxfrm()):, B<POSIX +character class tests> (isalnum(), isalpha(), isdigit(), isgraph(), +islower(), isprint(), ispunct(), isspace(), isupper(), isxdigit()): + +=item ENVIRONMENT + +PERL_BADLANG, LC_ALL, LANGUAGE, LC_CTYPE, LC_COLLATE, LC_MONETARY, +LC_NUMERIC, LC_TIME, LANG + +=item NOTES + +=over + +=item Backward compatibility + +=item I18N:Collate obsolete + +=item Sort speed and memory use impacts + +=item write() and LC_NUMERIC + +=item Freely available locale definitions + +=item I18n and l10n + +=item An imperfect standard + +=back + +=item BUGS + +=over + +=item Broken systems + +=back + +=item SEE ALSO + +=item HISTORY + +=back + +=head2 perlunicode - Unicode support in Perl + +=over + +=item DESCRIPTION + +=over + +=item Important Caveat + +Input and Output Disciplines, Regular Expressions, C<use utf8> still needed +to enable a few features + +=item Byte and Character semantics + +=item Effects of character semantics + +=item Character encodings for input and output + +=back + +=item CAVEATS + +=item SEE ALSO + +=back + +=head2 perlipc - Perl interprocess communication (signals, fifos, pipes, +safe subprocesses, sockets, and semaphores) + +=over + +=item DESCRIPTION + +=item Signals + +=item Named Pipes + +=over + +=item WARNING + +=back + +=item Using open() for IPC + +=over + +=item Filehandles + +=item Background Processes + +=item Complete Dissociation of Child from Parent + +=item Safe Pipe Opens + +=item Bidirectional Communication with Another Process + +=item Bidirectional Communication with Yourself + +=back + +=item Sockets: Client/Server Communication + +=over + +=item Internet Line Terminators + +=item Internet TCP Clients and Servers + +=item Unix-Domain TCP Clients and Servers + +=back + +=item TCP Clients with IO::Socket + +=over + +=item A Simple Client + +C<Proto>, C<PeerAddr>, C<PeerPort> + +=item A Webget Client + +=item Interactive Client with IO::Socket + +=back + +=item TCP Servers with IO::Socket + +Proto, LocalPort, Listen, Reuse + +=item UDP: Message Passing + +=item SysV IPC + +=item NOTES + +=item BUGS + +=item AUTHOR + +=item SEE ALSO + +=back + +=head2 perlfork - Perl's fork() emulation + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Behavior of other Perl features in forked pseudo-processes + +$$ or $PROCESS_ID, %ENV, chdir() and all other builtins that accept +filenames, wait() and waitpid(), kill(), exec(), exit(), Open handles to +files, directories and network sockets + +=item Resource limits + +=item Killing the parent process + +=item Lifetime of the parent process and pseudo-processes + +=item CAVEATS AND LIMITATIONS + +BEGIN blocks, Open filehandles, Forking pipe open() not yet implemented, +Global state maintained by XSUBs, Interpreter embedded in larger +application, Thread-safety of extensions + +=back + +=item BUGS + +=item AUTHOR + +=item SEE ALSO + +=back + +=head2 perlnumber - semantics of numbers and numeric operations in Perl + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=item Storing numbers + +=item Numeric operators and numeric conversions + +=item Flavors of Perl numeric operations + +Arithmetic operators except, C<no integer>, Arithmetic operators except, +C<use integer>, Bitwise operators, C<no integer>, Bitwise operators, C<use +integer>, Operators which expect an integer, Operators which expect a +string + +=item AUTHOR + +=item SEE ALSO + +=back + +=head2 perlthrtut - tutorial on threads in Perl + +=over + +=item DESCRIPTION + +=item What Is A Thread Anyway? + +=item Threaded Program Models + +=over + +=item Boss/Worker + +=item Work Crew + +=item Pipeline + +=back + +=item Native threads + +=item What kind of threads are perl threads? + +=item Threadsafe Modules + +=item Thread Basics + +=over + +=item Basic Thread Support + +=item Creating Threads + +=item Giving up control + +=item Waiting For A Thread To Exit + +=item Errors In Threads + +=item Ignoring A Thread + +=back + +=item Threads And Data + +=over + +=item Shared And Unshared Data + +=item Thread Pitfall: Races + +=item Controlling access: lock() + +=item Thread Pitfall: Deadlocks + +=item Queues: Passing Data Around + +=back + +=item Threads And Code + +=over + +=item Semaphores: Synchronizing Data Access + +Basic semaphores, Advanced Semaphores + +=item Attributes: Restricting Access To Subroutines + +=item Subroutine Locks + +=item Methods + +=item Locking A Subroutine + +=back + +=item General Thread Utility Routines + +=over + +=item What Thread Am I In? + +=item Thread IDs + +=item Are These Threads The Same? + +=item What Threads Are Running? + +=back + +=item A Complete Example + +=item Conclusion + +=item Bibliography + +=over + +=item Introductory Texts + +=item OS-Related References + +=item Other References + +=back + +=item Acknowledgements + +=item AUTHOR + +=item Copyrights + +=back + +=head2 perlport - Writing portable Perl + +=over + +=item DESCRIPTION + +Not all Perl programs have to be portable, Nearly all of Perl already I<is> +portable + +=item ISSUES + +=over + +=item Newlines + +=item Numbers endianness and Width + +=item Files and Filesystems + +=item System Interaction + +=item Interprocess Communication (IPC) + +=item External Subroutines (XS) + +=item Standard Modules + +=item Time and Date + +=item Character sets and character encoding + +=item Internationalisation + +=item System Resources + +=item Security + +=item Style + +=back + +=item CPAN Testers + +Mailing list: cpan-testers@perl.org, Testing results: +http://testers.cpan.org/ + +=item PLATFORMS + +=over + +=item Unix + +=item DOS and Derivatives + +Build instructions for OS/2, L<perlos2> + +=item S<Mac OS> + +=item VMS + +=item VOS + +=item EBCDIC Platforms + +=item Acorn RISC OS + +=item Other perls + +=back + +=item FUNCTION IMPLEMENTATIONS + +=over + +=item Alphabetical Listing of Perl Functions + +-I<X> FILEHANDLE, -I<X> EXPR, -I<X>, alarm SECONDS, alarm, binmode +FILEHANDLE, chmod LIST, chown LIST, chroot FILENAME, chroot, crypt +PLAINTEXT,SALT, dbmclose HASH, dbmopen HASH,DBNAME,MODE, dump LABEL, exec +LIST, fcntl FILEHANDLE,FUNCTION,SCALAR, flock FILEHANDLE,OPERATION, fork, +getlogin, getpgrp PID, getppid, getpriority WHICH,WHO, getpwnam NAME, +getgrnam NAME, getnetbyname NAME, getpwuid UID, getgrgid GID, getnetbyaddr +ADDR,ADDRTYPE, getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent, +getgrent, gethostent, getnetent, getprotoent, getservent, setpwent, +setgrent, sethostent STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, +setservent STAYOPEN, endpwent, endgrent, endhostent, endnetent, +endprotoent, endservent, getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, +ioctl FILEHANDLE,FUNCTION,SCALAR, kill SIGNAL, LIST, link OLDFILE,NEWFILE, +lstat FILEHANDLE, lstat EXPR, lstat, msgctl ID,CMD,ARG, msgget KEY,FLAGS, +msgsnd ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, open FILEHANDLE,EXPR, +open FILEHANDLE, pipe READHANDLE,WRITEHANDLE, readlink EXPR, readlink, +select RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget +KEY,NSEMS,FLAGS, semop KEY,OPSTRING, setgrent, setpgrp PID,PGRP, +setpriority WHICH,WHO,PRIORITY, setpwent, setsockopt +SOCKET,LEVEL,OPTNAME,OPTVAL, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, +shmread ID,VAR,POS,SIZE, shmwrite ID,STRING,POS,SIZE, socketpair +SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, stat FILEHANDLE, stat EXPR, stat, +symlink OLDFILE,NEWFILE, syscall LIST, sysopen +FILEHANDLE,FILENAME,MODE,PERMS, system LIST, times, truncate +FILEHANDLE,LENGTH, truncate EXPR,LENGTH, umask EXPR, umask, utime LIST, +wait, waitpid PID,FLAGS + +=back + +=item CHANGES + +v1.47, 22 March 2000, v1.46, 12 February 2000, v1.45, 20 December 1999, +v1.44, 19 July 1999, v1.43, 24 May 1999, v1.42, 22 May 1999, v1.41, 19 May +1999, v1.40, 11 April 1999, v1.39, 11 February 1999, v1.38, 31 December +1998, v1.37, 19 December 1998, v1.36, 9 September 1998, v1.35, 13 August +1998, v1.33, 06 August 1998, v1.32, 05 August 1998, v1.30, 03 August 1998, +v1.23, 10 July 1998 + +=item Supported Platforms + +=item SEE ALSO + +=item AUTHORS / CONTRIBUTORS + +=item VERSION + +=back + +=head2 perlsec - Perl security + +=over + +=item DESCRIPTION + +=over + +=item Laundering and Detecting Tainted Data + +=item Switches On the "#!" Line + +=item Cleaning Up Your Path + +=item Security Bugs + +=item Protecting Your Programs + +=back + +=item SEE ALSO + +=back + +=head2 perlboot - Beginner's Object-Oriented Tutorial + +=over + +=item DESCRIPTION + +=over + +=item If we could talk to the animals... + +=item Introducing the method invocation arrow + +=item Invoking a barnyard + +=item The extra parameter of method invocation + +=item Calling a second method to simplify things + +=item Inheriting the windpipes + +=item A few notes about @ISA + +=item Overriding the methods + +=item Starting the search from a different place + +=item The SUPER way of doing things + +=item Where we're at so far... + +=item A horse is a horse, of course of course -- or is it? + +=item Invoking an instance method + +=item Accessing the instance data + +=item How to build a horse + +=item Inheriting the constructor + +=item Making a method work with either classes or instances + +=item Adding parameters to a method + +=item More interesting instances + +=item A horse of a different color + +=item Summary + +=back + +=item SEE ALSO + +=item COPYRIGHT + +=back + +=head2 perltoot - Tom's object-oriented tutorial for perl + +=over + +=item DESCRIPTION + +=item Creating a Class + +=over + +=item Object Representation + +=item Class Interface + +=item Constructors and Instance Methods + +=item Planning for the Future: Better Constructors + +=item Destructors + +=item Other Object Methods + +=back + +=item Class Data + +=over + +=item Accessing Class Data + +=item Debugging Methods + +=item Class Destructors + +=item Documenting the Interface + +=back + +=item Aggregation + +=item Inheritance + +=over + +=item Overridden Methods + +=item Multiple Inheritance + +=item UNIVERSAL: The Root of All Objects + +=back + +=item Alternate Object Representations + +=over + +=item Arrays as Objects + +=item Closures as Objects + +=back + +=item AUTOLOAD: Proxy Methods + +=over + +=item Autoloaded Data Methods + +=item Inherited Autoloaded Data Methods + +=back + +=item Metaclassical Tools + +=over + +=item Class::Struct + +=item Data Members as Variables + +=item NOTES + +=item Object Terminology + +=back + +=item SEE ALSO + +=item AUTHOR AND COPYRIGHT + +=item COPYRIGHT + +=over + +=item Acknowledgments + +=back + +=back + +=head2 perltootc - Tom's OO Tutorial for Class Data in Perl + +=over + +=item DESCRIPTION + +=item Class Data as Package Variables + +=over + +=item Putting All Your Eggs in One Basket + +=item Inheritance Concerns + +=item The Eponymous Meta-Object + +=item Indirect References to Class Data + +=item Monadic Classes + +=item Translucent Attributes + +=back + +=item Class Data as Lexical Variables + +=over + +=item Privacy and Responsibility + +=item File-Scoped Lexicals + +=item More Inheritance Concerns + +=item Locking the Door and Throwing Away the Key + +=item Translucency Revisited + +=back + +=item NOTES + +=item SEE ALSO + +=item AUTHOR AND COPYRIGHT + +=item ACKNOWLEDGEMENTS + +=item HISTORY + +=back + +=head2 perlobj - Perl objects + +=over + +=item DESCRIPTION + +=over + +=item An Object is Simply a Reference + +=item A Class is Simply a Package + +=item A Method is Simply a Subroutine + +=item Method Invocation + +=item WARNING + +=item Default UNIVERSAL methods + +isa(CLASS), can(METHOD), VERSION( [NEED] ) + +=item Destructors + +=item Summary + +=item Two-Phased Garbage Collection + +=back + +=item SEE ALSO + +=back + +=head2 perlbot - Bag'o Object Tricks (the BOT) + +=over + +=item DESCRIPTION + +=item OO SCALING TIPS + +=item INSTANCE VARIABLES + +=item SCALAR INSTANCE VARIABLES + +=item INSTANCE VARIABLE INHERITANCE + +=item OBJECT RELATIONSHIPS + +=item OVERRIDING SUPERCLASS METHODS + +=item USING RELATIONSHIP WITH SDBM + +=item THINKING OF CODE REUSE + +=item CLASS CONTEXT AND THE OBJECT + +=item INHERITING A CONSTRUCTOR + +=item DELEGATION + +=back + +=head2 perltie - how to hide an object class in a simple variable + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Tying Scalars + +TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this + +=item Tying Arrays + +TIEARRAY classname, LIST, FETCH this, index, STORE this, index, value, +DESTROY this + +=item Tying Hashes + +USER, HOME, CLOBBER, LIST, TIEHASH classname, LIST, FETCH this, key, STORE +this, key, value, DELETE this, key, CLEAR this, EXISTS this, key, FIRSTKEY +this, NEXTKEY this, lastkey, DESTROY this + +=item Tying FileHandles + +TIEHANDLE classname, LIST, WRITE this, LIST, PRINT this, LIST, PRINTF this, +LIST, READ this, LIST, READLINE this, GETC this, CLOSE this, DESTROY this + +=item The C<untie> Gotcha + +=back + +=item SEE ALSO + +=item BUGS + +=item AUTHOR + +=back + +=head2 perlmod - Perl modules (packages and symbol tables) + +=over + +=item DESCRIPTION + +=over + +=item Packages + +=item Symbol Tables + +=item Package Constructors and Destructors + +=item Perl Classes + +=item Perl Modules + +=back + +=item SEE ALSO + +=back + +=head2 perlmodlib - constructing new Perl modules and finding existing ones + +=over + +=item DESCRIPTION + +=item THE PERL MODULE LIBRARY + +=over + +=item Pragmatic Modules + +attributes, attrs, autouse, base, blib, bytes, charnames, constant, +diagnostics, fields, filetest, integer, less, lib, locale, open, ops, +overload, re, sigtrap, strict, subs, utf8, vars, warnings + +=item Standard Modules + +AnyDBM_File, AutoLoader, AutoSplit, B, B::Asmdata, B::Assembler, B::Bblock, +B::Bytecode, B::C, B::CC, B::Debug, B::Deparse, B::Disassembler, B::Lint, +B::Showlex, B::Stackobj, B::Terse, B::Xref, Benchmark, ByteLoader, CGI, +CGI::Apache, CGI::Carp, CGI::Cookie, CGI::Fast, CGI::Pretty, CGI::Push, +CGI::Switch, CPAN, CPAN::FirstTime, CPAN::Nox, Carp, Carp::Heavy, +Class::Struct, Cwd, DB, DB_File, Devel::SelfStubber, DirHandle, Dumpvalue, +English, Env, Exporter, Exporter::Heavy, ExtUtils::Command, +ExtUtils::Embed, ExtUtils::Install, ExtUtils::Installed, ExtUtils::Liblist, +ExtUtils::MM_Cygwin, ExtUtils::MM_OS2, ExtUtils::MM_Unix, ExtUtils::MM_VMS, +ExtUtils::MM_Win32, ExtUtils::MakeMaker, ExtUtils::Manifest, +ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::Packlist, +ExtUtils::testlib, Fatal, Fcntl, File::Basename, File::CheckTree, +File::Compare, File::Copy, File::DosGlob, File::Find, File::Path, +File::Spec, File::Spec::Functions, File::Spec::Mac, File::Spec::OS2, +File::Spec::Unix, File::Spec::VMS, File::Spec::Win32, File::Temp, +File::stat, FileCache, FileHandle, FindBin, Getopt::Long, Getopt::Std, +I18N::Collate, IO, IPC::Open2, IPC::Open3, Math::BigFloat, Math::BigInt, +Math::Complex, Math::Trig, NDBM_File, Net::Ping, Net::hostent, Net::netent, +Net::protoent, Net::servent, O, ODBM_File, Opcode, Pod::Checker, Pod::Find, +Pod::Html, Pod::InputObjects, Pod::Man, Pod::ParseUtils, Pod::Parser, +Pod::Plainer, Pod::Select, Pod::Text, Pod::Text::Color, Pod::Text::Termcap, +Pod::Usage, SDBM_File, Safe, Search::Dict, SelectSaver, SelfLoader, Shell, +Socket, Symbol, Term::ANSIColor, Term::Cap, Term::Complete, Term::ReadLine, +Test, Test::Harness, Text::Abbrev, Text::ParseWords, Text::Soundex, +Text::Wrap, Tie::Array, Tie::Handle, Tie::Hash, Tie::RefHash, Tie::Scalar, +Tie::SubstrHash, Time::Local, Time::gmtime, Time::localtime, Time::tm, +UNIVERSAL, User::grent, User::pwent + +=item Extension Modules + +=back + +=item CPAN + +Language Extensions and Documentation Tools, Development Support, Operating +System Interfaces, Networking, Device Control (modems) and InterProcess +Communication, Data Types and Data Type Utilities, Database Interfaces, +User Interfaces, Interfaces to / Emulations of Other Programming Languages, +File Names, File Systems and File Locking (see also File Handles), String +Processing, Language Text Processing, Parsing, and Searching, Option, +Argument, Parameter, and Configuration File Processing, +Internationalization and Locale, Authentication, Security, and Encryption, +World Wide Web, HTML, HTTP, CGI, MIME, Server and Daemon Utilities, +Archiving and Compression, Images, Pixmap and Bitmap Manipulation, Drawing, +and Graphing, Mail and Usenet News, Control Flow Utilities (callbacks and +exceptions etc), File Handle and Input/Output Stream Utilities, +Miscellaneous Modules, Africa, Asia, Australasia, Central America, Europe, +North America, South America + +=item Modules: Creation, Use, and Abuse + +=over + +=item Guidelines for Module Creation + +Do similar modules already exist in some form?, Try to design the new +module to be easy to extend and reuse, Some simple style guidelines, Select +what to export, Select a name for the module, Have you got it right?, +README and other Additional Files, A description of the +module/package/extension etc, A copyright notice - see below, Prerequisites +- what else you may need to have, How to build it - possible changes to +Makefile.PL etc, How to install it, Recent changes in this release, +especially incompatibilities, Changes / enhancements you plan to make in +the future, Adding a Copyright Notice, Give the module a +version/issue/release number, How to release and distribute a module, Take +care when changing a released module + +=item Guidelines for Converting Perl 4 Library Scripts into Modules + +There is no requirement to convert anything, Consider the implications, +Make the most of the opportunity, The pl2pm utility will get you started, +Adds the standard Module prologue lines, Converts package specifiers from ' +to ::, Converts die(...) to croak(...), Several other minor changes + +=item Guidelines for Reusing Application Code + +Complete applications rarely belong in the Perl Module Library, Many +applications contain some Perl code that could be reused, Break-out the +reusable code into one or more separate module files, Take the opportunity +to reconsider and redesign the interfaces, In some cases the 'application' +can then be reduced to a small + +=back + +=item NOTE + +=back + +=head2 perlmodinstall - Installing CPAN Modules + +=over + +=item DESCRIPTION + +=over + +=item PREAMBLE + +B<DECOMPRESS> the file, B<UNPACK> the file into a directory, B<BUILD> the +module (sometimes unnecessary), B<INSTALL> the module + +=back + +=item HEY + +=item AUTHOR + +=item COPYRIGHT + +=back + +=head2 perlnewmod - preparing a new module for distribution + +=over + +=item DESCRIPTION + +=over + +=item Warning + +=item What should I make into a module? + +=item Step-by-step: Preparing the ground + +Look around, Check it's new, Discuss the need, Choose a name, Check again + +=item Step-by-step: Making the module + +Start with F<h2xs>, Use L<strict|strict> and L<warnings|warnings>, Use +L<Carp|Carp>, Use L<Exporter|Exporter> - wisely!, Use L<plain old +documentation|perlpod>, Write tests, Write the README + +=item Step-by-step: Distributing your module + +Get a CPAN user ID, C<perl Makefile.PL; make test; make dist>, Upload the +tarball, Announce to the modules list, Announce to clpa, Fix bugs! + +=back + +=item AUTHOR + +=item SEE ALSO + +=back + =head2 perlfaq1 - General Questions About Perl ($Revision: 1.23 $, $Date: 1999/05/23 16:08:30 $) @@ -600,7 +2792,7 @@ the tag =item How can I remove duplicate elements from a list or array? -a) If @in is sorted, and you want @out to be sorted:(this assumes all true +a) If @in is sorted, and you want @out to be sorted: (this assumes all true values in the array), b) If you don't know whether @in is sorted:, c) Like (b), but @in contains only small integers:, d) A way to do (b) without any loops or greps:, e) Like (d), but @in contains only small positive @@ -1129,633 +3321,570 @@ CGI script to do bad things? =back -=head2 perldelta - what's new for perl v5.6.0 +=head2 perlcompile - Introduction to the Perl Compiler-Translator =over =item DESCRIPTION -=item Core Enhancements - =over -=item Interpreter cloning, threads, and concurrency - -=item Lexically scoped warning categories +=item Layout -=item Unicode and UTF-8 support +B::Bytecode, B::C, B::CC, B::Lint, B::Deparse, B::Xref -=item Support for interpolating named characters +=back -=item "our" declarations +=item Using The Back Ends -=item Support for strings represented as a vector of ordinals +=over -=item Improved Perl version numbering system +=item The Cross Referencing Back End -=item New syntax for declaring subroutine attributes +i, &, s, r -=item File and directory handles can be autovivified +=item The Decompiling Back End -=item open() with more than two arguments +=item The Lint Back End -=item 64-bit support +=item The Simple C Back End -=item Large file support +=item The Bytecode Back End -=item Long doubles +=item The Optimized C Back End -=item "more bits" +B, O, B::Asmdata, B::Assembler, B::Bblock, B::Bytecode, B::C, B::CC, +B::Debug, B::Deparse, B::Disassembler, B::Lint, B::Showlex, B::Stackobj, +B::Stash, B::Terse, B::Xref -=item Enhanced support for sort() subroutines +=back -=item C<sort $coderef @foo> allowed +=item KNOWN PROBLEMS -=item File globbing implemented internally +=item AUTHOR -Support for CHECK blocks +=back -=item POSIX character class syntax [: :] supported +=head2 perlembed - how to embed perl in your C program -Better pseudo-random number generator +=over -=item Improved C<qw//> operator +=item DESCRIPTION -Better worst-case behavior of hashes +=over -=item pack() format 'Z' supported +=item PREAMBLE -=item pack() format modifier '!' supported +B<Use C from Perl?>, B<Use a Unix program from Perl?>, B<Use Perl from +Perl?>, B<Use C from C?>, B<Use Perl from C?> -=item pack() and unpack() support counted strings +=item ROADMAP -=item Comments in pack() templates +=item Compiling your C program -=item Weak references +=item Adding a Perl interpreter to your C program -=item Binary numbers supported +=item Calling a Perl subroutine from your C program -=item Lvalue subroutines +=item Evaluating a Perl statement from your C program -=item Some arrows may be omitted in calls through references +=item Performing Perl pattern matches and substitutions from your C program -=item Boolean assignment operators are legal lvalues +=item Fiddling with the Perl stack from your C program -=item exists() is supported on subroutine names +=item Maintaining a persistent interpreter -=item exists() and delete() are supported on array elements +=item Maintaining multiple interpreter instances -=item Pseudo-hashes work better +=item Using Perl modules, which themselves use C libraries, from your C +program -=item Automatic flushing of output buffers +=back -=item Better diagnostics on meaningless filehandle operations +=item Embedding Perl under Windows -=item Where possible, buffered data discarded from duped input filehandle +=item MORAL -=item eof() has the same old magic as <> +=item AUTHOR -=item binmode() can be used to set :crlf and :raw modes +=item COPYRIGHT -=item C<-T> filetest recognizes UTF-8 encoded files as "text" +=back -=item system(), backticks and pipe open now reflect exec() failure +=head2 perldebguts - Guts of Perl debugging -=item Improved diagnostics +=over -=item Diagnostics follow STDERR +=item DESCRIPTION -More consistent close-on-exec behavior +=item Debugger Internals -=item syswrite() ease-of-use +=over -=item Better syntax checks on parenthesized unary operators +=item Writing Your Own Debugger -=item Bit operators support full native integer width +=back -=item Improved security features +=item Frame Listing Output Examples -More functional bareword prototype (*) +=item Debugging regular expressions -=item C<require> and C<do> may be overridden +=over -=item $^X variables may now have names longer than one character +=item Compile-time output -=item New variable $^C reflects C<-c> switch +C<anchored> I<STRING> C<at> I<POS>, C<floating> I<STRING> C<at> +I<POS1..POS2>, C<matching floating/anchored>, C<minlen>, C<stclass> +I<TYPE>, C<noscan>, C<isall>, C<GPOS>, C<plus>, C<implicit>, C<with eval>, +C<anchored(TYPE)> -=item New variable $^V contains Perl version as a string +=item Types of nodes -=item Optional Y2K warnings +=item Run-time output =back -=item Modules and Pragmata +=item Debugging Perl memory usage =over -=item Modules +=item Using C<$ENV{PERL_DEBUG_MSTATS}> -attributes, B, Benchmark, ByteLoader, constant, charnames, Data::Dumper, -DB, DB_File, Devel::DProf, Devel::Peek, Dumpvalue, DynaLoader, English, -Env, Fcntl, File::Compare, File::Find, File::Glob, File::Spec, -File::Spec::Functions, Getopt::Long, IO, JPL, lib, Math::BigInt, -Math::Complex, Math::Trig, Pod::Parser, Pod::InputObjects, Pod::Checker, -podchecker, Pod::ParseUtils, Pod::Find, Pod::Select, podselect, Pod::Usage, -pod2usage, Pod::Text and Pod::Man, SDBM_File, Sys::Syslog, Sys::Hostname, -Term::ANSIColor, Time::Local, Win32, XSLoader, DBM Filters +C<buckets SMALLEST(APPROX)..GREATEST(APPROX)>, Free/Used, C<Total sbrk(): +SBRKed/SBRKs:CONTINUOUS>, C<pad: 0>, C<heads: 2192>, C<chain: 0>, C<tail: +6144> -=item Pragmata +=item Example of using B<-DL> switch + +C<717>, C<002>, C<054>, C<602>, C<702>, C<704> + +=item B<-DL> details + +C<!!!>, C<!!>, C<!> + +=item Limitations of B<-DL> statistics =back -=item Utility Changes +=item SEE ALSO + +=back + +=head2 perlxstut, perlXStut - Tutorial for writing XSUBs =over -=item dprofpp +=item DESCRIPTION -=item find2perl +=item SPECIAL NOTES -=item h2xs +=over -=item perlcc +=item make -=item perldoc +=item Version caveat -=item The Perl Debugger +=item Dynamic Loading versus Static Loading =back -=item Improved Documentation +=item TUTORIAL -perlapi.pod, perlboot.pod, perlcompile.pod, perldbmfilter.pod, -perldebug.pod, perldebguts.pod, perlfork.pod, perlfilter.pod, perlhack.pod, -perlintern.pod, perllexwarn.pod, perlnumber.pod, perlopentut.pod, -perlreftut.pod, perltootc.pod, perltodo.pod, perlunicode.pod +=over -=item Performance enhancements +=item EXAMPLE 1 -=over +=item EXAMPLE 2 -=item Simple sort() using { $a <=> $b } and the like are optimized +=item What has gone on? -=item Optimized assignments to lexical variables +=item Writing good test scripts -=item Faster subroutine calls +=item EXAMPLE 3 -delete(), each(), values() and hash iteration are faster +=item What's new here? -=back +=item Input and Output Parameters -=item Installation and Configuration Improvements +=item The XSUBPP Program -=over +=item The TYPEMAP file -=item -Dusethreads means something different +=item Warning about Output Arguments -=item New Configure flags +=item EXAMPLE 4 -=item Threadedness and 64-bitness now more daring +=item What has happened here? -=item Long Doubles +=item Anatomy of .xs file -=item -Dusemorebits +=item Getting the fat out of XSUBs -=item -Duselargefiles +=item More about XSUB arguments -=item installusrbinperl +=item The Argument Stack -=item SOCKS support +=item Extending your Extension -=item C<-A> flag +=item Documenting your Extension -=item Enhanced Installation Directories +=item Installing your Extension -=back +=item EXAMPLE 5 -=item Platform specific changes +=item New Things in this Example -=over +=item EXAMPLE 6 -=item Supported platforms +=item New Things in this Example -=item DOS +=item EXAMPLE 7 (Coming Soon) -=item OS390 (OpenEdition MVS) +=item EXAMPLE 8 (Coming Soon) -=item VMS +=item EXAMPLE 9 (Coming Soon) -=item Win32 +=item Troubleshooting these Examples =back -=item Significant bug fixes +=item See also + +=item Author =over -=item <HANDLE> on empty files +=item Last Changed -=item C<eval '...'> improvements +=back -=item All compilation errors are true errors +=back -=item Implicitly closed filehandles are safer +=head2 perlxs - XS language reference manual -=item Behavior of list slices is more consistent +=over -=item C<(\$)> prototype and C<$foo{a}> +=item DESCRIPTION -=item C<goto &sub> and AUTOLOAD +=over -=item C<-bareword> allowed under C<use integer> +=item Introduction -=item Failures in DESTROY() +=item On The Road -=item Locale bugs fixed +=item The Anatomy of an XSUB -=item Memory leaks +=item The Argument Stack -=item Spurious subroutine stubs after failed subroutine calls +=item The RETVAL Variable -=item Taint failures under C<-U> +=item The MODULE Keyword -=item END blocks and the C<-c> switch +=item The PACKAGE Keyword -=item Potential to leak DATA filehandles +=item The PREFIX Keyword -=back +=item The OUTPUT: Keyword -=item New or Changed Diagnostics +=item The CODE: Keyword -"%s" variable %s masks earlier declaration in same %s, "my sub" not yet -implemented, "our" variable %s redeclared, '!' allowed only after types %s, -/ cannot take a count, / must be followed by a, A or Z, / must be followed -by a*, A* or Z*, / must follow a numeric type, /%s/: Unrecognized escape -\\%c passed through, /%s/: Unrecognized escape \\%c in character class -passed through, /%s/ should probably be written as "%s", %s() called too -early to check prototype, %s argument is not a HASH or ARRAY element, %s -argument is not a HASH or ARRAY element or slice, %s argument is not a -subroutine name, %s package attribute may clash with future reserved word: -%s, (in cleanup) %s, <> should be quotes, Attempt to join self, Bad evalled -substitution pattern, Bad realloc() ignored, Bareword found in conditional, -Binary number > 0b11111111111111111111111111111111 non-portable, Bit vector -size > 32 non-portable, Buffer overflow in prime_env_iter: %s, Can't check -filesystem of script "%s", Can't declare class for non-scalar %s in "%s", -Can't declare %s in "%s", Can't ignore signal CHLD, forcing to default, -Can't modify non-lvalue subroutine call, Can't read CRTL environ, Can't -remove %s: %s, skipping file, Can't return %s from lvalue subroutine, Can't -weaken a nonreference, Character class [:%s:] unknown, Character class -syntax [%s] belongs inside character classes, Constant is not %s reference, -constant(%s): %s, CORE::%s is not a keyword, defined(@array) is deprecated, -defined(%hash) is deprecated, Did not produce a valid header, (Did you mean -"local" instead of "our"?), Document contains no data, entering effective -%s failed, false [] range "%s" in regexp, Filehandle %s opened only for -output, flock() on closed filehandle %s, Global symbol "%s" requires -explicit package name, Hexadecimal number > 0xffffffff non-portable, -Ill-formed CRTL environ value "%s", Ill-formed message in prime_env_iter: -|%s|, Illegal binary digit %s, Illegal binary digit %s ignored, Illegal -number of bits in vec, Integer overflow in %s number, Invalid %s attribute: -%s, Invalid %s attributes: %s, invalid [] range "%s" in regexp, Invalid -separator character %s in attribute list, Invalid separator character %s in -subroutine attribute list, leaving effective %s failed, Lvalue subs -returning %s not implemented yet, Method %s not permitted, Missing -%sbrace%s on \N{}, Missing command in piped open, Missing name in "my sub", -No %s specified for -%c, No package name allowed for variable %s in "our", -No space allowed after -%c, no UTC offset information; assuming local time -is UTC, Octal number > 037777777777 non-portable, panic: del_backref, -panic: kid popen errno read, panic: magic_killbackrefs, Parentheses missing -around "%s" list, Possible Y2K bug: %s, pragma "attrs" is deprecated, use -"sub NAME : ATTRS" instead, Premature end of script headers, Repeat count -in pack overflows, Repeat count in unpack overflows, realloc() of freed -memory ignored, Reference is already weak, setpgrp can't take arguments, -Strange *+?{} on zero-length expression, switching effective %s is not -implemented, This Perl can't reset CRTL environ elements (%s), This Perl -can't set CRTL environ elements (%s=%s), Too late to run %s block, Unknown -open() mode '%s', Unknown process %x sent message to prime_env_iter: %s, -Unrecognized escape \\%c passed through, Unterminated attribute parameter -in attribute list, Unterminated attribute list, Unterminated attribute -parameter in subroutine attribute list, Unterminated subroutine attribute -list, Value of CLI symbol "%s" too long, Version number must be a constant -number +=item The INIT: Keyword -=item New tests +=item The NO_INIT Keyword -=item Incompatible Changes +=item Initializing Function Parameters -=over +=item Default Parameter Values -=item Perl Source Incompatibilities +=item The PREINIT: Keyword -CHECK is a new keyword, Treatment of list slices of undef has changed +=item The SCOPE: Keyword -=item Format of $English::PERL_VERSION is different +=item The INPUT: Keyword -Literals of the form C<1.2.3> parse differently, Possibly changed -pseudo-random number generator, Hashing function for hash keys has changed, -C<undef> fails on read only values, Close-on-exec bit may be set on pipe -and socket handles, Writing C<"$$1"> to mean C<"${$}1"> is unsupported, -delete(), values() and C<\(%h)> operate on aliases to values, not copies, -vec(EXPR,OFFSET,BITS) enforces powers-of-two BITS, Text of some diagnostic -output has changed, C<%@> has been removed, Parenthesized not() behaves -like a list operator, Semantics of bareword prototype C<(*)> have changed +=item Variable-length Parameter Lists -=item Semantics of bit operators may have changed on 64-bit platforms +=item The C_ARGS: Keyword -=item More builtins taint their results +=item The PPCODE: Keyword -=item C Source Incompatibilities +=item Returning Undef And Empty Lists -C<PERL_POLLUTE>, C<PERL_IMPLICIT_CONTEXT>, C<PERL_POLLUTE_MALLOC> +=item The REQUIRE: Keyword -=item Compatible C Source API Changes +=item The CLEANUP: Keyword -C<PATCHLEVEL> is now C<PERL_VERSION> +=item The BOOT: Keyword -=item Binary Incompatibilities +=item The VERSIONCHECK: Keyword -=back +=item The PROTOTYPES: Keyword -=item Known Problems +=item The PROTOTYPE: Keyword -=over +=item The ALIAS: Keyword -=item Thread test failures +=item The INTERFACE: Keyword -=item EBCDIC platforms not supported +=item The INTERFACE_MACRO: Keyword -=item In 64-bit HP-UX the lib/io_multihomed test may hang +=item The INCLUDE: Keyword -=item NEXTSTEP 3.3 POSIX test failure +=item The CASE: Keyword -=item Tru64 (aka Digital UNIX, aka DEC OSF/1) lib/sdbm test failure with -gcc +=item The & Unary Operator -=item UNICOS/mk CC failures during Configure run +=item Inserting Comments and C Preprocessor Directives -=item Arrow operator and arrays +=item Using XS With C++ -=item Windows 2000 +=item Interface Strategy -=item Experimental features +=item Perl Objects And C Structures -Threads, Unicode, 64-bit support, Lvalue subroutines, Weak references, The -pseudo-hash data type, The Compiler suite, Internal implementation of file -globbing, The DB module, The regular expression constructs C<(?{ code })> -and C<(??{ code })> +=item The Typemap =back -=item Obsolete Diagnostics - -Character class syntax [: :] is reserved for future extensions, Ill-formed -logical name |%s| in prime_env_iter, Probable precedence problem on %s, -regexp too big, Use of "$$<digit>" to mean "${$}<digit>" is deprecated - -=item Reporting Bugs +=item EXAMPLES -=item SEE ALSO +=item XS VERSION -=item HISTORY +=item AUTHOR =back -=head2 perldata - Perl data types +=head2 perlguts - Introduction to the Perl API =over =item DESCRIPTION -=over +=item Variables -=item Variable names +=over -=item Context +=item Datatypes -=item Scalar values +=item What is an "IV"? -=item Scalar value constructors +=item Working with SVs -=item List value constructors +=item What's Really Stored in an SV? -=item Slices +=item Working with AVs -=item Typeglobs and Filehandles +=item Working with HVs -=back +=item Hash API Extensions -=item SEE ALSO +=item References -=back +=item Blessed References and Class Objects -=head2 perlsyn - Perl syntax +=item Creating New Variables -=over +=item Reference Counts and Mortality -=item DESCRIPTION +=item Stashes and Globs -=over +=item Double-Typed SVs -=item Declarations +=item Magic Variables -=item Simple statements +=item Assigning Magic -=item Compound statements +=item Magic Virtual Tables -=item Loop Control +=item Finding Magic -=item For Loops +=item Understanding the Magic of Tied Hashes and Arrays -=item Foreach Loops +=item Localizing changes -=item Basic BLOCKs and Switch Statements +C<SAVEINT(int i)>, C<SAVEIV(IV i)>, C<SAVEI32(I32 i)>, C<SAVELONG(long i)>, +C<SAVESPTR(s)>, C<SAVEPPTR(p)>, C<SAVEFREESV(SV *sv)>, C<SAVEFREEOP(OP +*op)>, C<SAVEFREEPV(p)>, C<SAVECLEARSV(SV *sv)>, C<SAVEDELETE(HV *hv, char +*key, I32 length)>, C<SAVEDESTRUCTOR(DESTRUCTORFUNC_NOCONTEXT_t f, void +*p)>, C<SAVEDESTRUCTOR_X(DESTRUCTORFUNC_t f, void *p)>, C<SAVESTACK_POS()>, +C<SV* save_scalar(GV *gv)>, C<AV* save_ary(GV *gv)>, C<HV* save_hash(GV +*gv)>, C<void save_item(SV *item)>, C<void save_list(SV **sarg, I32 +maxsarg)>, C<SV* save_svref(SV **sptr)>, C<void save_aptr(AV **aptr)>, +C<void save_hptr(HV **hptr)> -=item Goto +=back -=item PODs: Embedded Documentation +=item Subroutines -=item Plain Old Comments (Not!) +=over -=back +=item XSUBs and the Argument Stack -=back +=item Calling Perl Routines from within C Programs -=head2 perlop - Perl operators and precedence +=item Memory Allocation -=over +=item PerlIO -=item SYNOPSIS +=item Putting a C value on Perl stack -=item DESCRIPTION +=item Scratchpads -=over +=item Scratchpads and recursion -=item Terms and List Operators (Leftward) +=back -=item The Arrow Operator +=item Compiled code -=item Auto-increment and Auto-decrement +=over -=item Exponentiation +=item Code tree -=item Symbolic Unary Operators +=item Examining the tree -=item Binding Operators +=item Compile pass 1: check routines -=item Multiplicative Operators +=item Compile pass 1a: constant folding -=item Additive Operators +=item Compile pass 2: context propagation -=item Shift Operators +=item Compile pass 3: peephole optimization -=item Named Unary Operators +=back -=item Relational Operators +=item How multiple interpreters and concurrency are supported -=item Equality Operators +=over -=item Bitwise And +=item Background and PERL_IMPLICIT_CONTEXT -=item Bitwise Or and Exclusive Or +=item How do I use all this in extensions? -=item C-style Logical And +=item Future Plans and PERL_IMPLICIT_SYS -=item C-style Logical Or +=back -=item Range Operators +=item Internal Functions -=item Conditional Operator +A, p, d, s, n, r, f, m, o, j, x -=item Assignment Operators +=over -=item Comma Operator +=item Source Documentation -=item List Operators (Rightward) +=back -=item Logical Not +=item Unicode Support -=item Logical And +=over -=item Logical or and Exclusive Or +=item What B<is> Unicode, anyway? -=item C Operators Missing From Perl +=item How can I recognise a UTF8 string? -unary &, unary *, (TYPE) +=item How does UTF8 represent Unicode characters? -=item Quote and Quote-like Operators +=item How does Perl store UTF8 strings? -=item Regexp Quote-Like Operators +=item How do I convert a string to UTF8? -?PATTERN?, m/PATTERN/cgimosx, /PATTERN/cgimosx, q/STRING/, C<'STRING'>, -qq/STRING/, "STRING", qr/STRING/imosx, qx/STRING/, `STRING`, qw/STRING/, -s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cdsUC, -y/SEARCHLIST/REPLACEMENTLIST/cdsUC +=item Is there anything else I need to know? -=item Gory details of parsing quoted constructs +=back -Finding the end, Removal of backslashes before delimiters, Interpolation, -C<<<'EOF'>, C<m''>, C<s'''>, C<tr///>, C<y///>, C<''>, C<q//>, C<"">, -C<``>, C<qq//>, C<qx//>, C<< <file*glob> >>, C<?RE?>, C</RE/>, C<m/RE/>, -C<s/RE/foo/>,, Interpolation of regular expressions, Optimization of -regular expressions +=item AUTHORS -=item I/O Operators +=item SEE ALSO -=item Constant Folding +=back -=item Bitwise String Operators +=head2 perlcall - Perl calling conventions from C -=item Integer Arithmetic +=over -=item Floating-point Arithmetic +=item DESCRIPTION -=item Bigger Numbers +An Error Handler, An Event Driven Program -=back +=item THE CALL_ FUNCTIONS -=back +call_sv, call_pv, call_method, call_argv -=head2 perlre - Perl regular expressions +=item FLAG VALUES =over -=item DESCRIPTION +=item G_VOID -i, m, s, x +=item G_SCALAR -=over +=item G_ARRAY -=item Regular Expressions +=item G_DISCARD -cntrl, graph, print, punct, xdigit +=item G_NOARGS -=item Extended Patterns +=item G_EVAL -C<(?#text)>, C<(?imsx-imsx)>, C<(?:pattern)>, C<(?imsx-imsx:pattern)>, -C<(?=pattern)>, C<(?!pattern)>, C<(?<=pattern)>, C<(?<!pattern)>, C<(?{ -code })>, C<(??{ code })>, C<< (?>pattern) >>, -C<(?(condition)yes-pattern|no-pattern)>, C<(?(condition)yes-pattern)> +=item G_KEEPERR -=item Backtracking +=item Determining the Context -=item Version 8 Regular Expressions +=back -=item Warning on \1 vs $1 +=item KNOWN PROBLEMS -=item Repeated patterns matching zero-length substring +=item EXAMPLES -=item Combining pieces together +=over -C<ST>, C<S|T>, C<S{REPEAT_COUNT}>, C<S{min,max}>, C<S{min,max}?>, C<S?>, -C<S*>, C<S+>, C<S??>, C<S*?>, C<S+?>, C<< (?>S) >>, C<(?=S)>, C<(?<=S)>, -C<(?!S)>, C<(?<!S)>, C<(??{ EXPR })>, -C<(?(condition)yes-pattern|no-pattern)> +=item No Parameters, Nothing returned -=item Creating custom RE engines +=item Passing Parameters -=back +=item Returning a Scalar -=item BUGS +=item Returning a list of values -=item SEE ALSO +=item Returning a list in a scalar context -=back +=item Returning Data from Perl via the parameter list -=head2 perlrun - how to execute the Perl interpreter +=item Using G_EVAL -=over +=item Using G_KEEPERR -=item SYNOPSIS +=item Using call_sv -=item DESCRIPTION +=item Using call_argv -=over +=item Using call_method -=item #! and quoting on non-Unix systems +=item Using GIMME_V -OS/2, MS-DOS, Win95/NT, Macintosh, VMS +=item Using Perl to dispose of temporaries -=item Location of Perl +=item Strategies for storing Callback Context Information -=item Command Switches +1. Ignore the problem - Allow only 1 callback, 2. Create a sequence of +callbacks - hard wired limit, 3. Use a parameter to map to the Perl +callback -B<-0>[I<digits>], B<-a>, B<-C>, B<-c>, B<-d>, B<-d:>I<foo>, -B<-D>I<letters>, B<-D>I<number>, B<-e> I<commandline>, B<-F>I<pattern>, -B<-h>, B<-i>[I<extension>], B<-I>I<directory>, B<-l>[I<octnum>], -B<-m>[B<->]I<module>, B<-M>[B<->]I<module>, B<-M>[B<->]I<'module ...'>, -B<-[mM]>[B<->]I<module=arg[,arg]...>, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>, -B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<name>, B<-w>, B<-W>, B<-X>, -B<-x> I<directory> +=item Alternate Stack Manipulation + +=item Creating and calling an anonymous subroutine in C =back -=item ENVIRONMENT +=item SEE ALSO -HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, PERL5SHELL -(specific to the Win32 port), PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL +=item AUTHOR + +=item DATE =back -=head2 perlfunc - Perl builtin functions +=head2 perlutil - utilities packaged with the Perl distribution =over @@ -1763,151 +3892,61 @@ HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, PERL5SHELL =over -=item Perl Functions by Category +=item DOCUMENTATION -Functions for SCALARs or strings, Regular expressions and pattern matching, -Numeric functions, Functions for real @ARRAYs, Functions for list data, -Functions for real %HASHes, Input and output functions, Functions for fixed -length data or records, Functions for filehandles, files, or directories, -Keywords related to the control flow of your perl program, Keywords related -to scoping, Miscellaneous functions, Functions for processes and process -groups, Keywords related to perl modules, Keywords related to classes and -object-orientedness, Low-level socket functions, System V interprocess -communication functions, Fetching user and group info, Fetching network -info, Time-related functions, Functions new in perl5, Functions obsoleted -in perl5 +L<perldoc|perldoc>, L<pod2man|pod2man> and L<pod2text|pod2text>, +L<pod2html|pod2html> and L<pod2latex|pod2latex>, L<pod2usage|pod2usage>, +L<podselect|podselect>, L<podchecker|podchecker>, L<splain|splain>, +L<roffitall|roffitall> -=item Portability +=item CONVERTORS -=item Alphabetical Listing of Perl Functions +L<a2p|a2p>, L<s2p|s2p>, L<find2perl|find2perl> -I<-X> FILEHANDLE, I<-X> EXPR, I<-X>, abs VALUE, abs, accept -NEWSOCKET,GENERICSOCKET, alarm SECONDS, alarm, atan2 Y,X, bind SOCKET,NAME, -binmode FILEHANDLE, DISCIPLINE, binmode FILEHANDLE, bless REF,CLASSNAME, -bless REF, caller EXPR, caller, chdir EXPR, chmod LIST, chomp VARIABLE, -chomp LIST, chomp, chop VARIABLE, chop LIST, chop, chown LIST, chr NUMBER, -chr, chroot FILENAME, chroot, close FILEHANDLE, close, closedir DIRHANDLE, -connect SOCKET,NAME, continue BLOCK, cos EXPR, crypt PLAINTEXT,SALT, -dbmclose HASH, dbmopen HASH,DBNAME,MASK, defined EXPR, defined, delete -EXPR, die LIST, do BLOCK, do SUBROUTINE(LIST), do EXPR, dump LABEL, dump, -each HASH, eof FILEHANDLE, eof (), eof, eval EXPR, eval BLOCK, exec LIST, -exec PROGRAM LIST, exists EXPR, exit EXPR, exp EXPR, exp, fcntl -FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock FILEHANDLE,OPERATION, -fork, format, formline PICTURE,LIST, getc FILEHANDLE, getc, getlogin, -getpeername SOCKET, getpgrp PID, getppid, getpriority WHICH,WHO, getpwnam -NAME, getgrnam NAME, gethostbyname NAME, getnetbyname NAME, getprotobyname -NAME, getpwuid UID, getgrgid GID, getservbyname NAME,PROTO, gethostbyaddr -ADDR,ADDRTYPE, getnetbyaddr ADDR,ADDRTYPE, getprotobynumber NUMBER, -getservbyport PORT,PROTO, getpwent, getgrent, gethostent, getnetent, -getprotoent, getservent, setpwent, setgrent, sethostent STAYOPEN, setnetent -STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN, endpwent, endgrent, -endhostent, endnetent, endprotoent, endservent, getsockname SOCKET, -getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, gmtime EXPR, goto LABEL, -goto EXPR, goto &NAME, grep BLOCK LIST, grep EXPR,LIST, hex EXPR, hex, -import, index STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl -FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill SIGNAL, LIST, -last LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length, -link OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR, -lock, log EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK -LIST, map EXPR,LIST, mkdir FILENAME,MASK, mkdir FILENAME, msgctl -ID,CMD,ARG, msgget KEY,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, msgsnd -ID,MSG,FLAGS, my EXPR, my EXPR : ATTRIBUTES, next LABEL, next, no Module -LIST, oct EXPR, oct, open FILEHANDLE,MODE,LIST, open FILEHANDLE,EXPR, open -FILEHANDLE, opendir DIRHANDLE,EXPR, ord EXPR, ord, our EXPR, pack -TEMPLATE,LIST, package, package NAMESPACE, pipe READHANDLE,WRITEHANDLE, pop -ARRAY, pop, pos SCALAR, pos, print FILEHANDLE LIST, print LIST, print, -printf FILEHANDLE FORMAT, LIST, printf FORMAT, LIST, prototype FUNCTION, -push ARRAY,LIST, q/STRING/, qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/, -quotemeta EXPR, quotemeta, rand EXPR, rand, read -FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir -DIRHANDLE, readline EXPR, readlink EXPR, readlink, readpipe EXPR, recv -SOCKET,SCALAR,LENGTH,FLAGS, redo LABEL, redo, ref EXPR, ref, rename -OLDNAME,NEWNAME, require VERSION, require EXPR, require, reset EXPR, reset, -return EXPR, return, reverse LIST, rewinddir DIRHANDLE, rindex -STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar -EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select -FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl -ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send -SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority -WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shift ARRAY, -shift, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE, -shmwrite ID,STRING,POS,SIZE, shutdown SOCKET,HOW, sin EXPR, sin, sleep -EXPR, sleep, socket SOCKET,DOMAIN,TYPE,PROTOCOL, socketpair -SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, sort SUBNAME LIST, sort BLOCK LIST, -sort LIST, splice ARRAY,OFFSET,LENGTH,LIST, splice ARRAY,OFFSET,LENGTH, -splice ARRAY,OFFSET, splice ARRAY, split /PATTERN/,EXPR,LIMIT, split -/PATTERN/,EXPR, split /PATTERN/, split, sprintf FORMAT, LIST, sqrt EXPR, -sqrt, srand EXPR, srand, stat FILEHANDLE, stat EXPR, stat, study SCALAR, -study, sub BLOCK, sub NAME, sub NAME BLOCK, substr -EXPR,OFFSET,LENGTH,REPLACEMENT, substr EXPR,OFFSET,LENGTH, substr -EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST, sysopen -FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS, sysread -FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, sysseek -FILEHANDLE,POSITION,WHENCE, system LIST, system PROGRAM LIST, syswrite -FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite FILEHANDLE,SCALAR,LENGTH, -syswrite FILEHANDLE,SCALAR, tell FILEHANDLE, tell, telldir DIRHANDLE, tie -VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate -FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, -ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack -TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module VERSION LIST, -use Module VERSION, use Module LIST, use Module, use VERSION, utime LIST, -values HASH, vec EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn -LIST, write FILEHANDLE, write EXPR, write, y/// +=item Development + +L<perlbug|perlbug>, L<h2ph|h2ph>, L<c2ph|c2ph> and L<pstruct|pstruct>, +L<h2xs|h2xs>, L<dprofpp|dprofpp>, L<perlcc|perlcc> + +=item SEE ALSO =back =back -=head2 perlvar - Perl predefined variables +=head2 perlfilter - Source Filters =over =item DESCRIPTION -=over +=item CONCEPTS -=item Predefined Names +=item USING FILTERS -$ARG, $_, $<I<digits>>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $', -$LAST_PAREN_MATCH, $+, @+, $MULTILINE_MATCHING, $*, input_line_number -HANDLE EXPR, $INPUT_LINE_NUMBER, $NR, $, input_record_separator HANDLE -EXPR, $INPUT_RECORD_SEPARATOR, $RS, $/, autoflush HANDLE EXPR, -$OUTPUT_AUTOFLUSH, $|, output_field_separator HANDLE EXPR, -$OUTPUT_FIELD_SEPARATOR, $OFS, $,, output_record_separator HANDLE EXPR, -$OUTPUT_RECORD_SEPARATOR, $ORS, $\, $LIST_SEPARATOR, $", -$SUBSCRIPT_SEPARATOR, $SUBSEP, $;, $OFMT, $#, format_page_number HANDLE -EXPR, $FORMAT_PAGE_NUMBER, $%, format_lines_per_page HANDLE EXPR, -$FORMAT_LINES_PER_PAGE, $=, format_lines_left HANDLE EXPR, -$FORMAT_LINES_LEFT, $-, @-, C<$`> is the same as C<substr($var, 0, $-[0]>), -C<$&> is the same as C<substr($var, $-[0], $+[0] - $-[0]>), C<$'> is the -same as C<substr($var, $+[0]>), C<$1> is the same as C<substr($var, $-[1], -$+[1] - $-[1])>, C<$2> is the same as C<substr($var, $-[2], $+[2] - -$-[2])>, C<$3> is the same as C<substr $var, $-[3], $+[3] - $-[3]>), -format_name HANDLE EXPR, $FORMAT_NAME, $~, format_top_name HANDLE EXPR, -$FORMAT_TOP_NAME, $^, format_line_break_characters HANDLE EXPR, -$FORMAT_LINE_BREAK_CHARACTERS, $:, format_formfeed HANDLE EXPR, -$FORMAT_FORMFEED, $^L, $ACCUMULATOR, $^A, $CHILD_ERROR, $?, $OS_ERROR, -$ERRNO, $!, $EXTENDED_OS_ERROR, $^E, $EVAL_ERROR, $@, $PROCESS_ID, $PID, -$$, $REAL_USER_ID, $UID, $<, $EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, -$GID, $(, $EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $], -$COMPILING, $^C, $DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, %^H, -$INPLACE_EDIT, $^I, $^M, $OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, -0x08, 0x10, 0x20, 0x40, 0x80, 0x100, 0x200, $LAST_REGEXP_CODE_RESULT, $^R, -$EXCEPTIONS_BEING_CAUGHT, $^S, $BASETIME, $^T, $PERL_VERSION, $^V, -$WARNING, $^W, ${^WARNING_BITS}, ${^WIDE_SYSTEM_CALLS}, $EXECUTABLE_NAME, -$^X, $ARGV, @ARGV, @INC, @_, %INC, %ENV, $ENV{expr}, %SIG, $SIG{expr} +=item WRITING A SOURCE FILTER -=item Error Indicators +=item WRITING A SOURCE FILTER IN C -=item Technical Note on the Syntax of Variable Names +B<Decryption Filters> -=back +=item CREATING A SOURCE FILTER AS A SEPARATE EXECUTABLE -=item BUGS +=item WRITING A SOURCE FILTER IN PERL + +=item USING CONTEXT: THE DEBUG FILTER + +=item CONCLUSION + +=item REQUIREMENTS + +=item AUTHOR + +=item Copyrights =back -=head2 perlsub - Perl subroutines +=head2 perldbmfilter - Perl DBM Filters =over @@ -1915,1472 +3954,1528 @@ $^X, $ARGV, @ARGV, @INC, @_, %INC, %ENV, $ENV{expr}, %SIG, $SIG{expr} =item DESCRIPTION -=over - -=item Private Variables via my() +B<filter_store_key>, B<filter_store_value>, B<filter_fetch_key>, +B<filter_fetch_value> -=item Persistent Private Variables +=over -=item Temporary Values via local() +=item The Filter -=item Lvalue subroutines +=item An Example -- the NULL termination problem. -=item Passing Symbol Table Entries (typeglobs) +=item Another Example -- Key is a C int. -=item When to Still Use local() +=back -1. You need to give a global variable a temporary value, especially $_, 2. -You need to create a local file or directory handle or a local function, 3. -You want to temporarily change just one element of an array or hash +=item SEE ALSO -=item Pass by Reference +=item AUTHOR -=item Prototypes +=back -=item Constant Functions +=head2 perlapi - autogenerated documentation for the perl public API -=item Overriding Built-in Functions +=over -=item Autoloading +=item DESCRIPTION -=item Subroutine Attributes +AvFILL, av_clear, av_delete, av_exists, av_extend, av_fetch, av_fill, +av_len, av_make, av_pop, av_push, av_shift, av_store, av_undef, av_unshift, +bytes_to_utf8, call_argv, call_method, call_pv, call_sv, CLASS, Copy, +croak, CvSTASH, dMARK, dORIGMARK, dSP, dXSARGS, dXSI32, ENTER, eval_pv, +eval_sv, EXTEND, fbm_compile, fbm_instr, FREETMPS, get_av, get_cv, get_hv, +get_sv, GIMME, GIMME_V, GvSV, gv_fetchmeth, gv_fetchmethod, +gv_fetchmethod_autoload, gv_stashpv, gv_stashsv, G_ARRAY, G_DISCARD, +G_EVAL, G_NOARGS, G_SCALAR, G_VOID, HEf_SVKEY, HeHASH, HeKEY, HeKLEN, HePV, +HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, HvNAME, hv_clear, hv_delete, +hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, +hv_iterinit, hv_iterkey, hv_iterkeysv, hv_iternext, hv_iternextsv, +hv_iterval, hv_magic, hv_store, hv_store_ent, hv_undef, isALNUM, isALPHA, +isDIGIT, isLOWER, isSPACE, isUPPER, items, ix, LEAVE, looks_like_number, +MARK, mg_clear, mg_copy, mg_find, mg_free, mg_get, mg_length, mg_magical, +mg_set, Move, New, newAV, Newc, newCONSTSUB, newHV, newRV_inc, newRV_noinc, +NEWSV, newSViv, newSVnv, newSVpv, newSVpvf, newSVpvn, newSVrv, newSVsv, +newSVuv, newXS, newXSproto, Newz, Nullav, Nullch, Nullcv, Nullhv, Nullsv, +ORIGMARK, perl_alloc, perl_construct, perl_destruct, perl_free, perl_parse, +perl_run, PL_DBsingle, PL_DBsub, PL_DBtrace, PL_dowarn, PL_modglobal, +PL_na, PL_sv_no, PL_sv_undef, PL_sv_yes, POPi, POPl, POPn, POPp, POPs, +PUSHi, PUSHMARK, PUSHn, PUSHp, PUSHs, PUSHu, PUTBACK, Renew, Renewc, +require_pv, RETVAL, Safefree, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, +strEQ, strGE, strGT, strLE, strLT, strNE, strnEQ, strnNE, StructCopy, +SvCUR, SvCUR_set, SvEND, SvGETMAGIC, SvGROW, SvIOK, SvIOKp, SvIOK_off, +SvIOK_on, SvIOK_only, SvIV, SvIVX, SvLEN, SvNIOK, SvNIOKp, SvNIOK_off, +SvNOK, SvNOKp, SvNOK_off, SvNOK_on, SvNOK_only, SvNV, SvNVX, SvOK, SvOOK, +SvPOK, SvPOKp, SvPOK_off, SvPOK_on, SvPOK_only, SvPV, SvPVX, SvPV_force, +SvPV_nolen, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, +SvROK_on, SvRV, SvSETMAGIC, SvSetSV, SvSetSV_nosteal, SvSTASH, SvTAINT, +SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, svtype, SvTYPE, SVt_IV, +SVt_NV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUPGRADE, SvUV, +SvUVX, sv_2mortal, sv_bless, sv_catpv, sv_catpvf, sv_catpvf_mg, sv_catpvn, +sv_catpvn_mg, sv_catpv_mg, sv_catsv, sv_catsv_mg, sv_chop, sv_clear, +sv_cmp, sv_cmp_locale, sv_dec, sv_derived_from, sv_eq, sv_free, sv_gets, +sv_grow, sv_inc, sv_insert, sv_isa, sv_isobject, sv_len, sv_len_utf8, +sv_magic, sv_mortalcopy, sv_newmortal, sv_pvn_force, sv_pvutf8n_force, +sv_reftype, sv_replace, sv_rvweaken, sv_setiv, sv_setiv_mg, sv_setnv, +sv_setnv_mg, sv_setpv, sv_setpvf, sv_setpvf_mg, sv_setpviv, sv_setpviv_mg, +sv_setpvn, sv_setpvn_mg, sv_setpv_mg, sv_setref_iv, sv_setref_nv, +sv_setref_pv, sv_setref_pvn, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg, +sv_true, sv_unmagic, sv_unref, sv_upgrade, sv_usepvn, sv_usepvn_mg, +sv_utf8_downgrade, sv_utf8_encode, sv_utf8_upgrade, sv_vcatpvfn, +sv_vsetpvfn, THIS, toLOWER, toUPPER, U8 *s, utf8_to_bytes, warn, XPUSHi, +XPUSHn, XPUSHp, XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, +XSRETURN_NO, XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, +XST_mIV, XST_mNO, XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, +XS_VERSION_BOOTCHECK, Zero -=back +=item AUTHORS =item SEE ALSO =back -=head2 perlmod - Perl modules (packages and symbol tables) +=head2 perlintern - autogenerated documentation of purely B<internal> + Perl functions =over =item DESCRIPTION +is_gv_magical + +=item AUTHORS + +=item SEE ALSO + +=back + +=head2 perlapio - perl's IO abstraction interface. + =over -=item Packages +=item SYNOPSIS -=item Symbol Tables +=item DESCRIPTION -=item Package Constructors and Destructors +B<PerlIO *>, B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()>, +B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)>, +B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)>, +B<PerlIO_stdoutf(fmt,...)>, B<PerlIO_read(f,buf,count)>, +B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(f,s)>, +B<PerlIO_putc(f,c)>, B<PerlIO_ungetc(f,c)>, B<PerlIO_getc(f)>, +B<PerlIO_eof(f)>, B<PerlIO_error(f)>, B<PerlIO_fileno(f)>, +B<PerlIO_clearerr(f)>, B<PerlIO_flush(f)>, B<PerlIO_tell(f)>, +B<PerlIO_seek(f,o,w)>, B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)>, +B<PerlIO_rewind(f)>, B<PerlIO_tmpfile()> -=item Perl Classes +=over -=item Perl Modules +=item Co-existence with stdio -=back +B<PerlIO_importFILE(f,flags)>, B<PerlIO_exportFILE(f,flags)>, +B<PerlIO_findFILE(f)>, B<PerlIO_releaseFILE(p,f)>, B<PerlIO_setlinebuf(f)>, +B<PerlIO_has_cntptr(f)>, B<PerlIO_get_ptr(f)>, B<PerlIO_get_cnt(f)>, +B<PerlIO_canset_cnt(f)>, B<PerlIO_fast_gets(f)>, +B<PerlIO_set_ptrcnt(f,p,c)>, B<PerlIO_set_cnt(f,c)>, B<PerlIO_has_base(f)>, +B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> -=item SEE ALSO +=back =back -=head2 perlmodlib - constructing new Perl modules and finding existing ones +=head2 perltodo - Perl TO-DO List =over =item DESCRIPTION -=item THE PERL MODULE LIBRARY +=item Infrastructure =over -=item Pragmatic Modules +=item Mailing list archives -attributes, attrs, autouse, base, blib, caller, charnames, constant, -diagnostics, fields, filetest, integer, less, lib, locale, ops, overload, -re, sigtrap, strict, subs, utf8, vars, warnings +=item Bug tracking system -=item Standard Modules +=item Regression Tests -AnyDBM_File, AutoLoader, AutoSplit, B, B::Asmdata, B::Assembler, B::Bblock, -B::Bytecode, B::C, B::CC, B::Debug, B::Deparse, B::Disassembler, B::Lint, -B::Showlex, B::Stackobj, B::Terse, B::Xref, Benchmark, ByteLoader, CGI, -CGI::Apache, CGI::Carp, CGI::Cookie, CGI::Fast, CGI::Pretty, CGI::Push, -CGI::Switch, CPAN, CPAN::FirstTime, CPAN::Nox, Carp, Carp::Heavy, -Class::Struct, Config, Cwd, DB, DB_File, Data::Dumper, Devel::DProf, -Devel::Peek, Devel::SelfStubber, DirHandle, Dumpvalue, DynaLoader, English, -Env, Errno, Exporter, Exporter::Heavy, ExtUtils::Command, ExtUtils::Embed, -ExtUtils::Install, ExtUtils::Installed, ExtUtils::Liblist, -ExtUtils::MM_Cygwin, ExtUtils::MM_OS2, ExtUtils::MM_Unix, ExtUtils::MM_VMS, -ExtUtils::MM_Win32, ExtUtils::MakeMaker, ExtUtils::Manifest, -ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::Packlist, -ExtUtils::testlib, Fatal, Fcntl, File::Basename, File::CheckTree, -File::Compare, File::Copy, File::DosGlob, File::Find, File::Glob, -File::Path, File::Spec, File::Spec::Functions, File::Spec::Mac, -File::Spec::OS2, File::Spec::Unix, File::Spec::VMS, File::Spec::Win32, -File::stat, FileCache, FileHandle, FindBin, GDBM_File, Getopt::Long, -Getopt::Std, I18N::Collate, IO, IO::Dir, IO::File, IO::Handle, IO::Pipe, -IO::Poll, IO::Seekable, IO::Select, IO::Socket, IO::Socket::INET, -IO::Socket::UNIX, IPC::Msg, IPC::Open2, IPC::Open3, IPC::Semaphore, -IPC::SysV, Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig, -Net::Ping, Net::hostent, Net::netent, Net::protoent, Net::servent, O, -Opcode, POSIX, Pod::Checker, Pod::Html, Pod::InputObjects, Pod::Man, -Pod::Parser, Pod::Select, Pod::Text, Pod::Text::Color, Pod::Usage, -SDBM_File, Safe, Search::Dict, SelectSaver, SelfLoader, Shell, Socket, -Symbol, Sys::Hostname, Sys::Syslog, Term::Cap, Term::Complete, -Term::ReadLine, Test, Test::Harness, Text::Abbrev, Text::ParseWords, -Text::Soundex, Text::Wrap, Tie::Array, Tie::Handle, Tie::Hash, -Tie::RefHash, Tie::Scalar, Tie::SubstrHash, Time::Local, Time::gmtime, -Time::localtime, Time::tm, UNIVERSAL, User::grent, User::pwent - -=item Extension Modules +Coverage, Regression, __DIE__, suidperl, The 25% slowdown from perl4 to +perl5 =back -=item CPAN - -Language Extensions and Documentation Tools, Development Support, Operating -System Interfaces, Networking, Device Control (modems) and InterProcess -Communication, Data Types and Data Type Utilities, Database Interfaces, -User Interfaces, Interfaces to / Emulations of Other Programming Languages, -File Names, File Systems and File Locking (see also File Handles), String -Processing, Language Text Processing, Parsing, and Searching, Option, -Argument, Parameter, and Configuration File Processing, -Internationalization and Locale, Authentication, Security, and Encryption, -World Wide Web, HTML, HTTP, CGI, MIME, Server and Daemon Utilities, -Archiving and Compression, Images, Pixmap and Bitmap Manipulation, Drawing, -and Graphing, Mail and Usenet News, Control Flow Utilities (callbacks and -exceptions etc), File Handle and Input/Output Stream Utilities, -Miscellaneous Modules, Africa, Asia, Australasia, Central America, Europe, -North America, South America - -=item Modules: Creation, Use, and Abuse +=item Configure =over -=item Guidelines for Module Creation +=item Install HTML -Do similar modules already exist in some form?, Try to design the new -module to be easy to extend and reuse, Some simple style guidelines, Select -what to export, Select a name for the module, Have you got it right?, -README and other Additional Files, A description of the -module/package/extension etc, A copyright notice - see below, Prerequisites -- what else you may need to have, How to build it - possible changes to -Makefile.PL etc, How to install it, Recent changes in this release, -especially incompatibilities, Changes / enhancements you plan to make in -the future, Adding a Copyright Notice, Give the module a -version/issue/release number, How to release and distribute a module, Take -care when changing a released module +=back -=item Guidelines for Converting Perl 4 Library Scripts into Modules +=item Perl Language -There is no requirement to convert anything, Consider the implications, -Make the most of the opportunity, The pl2pm utility will get you started, -Adds the standard Module prologue lines, Converts package specifiers from ' -to ::, Converts die(...) to croak(...), Several other minor changes +=over -=item Guidelines for Reusing Application Code +=item our ($var) -Complete applications rarely belong in the Perl Module Library, Many -applications contain some Perl code that could be reused, Break-out the -reusable code into one or more separate module files, Take the opportunity -to reconsider and redesign the interfaces, In some cases the 'application' -can then be reduced to a small +=item 64-bit Perl -=back +=item Prototypes -=item NOTE +Named prototypes, Indirect objects, Method calls, Context, Scoped subs =back -=head2 perlmodinstall - Installing CPAN Modules +=item Perl Internals =over -=item DESCRIPTION +=item magic_setisa -=over +=item Garbage Collection -=item PREAMBLE +=item Reliable signals -B<DECOMPRESS> the file, B<UNPACK> the file into a directory, B<BUILD> the -module (sometimes unnecessary), B<INSTALL> the module +Alternate runops() for signal despatch, Figure out how to die() in delayed +sighandler, Add tests for Thread::Signal, Automatic tests against CPAN -=back +=item Interpolated regex performance bugs -=item HEY +=item Memory leaks from failed eval/regcomp -=item AUTHOR +=item Make XS easier to use -=item COPYRIGHT +=item Make embedded Perl easier to use -=back +=item Namespace cleanup -=head2 perlfork - Perl's fork() emulation +=item MULTIPLICITY -=over +=item MacPerl -=item SYNOPSIS +=back -=item DESCRIPTION +=item Documentation =over -=item Behavior of other Perl features in forked pseudo-processes +=item A clear division into tutorial and reference -$$ or $PROCESS_ID, %ENV, chdir() and all other builtins that accept -filenames, wait() and waitpid(), kill(), exec(), exit(), Open handles to -files, directories and network sockets +=item Remove the artificial distinction between operators and functions -=item Resource limits +=item More tutorials -=item Killing the parent process +Regular expressions, I/O, pack/unpack, Debugging -=item Lifetime of the parent process and pseudo-processes +=item Include a search tool -=item CAVEATS AND LIMITATIONS +=item Include a locate tool -BEGIN blocks, Open filehandles, Forking pipe open() not yet implemented, -Global state maintained by XSUBs, Interpreter embedded in larger -application, Thread-safety of extensions +=item Separate function manpages by default -=back +=item Users can't find the manpages -=item BUGS +=item Install ALL Documentation -=item AUTHOR +=item Outstanding issues to be documented -=item SEE ALSO +=item Adapt www.linuxhq.com for Perl + +=item Replace man with a perl program + +=item Unicode tutorial =back -=head2 perlform - Perl formats +=item Modules =over -=item DESCRIPTION +=item Update the POSIX extension to conform with the POSIX 1003.1 Edition 2 -=over +=item Module versions -=item Format Variables +=item New modules -=back +=item Profiler -=item NOTES +=item Tie Modules -=over +VecArray, SubstrArray, VirtualArray, ShiftSplice -=item Footers +=item Procedural options -=item Accessing Formatting Internals +=item RPC -=back +=item y2k localtime/gmtime -=item WARNINGS +=item Export File::Find variables -=back +=item Ioctl -=head2 perllocale - Perl locale handling (internationalization and -localization) +=item Debugger attach/detach -=over +=item Regular Expression debugger -=item DESCRIPTION +=item Alternative RE Syntax -=item PREPARING TO USE LOCALES +=item Bundled modules -=item USING LOCALES +=item Expect -=over +=item GUI::Native -=item The use locale pragma +=item Update semibroken auxiliary tools; h2ph, a2p, etc. -=item The setlocale function +=item POD Converters -=item Finding locales +=item pod2html -=item LOCALE PROBLEMS +=item Podchecker -=item Temporarily fixing locale problems +=back -=item Permanently fixing locale problems +=item Tom's Wishes -=item Permanently fixing your system's locale configuration +=over -=item Fixing system locale configuration +=item Webperl -=item The localeconv function +=item Mobile agents + +=item POSIX on non-POSIX + +=item Portable installations =back -=item LOCALE CATEGORIES +=item Win32 Stuff =over -=item Category LC_COLLATE: Collation +=item Rename new headers to be consistent with the rest -=item Category LC_CTYPE: Character Types +=item Sort out the spawnvp() mess -=item Category LC_NUMERIC: Numeric Formatting +=item Work out DLL versioning -=item Category LC_MONETARY: Formatting of monetary amounts +=item Style-check -=item LC_TIME +=back -=item Other categories +=item Would be nice to have -=back +C<pack "(stuff)*">, Contiguous bitfields in pack/unpack, lexperl, Bundled +perl preprocessor, Use posix calls internally where possible, format +BOTTOM, -i rename file only when successfully changed, All ARGV input +should act like <>, report HANDLE [formats], support in perlmain to rerun +debugger, lvalue functions -=item SECURITY +=item Possible pragmas -B<Comparison operators> (C<lt>, C<le>, C<ge>, C<gt> and C<cmp>):, -B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or C<\U>), -B<Matching operator> (C<m//>):, B<Substitution operator> (C<s///>):, -B<Output formatting functions> (printf() and write()):, B<Case-mapping -functions> (lc(), lcfirst(), uc(), ucfirst()):, B<POSIX locale-dependent -functions> (localeconv(), strcoll(),strftime(), strxfrm()):, B<POSIX -character class tests> (isalnum(), isalpha(), isdigit(),isgraph(), -islower(), isprint(), ispunct(), isspace(), isupper(), -isxdigit()): +=over -=item ENVIRONMENT +=item 'less' -PERL_BADLANG, LC_ALL, LANGUAGE, LC_CTYPE, LC_COLLATE, LC_MONETARY, -LC_NUMERIC, LC_TIME, LANG +=back -=item NOTES +=item Optimizations =over -=item Backward compatibility +=item constant function cache -=item I18N:Collate obsolete +=item foreach(reverse...) -=item Sort speed and memory use impacts +=item Cache eval tree -=item write() and LC_NUMERIC +=item rcatmaybe -=item Freely available locale definitions +=item Shrink opcode tables -=item I18n and l10n +=item Cache hash value -=item An imperfect standard +=item Optimize away @_ where possible + +=item Optimize sort by { $a <=> $b } + +=item Rewrite regexp parser for better integrated optimization =back -=item BUGS +=item Vague possibilities + +ref function in list context, make tr/// return histogram in list context?, +Loop control on do{} et al, Explicit switch statements, compile to real +threaded code, structured types, Modifiable $1 et al + +=item To Do Or Not To Do =over -=item Broken systems +=item Making my() work on "package" variables -=back +=item "or" testing defined not truth -=item SEE ALSO +=item "dynamic" lexicals -=item HISTORY +=item "class"-based, rather than package-based "lexicals" =back -=head2 perlref - Perl references and nested data structures +=item Threading =over -=item NOTE - -=item DESCRIPTION +=item Modules -=over +=item Testing -=item Making References +=item $AUTOLOAD -=item Using References +=item exit/die -=item Symbolic references +=item External threads -=item Not-so-symbolic references +=item Thread::Pool -=item Pseudo-hashes: Using an array as a hash +=item thread-safety -=item Function Templates +=item Per-thread GVs =back -=item WARNING +=item Compiler -=item SEE ALSO +=over -=back +=item Optimization -=head2 perlreftut - Mark's very short tutorial about references +=item Byteperl -=over +=item Precompiled modules -=item DESCRIPTION +=item Executables -=item Who Needs Complicated Data Structures? +=item Typed lexicals -=item The Solution +=item Win32 -=item Syntax +=item END blocks -=over +=item _AUTOLOAD -=item Making References +=item comppadlist -=item Using References +=item Cached compilation =back -=item An Example +=item Recently Finished Tasks -=item Arrow Rule +=over -=item Solution +=item Figure a way out of $^(capital letter) -=item The Rest +=item Filenames -=item Summary +=item Foreign lines -=item Credits +=item Namespace cleanup -=over +=item ISA.pm -=item Distribution Conditions +=item gettimeofday + +=item autocroak? =back =back -=head2 perldsc - Perl Data Structures Cookbook +=head2 perlhack - How to hack at the Perl internals =over =item DESCRIPTION -arrays of arrays, hashes of arrays, arrays of hashes, hashes of hashes, -more elaborate constructs +Does concept match the general goals of Perl?, Where is the +implementation?, Backwards compatibility, Could it be a module instead?, Is +the feature generic enough?, Does it potentially introduce new bugs?, Does +it preclude other desirable features?, Is the implementation robust?, Is +the implementation generic enough to be portable?, Is there enough +documentation?, Is there another way to do it?, Does it create too much +work?, Patches speak louder than words, L<perlguts>, L<perlxstut> and +L<perlxs>, L<perlapi>, F<Porting/pumpkin.pod>, The perl5-porters FAQ -=item REFERENCES +=over -=item COMMON MISTAKES +=item Finding Your Way Around -=item CAVEAT ON PRECEDENCE +Core modules, Documentation, Configure, Interpreter -=item WHY YOU SHOULD ALWAYS C<use strict> +=item Elements of the interpreter -=item DEBUGGING +Startup, Parsing, Optimization, Running -=item CODE EXAMPLES +=item Internal Variable Types -=item ARRAYS OF ARRAYS +=item Op Trees -=over +=item Stacks -=item Declaration of a ARRAY OF ARRAYS +Argument stack, Mark stack, Save stack -=item Generation of a ARRAY OF ARRAYS +=item Millions of Macros -=item Access and Printing of a ARRAY OF ARRAYS +=item Poking at Perl -=back +=item Using a source-level debugger -=item HASHES OF ARRAYS +run [args], break function_name, break source.c:xxx, step, next, continue, +finish, print -=over +=item Dumping Perl Data Structures -=item Declaration of a HASH OF ARRAYS +=item Patching -=item Generation of a HASH OF ARRAYS +=item CONCLUSION -=item Access and Printing of a HASH OF ARRAYS +I<The Road goes ever on and on, down from the door where it began.> =back -=item ARRAYS OF HASHES +=item AUTHOR + +=back + +=head2 perlhist - the Perl history records =over -=item Declaration of a ARRAY OF HASHES +=item DESCRIPTION -=item Generation of a ARRAY OF HASHES +=item INTRODUCTION -=item Access and Printing of a ARRAY OF HASHES +=item THE KEEPERS OF THE PUMPKIN + +=over + +=item PUMPKIN? =back -=item HASHES OF HASHES +=item THE RECORDS =over -=item Declaration of a HASH OF HASHES +=item SELECTED RELEASE SIZES -=item Generation of a HASH OF HASHES +=item SELECTED PATCH SIZES -=item Access and Printing of a HASH OF HASHES +=back + +=item THE KEEPERS OF THE RECORDS =back -=item MORE ELABORATE RECORDS +=head2 perldelta - what's new for perl v5.8.0 =over -=item Declaration of MORE ELABORATE RECORDS +=item DESCRIPTION -=item Declaration of a HASH OF COMPLEX RECORDS +=item Core Enhancements -=item Generation of a HASH OF COMPLEX RECORDS +=item Modules and Pragmata -=back +=item Utility Changes -=item Database Ties +=item Improved Documentation -=item SEE ALSO +=item Performance enhancements -=item AUTHOR +=item Installation and Configuration Improvements + +=over + +=item gcc automatically tried if 'cc' does not seem to be working =back -=head2 perllol - Manipulating Arrays of Arrays in Perl +=item Platform specific changes -=over +=item Significant bug fixes -=item DESCRIPTION +=item New or Changed Diagnostics -=item Declaration and Access of Arrays of Arrays +(perhaps you forgot to load "%s"?), Ambiguous range in transliteration +operator -=item Growing Your Own +=item New tests -=item Access and Printing +=item Incompatible Changes -=item Slices +=item Known Problems + +=item Obsolete Diagnostics + +=item Reporting Bugs =item SEE ALSO -=item AUTHOR +=item HISTORY =back -=head2 perlboot - Beginner's Object-Oriented Tutorial +=head2 perl56delta, perldelta - what's new for perl v5.6.0 =over =item DESCRIPTION +=item Core Enhancements + =over -=item If we could talk to the animals... +=item Interpreter cloning, threads, and concurrency -=item Introducing the method invocation arrow +=item Lexically scoped warning categories -=item Invoking a barnyard +=item Unicode and UTF-8 support -=item The extra parameter of method invocation +=item Support for interpolating named characters -=item Calling a second method to simplify things +=item "our" declarations -=item Inheriting the windpipes +=item Support for strings represented as a vector of ordinals -=item A few notes about @ISA +=item Improved Perl version numbering system -=item Overriding the methods +=item New syntax for declaring subroutine attributes -=item Starting the search from a different place +=item File and directory handles can be autovivified -=item The SUPER way of doing things +=item open() with more than two arguments -=item Where we're at so far... +=item 64-bit support -=item A horse is a horse, of course of course -- or is it? +=item Large file support -=item Invoking an instance method +=item Long doubles -=item Accessing the instance data +=item "more bits" -=item How to build a horse +=item Enhanced support for sort() subroutines -=item Inheriting the constructor +=item C<sort $coderef @foo> allowed -=item Making a method work with either classes or instances +=item File globbing implemented internally -=item Adding parameters to a method +=item Support for CHECK blocks -=item More interesting instances +=item POSIX character class syntax [: :] supported -=item A horse of a different color +=item Better pseudo-random number generator -=item Summary +=item Improved C<qw//> operator -=back +=item Better worst-case behavior of hashes -=item SEE ALSO +=item pack() format 'Z' supported -=item COPYRIGHT +=item pack() format modifier '!' supported -=back +=item pack() and unpack() support counted strings -=head2 perltoot - Tom's object-oriented tutorial for perl +=item Comments in pack() templates -=over +=item Weak references -=item DESCRIPTION +=item Binary numbers supported -=item Creating a Class +=item Lvalue subroutines -=over +=item Some arrows may be omitted in calls through references -=item Object Representation +=item Boolean assignment operators are legal lvalues -=item Class Interface +=item exists() is supported on subroutine names -=item Constructors and Instance Methods +=item exists() and delete() are supported on array elements -=item Planning for the Future: Better Constructors +=item Pseudo-hashes work better -=item Destructors +=item Automatic flushing of output buffers -=item Other Object Methods +=item Better diagnostics on meaningless filehandle operations -=back +=item Where possible, buffered data discarded from duped input filehandle -=item Class Data +=item eof() has the same old magic as <> -=over +=item binmode() can be used to set :crlf and :raw modes -=item Accessing Class Data +=item C<-T> filetest recognizes UTF-8 encoded files as "text" -=item Debugging Methods +=item system(), backticks and pipe open now reflect exec() failure -=item Class Destructors +=item Improved diagnostics -=item Documenting the Interface +=item Diagnostics follow STDERR -=back +=item More consistent close-on-exec behavior -=item Aggregation +=item syswrite() ease-of-use -=item Inheritance +=item Better syntax checks on parenthesized unary operators -=over +=item Bit operators support full native integer width -=item Overridden Methods +=item Improved security features -=item Multiple Inheritance +=item More functional bareword prototype (*) -=item UNIVERSAL: The Root of All Objects +=item C<require> and C<do> may be overridden -=back +=item $^X variables may now have names longer than one character -=item Alternate Object Representations +=item New variable $^C reflects C<-c> switch -=over +=item New variable $^V contains Perl version as a string -=item Arrays as Objects +=item Optional Y2K warnings -=item Closures as Objects +=item Arrays now always interpolate into double-quoted strings =back -=item AUTOLOAD: Proxy Methods +=item Modules and Pragmata =over -=item Autoloaded Data Methods +=item Modules -=item Inherited Autoloaded Data Methods +attributes, B, Benchmark, ByteLoader, constant, charnames, Data::Dumper, +DB, DB_File, Devel::DProf, Devel::Peek, Dumpvalue, DynaLoader, English, +Env, Fcntl, File::Compare, File::Find, File::Glob, File::Spec, +File::Spec::Functions, Getopt::Long, IO, JPL, lib, Math::BigInt, +Math::Complex, Math::Trig, Pod::Parser, Pod::InputObjects, Pod::Checker, +podchecker, Pod::ParseUtils, Pod::Find, Pod::Select, podselect, Pod::Usage, +pod2usage, Pod::Text and Pod::Man, SDBM_File, Sys::Syslog, Sys::Hostname, +Term::ANSIColor, Time::Local, Win32, XSLoader, DBM Filters + +=item Pragmata =back -=item Metaclassical Tools +=item Utility Changes =over -=item Class::Struct +=item dprofpp -=item Data Members as Variables +=item find2perl -=item NOTES +=item h2xs -=item Object Terminology +=item perlcc + +=item perldoc + +=item The Perl Debugger =back -=item SEE ALSO +=item Improved Documentation -=item AUTHOR AND COPYRIGHT +perlapi.pod, perlboot.pod, perlcompile.pod, perldbmfilter.pod, +perldebug.pod, perldebguts.pod, perlfork.pod, perlfilter.pod, perlhack.pod, +perlintern.pod, perllexwarn.pod, perlnumber.pod, perlopentut.pod, +perlreftut.pod, perltootc.pod, perltodo.pod, perlunicode.pod -=item COPYRIGHT +=item Performance enhancements =over -=item Acknowledgments - -=back +=item Simple sort() using { $a <=> $b } and the like are optimized -=back +=item Optimized assignments to lexical variables -=head2 perltootc - Tom's OO Tutorial for Class Data in Perl +=item Faster subroutine calls -=over +=item delete(), each(), values() and hash iteration are faster -=item DESCRIPTION +=back -=item Class Data as Package Variables +=item Installation and Configuration Improvements =over -=item Putting All Your Eggs in One Basket - -=item Inheritance Concerns - -=item The Eponymous Meta-Object +=item -Dusethreads means something different -=item Indirect References to Class Data +=item New Configure flags -=item Monadic Classes +=item Threadedness and 64-bitness now more daring -=item Translucent Attributes +=item Long Doubles -=back +=item -Dusemorebits -=item Class Data as Lexical Variables +=item -Duselargefiles -=over +=item installusrbinperl -=item Privacy and Responsibility +=item SOCKS support -=item File-Scoped Lexicals +=item C<-A> flag -=item More Inheritance Concerns +=item Enhanced Installation Directories -=item Locking the Door and Throwing Away the Key +=back -=item Translucency Revisited +=item Platform specific changes -=back +=over -=item NOTES +=item Supported platforms -=item SEE ALSO +=item DOS -=item AUTHOR AND COPYRIGHT +=item OS390 (OpenEdition MVS) -=item ACKNOWLEDGEMENTS +=item VMS -=item HISTORY +=item Win32 =back -=head2 perlobj - Perl objects +=item Significant bug fixes =over -=item DESCRIPTION +=item <HANDLE> on empty files -=over +=item C<eval '...'> improvements -=item An Object is Simply a Reference +=item All compilation errors are true errors -=item A Class is Simply a Package +=item Implicitly closed filehandles are safer -=item A Method is Simply a Subroutine +=item Behavior of list slices is more consistent -=item Method Invocation +=item C<(\$)> prototype and C<$foo{a}> -=item WARNING +=item C<goto &sub> and AUTOLOAD -=item Default UNIVERSAL methods +=item C<-bareword> allowed under C<use integer> -isa(CLASS), can(METHOD), VERSION( [NEED] ) +=item Failures in DESTROY() -=item Destructors +=item Locale bugs fixed -=item Summary +=item Memory leaks -=item Two-Phased Garbage Collection +=item Spurious subroutine stubs after failed subroutine calls -=back +=item Taint failures under C<-U> -=item SEE ALSO +=item END blocks and the C<-c> switch + +=item Potential to leak DATA filehandles =back -=head2 perltie - how to hide an object class in a simple variable +=item New or Changed Diagnostics -=over +"%s" variable %s masks earlier declaration in same %s, "my sub" not yet +implemented, "our" variable %s redeclared, '!' allowed only after types %s, +/ cannot take a count, / must be followed by a, A or Z, / must be followed +by a*, A* or Z*, / must follow a numeric type, /%s/: Unrecognized escape +\\%c passed through, /%s/: Unrecognized escape \\%c in character class +passed through, /%s/ should probably be written as "%s", %s() called too +early to check prototype, %s argument is not a HASH or ARRAY element, %s +argument is not a HASH or ARRAY element or slice, %s argument is not a +subroutine name, %s package attribute may clash with future reserved word: +%s, (in cleanup) %s, <> should be quotes, Attempt to join self, Bad evalled +substitution pattern, Bad realloc() ignored, Bareword found in conditional, +Binary number > 0b11111111111111111111111111111111 non-portable, Bit vector +size > 32 non-portable, Buffer overflow in prime_env_iter: %s, Can't check +filesystem of script "%s", Can't declare class for non-scalar %s in "%s", +Can't declare %s in "%s", Can't ignore signal CHLD, forcing to default, +Can't modify non-lvalue subroutine call, Can't read CRTL environ, Can't +remove %s: %s, skipping file, Can't return %s from lvalue subroutine, Can't +weaken a nonreference, Character class [:%s:] unknown, Character class +syntax [%s] belongs inside character classes, Constant is not %s reference, +constant(%s): %s, CORE::%s is not a keyword, defined(@array) is deprecated, +defined(%hash) is deprecated, Did not produce a valid header, (Did you mean +"local" instead of "our"?), Document contains no data, entering effective +%s failed, false [] range "%s" in regexp, Filehandle %s opened only for +output, flock() on closed filehandle %s, Global symbol "%s" requires +explicit package name, Hexadecimal number > 0xffffffff non-portable, +Ill-formed CRTL environ value "%s", Ill-formed message in prime_env_iter: +|%s|, Illegal binary digit %s, Illegal binary digit %s ignored, Illegal +number of bits in vec, Integer overflow in %s number, Invalid %s attribute: +%s, Invalid %s attributes: %s, invalid [] range "%s" in regexp, Invalid +separator character %s in attribute list, Invalid separator character %s in +subroutine attribute list, leaving effective %s failed, Lvalue subs +returning %s not implemented yet, Method %s not permitted, Missing +%sbrace%s on \N{}, Missing command in piped open, Missing name in "my sub", +No %s specified for -%c, No package name allowed for variable %s in "our", +No space allowed after -%c, no UTC offset information; assuming local time +is UTC, Octal number > 037777777777 non-portable, panic: del_backref, +panic: kid popen errno read, panic: magic_killbackrefs, Parentheses missing +around "%s" list, Possible unintended interpolation of %s in string, +Possible Y2K bug: %s, pragma "attrs" is deprecated, use "sub NAME : ATTRS" +instead, Premature end of script headers, Repeat count in pack overflows, +Repeat count in unpack overflows, realloc() of freed memory ignored, +Reference is already weak, setpgrp can't take arguments, Strange *+?{} on +zero-length expression, switching effective %s is not implemented, This +Perl can't reset CRTL environ elements (%s), This Perl can't set CRTL +environ elements (%s=%s), Too late to run %s block, Unknown open() mode +'%s', Unknown process %x sent message to prime_env_iter: %s, Unrecognized +escape \\%c passed through, Unterminated attribute parameter in attribute +list, Unterminated attribute list, Unterminated attribute parameter in +subroutine attribute list, Unterminated subroutine attribute list, Value of +CLI symbol "%s" too long, Version number must be a constant number -=item SYNOPSIS +=item New tests -=item DESCRIPTION +=item Incompatible Changes =over -=item Tying Scalars - -TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this - -=item Tying Arrays +=item Perl Source Incompatibilities -TIEARRAY classname, LIST, FETCH this, index, STORE this, index, value, -DESTROY this +CHECK is a new keyword, Treatment of list slices of undef has changed, +Format of $English::PERL_VERSION is different, Literals of the form +C<1.2.3> parse differently, Possibly changed pseudo-random number +generator, Hashing function for hash keys has changed, C<undef> fails on +read only values, Close-on-exec bit may be set on pipe and socket handles, +Writing C<"$$1"> to mean C<"${$}1"> is unsupported, delete(), values() and +C<\(%h)> operate on aliases to values, not copies, vec(EXPR,OFFSET,BITS) +enforces powers-of-two BITS, Text of some diagnostic output has changed, +C<%@> has been removed, Parenthesized not() behaves like a list operator, +Semantics of bareword prototype C<(*)> have changed, Semantics of bit +operators may have changed on 64-bit platforms, More builtins taint their +results -=item Tying Hashes +=item C Source Incompatibilities -USER, HOME, CLOBBER, LIST, TIEHASH classname, LIST, FETCH this, key, STORE -this, key, value, DELETE this, key, CLEAR this, EXISTS this, key, FIRSTKEY -this, NEXTKEY this, lastkey, DESTROY this +C<PERL_POLLUTE>, C<PERL_IMPLICIT_CONTEXT>, C<PERL_POLLUTE_MALLOC> -=item Tying FileHandles +=item Compatible C Source API Changes -TIEHANDLE classname, LIST, WRITE this, LIST, PRINT this, LIST, PRINTF this, -LIST, READ this, LIST, READLINE this, GETC this, CLOSE this, DESTROY this +C<PATCHLEVEL> is now C<PERL_VERSION> -=item The C<untie> Gotcha +=item Binary Incompatibilities =back -=item SEE ALSO - -=item BUGS +=item Known Problems -=item AUTHOR +=over -=back +=item Thread test failures -=head2 perlbot - Bag'o Object Tricks (the BOT) +=item EBCDIC platforms not supported -=over +=item In 64-bit HP-UX the lib/io_multihomed test may hang -=item DESCRIPTION +=item NEXTSTEP 3.3 POSIX test failure -=item OO SCALING TIPS +=item Tru64 (aka Digital UNIX, aka DEC OSF/1) lib/sdbm test failure with +gcc -=item INSTANCE VARIABLES +=item UNICOS/mk CC failures during Configure run -=item SCALAR INSTANCE VARIABLES +=item Arrow operator and arrays -=item INSTANCE VARIABLE INHERITANCE +=item Experimental features -=item OBJECT RELATIONSHIPS +Threads, Unicode, 64-bit support, Lvalue subroutines, Weak references, The +pseudo-hash data type, The Compiler suite, Internal implementation of file +globbing, The DB module, The regular expression constructs C<(?{ code })> +and C<(??{ code })> -=item OVERRIDING SUPERCLASS METHODS +=back -=item USING RELATIONSHIP WITH SDBM +=item Obsolete Diagnostics -=item THINKING OF CODE REUSE +Character class syntax [: :] is reserved for future extensions, Ill-formed +logical name |%s| in prime_env_iter, In string, @%s now must be written as +\@%s, Probable precedence problem on %s, regexp too big, Use of "$$<digit>" +to mean "${$}<digit>" is deprecated -=item CLASS CONTEXT AND THE OBJECT +=item Reporting Bugs -=item INHERITING A CONSTRUCTOR +=item SEE ALSO -=item DELEGATION +=item HISTORY =back -=head2 perlipc - Perl interprocess communication (signals, fifos, pipes, -safe subprocesses, sockets, and semaphores) +=head2 perl5005delta, perldelta - what's new for perl5.005 =over =item DESCRIPTION -=item Signals +=item About the new versioning system -=item Named Pipes +=item Incompatible Changes =over -=item WARNING +=item WARNING: This version is not binary compatible with Perl 5.004. -=back - -=item Using open() for IPC +=item Default installation structure has changed -=over +=item Perl Source Compatibility -=item Filehandles +=item C Source Compatibility -=item Background Processes +Core sources now require ANSI C compiler, All Perl global variables must +now be referenced with an explicit prefix, Enabling threads has source +compatibility issues -=item Complete Dissociation of Child from Parent +=item Binary Compatibility -=item Safe Pipe Opens +=item Security fixes may affect compatibility -=item Bidirectional Communication with Another Process +=item Relaxed new mandatory warnings introduced in 5.004 -=item Bidirectional Communication with Yourself +=item Licensing =back -=item Sockets: Client/Server Communication +=item Core Changes =over -=item Internet Line Terminators +=item Threads -=item Internet TCP Clients and Servers +=item Compiler -=item Unix-Domain TCP Clients and Servers +=item Regular Expressions -=back +Many new and improved optimizations, Many bug fixes, New regular expression +constructs, New operator for precompiled regular expressions, Other +improvements, Incompatible changes -=item TCP Clients with IO::Socket +=item Improved malloc() -=over +=item Quicksort is internally implemented -=item A Simple Client +=item Reliable signals -C<Proto>, C<PeerAddr>, C<PeerPort> +=item Reliable stack pointers -=item A Webget Client +=item More generous treatment of carriage returns -=item Interactive Client with IO::Socket +=item Memory leaks -=back +=item Better support for multiple interpreters -=item TCP Servers with IO::Socket +=item Behavior of local() on array and hash elements is now well-defined -Proto, LocalPort, Listen, Reuse +=item C<%!> is transparently tied to the L<Errno> module -=item UDP: Message Passing +=item Pseudo-hashes are supported -=item SysV IPC +=item C<EXPR foreach EXPR> is supported -=item NOTES +=item Keywords can be globally overridden -=item BUGS +=item C<$^E> is meaningful on Win32 -=item AUTHOR +=item C<foreach (1..1000000)> optimized -=item SEE ALSO +=item C<Foo::> can be used as implicitly quoted package name -=back +=item C<exists $Foo::{Bar::}> tests existence of a package -=head2 perldbmfilter - Perl DBM Filters +=item Better locale support -=over +=item Experimental support for 64-bit platforms -=item SYNOPSIS +=item prototype() returns useful results on builtins -=item DESCRIPTION +=item Extended support for exception handling -B<filter_store_key>, B<filter_store_value>, B<filter_fetch_key>, -B<filter_fetch_value> +=item Re-blessing in DESTROY() supported for chaining DESTROY() methods -=over +=item All C<printf> format conversions are handled internally -=item The Filter +=item New C<INIT> keyword -=item An Example -- the NULL termination problem. +=item New C<lock> keyword -=item Another Example -- Key is a C int. +=item New C<qr//> operator -=back +=item C<our> is now a reserved word -=item SEE ALSO +=item Tied arrays are now fully supported -=item AUTHOR +=item Tied handles support is better -=back +=item 4th argument to substr -=head2 perldebug - Perl debugging +=item Negative LENGTH argument to splice -=over +=item Magic lvalues are now more magical -=item DESCRIPTION +=item <> now reads in records -=item The Perl Debugger +=back + +=item Supported Platforms =over -=item Debugger Commands +=item New Platforms -h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n -[expr], r, <CR>, c [line|sub], l, l min+incr, l min-max, l line, l subname, --, w [line], f filename, /pattern/, ?pattern?, L, S [[!]regex], t, t expr, -b [line] [condition], b subname [condition], b postpone subname -[condition], b load filename, b compile subname, d [line], D, a [line] -command, a [line], A, W expr, W, O booloption .., O anyoption? .., O -option=value .., < ?, < [ command ], << command, > ?, > command, >> -command, { ?, { [ command ], {{ command, ! number, ! -number, ! pattern, !! -cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd, command, m expr, man [manpage] +=item Changes in existing support -=item Configurable Options +=back -C<recallCommand>, C<ShellBang>, C<pager>, C<tkRunning>, C<signalLevel>, -C<warnLevel>, C<dieLevel>, C<AutoTrace>, C<LineInfo>, C<inhibit_exit>, -C<PrintRet>, C<ornaments>, C<frame>, C<maxTraceLen>, C<arrayDepth>, -C<hashDepth>, C<compactDump>, C<veryCompact>, C<globPrint>, C<DumpDBFiles>, -C<DumpPackages>, C<DumpReused>, C<quote>, C<HighBit>, C<undefPrint>, -C<UsageOnly>, C<TTY>, C<noTTY>, C<ReadLine>, C<NonStop> +=item Modules and Pragmata -=item Debugger input/output +=over -Prompt, Multiline commands, Stack backtrace, Line Listing Format, Frame -listing +=item New Modules -=item Debugging compile-time statements +B, Data::Dumper, Dumpvalue, Errno, File::Spec, ExtUtils::Installed, +ExtUtils::Packlist, Fatal, IPC::SysV, Test, Tie::Array, Tie::Handle, +Thread, attrs, fields, re -=item Debugger Customization +=item Changes in existing modules -=item Readline Support +Benchmark, Carp, CGI, Fcntl, Math::Complex, Math::Trig, POSIX, DB_File, +MakeMaker, CPAN, Cwd, Benchmark -=item Editor Support for Debugging +=back -=item The Perl Profiler +=item Utility Changes -=back +=item Documentation Changes + +=item New Diagnostics + +Ambiguous call resolved as CORE::%s(), qualify as such or use &, Bad index +while coercing array into hash, Bareword "%s" refers to nonexistent +package, Can't call method "%s" on an undefined value, Can't check +filesystem of script "%s" for nosuid, Can't coerce array into hash, Can't +goto subroutine from an eval-string, Can't localize pseudo-hash element, +Can't use %%! because Errno.pm is not available, Cannot find an opnumber +for "%s", Character class syntax [. .] is reserved for future extensions, +Character class syntax [: :] is reserved for future extensions, Character +class syntax [= =] is reserved for future extensions, %s: Eval-group in +insecure regular expression, %s: Eval-group not allowed, use re 'eval', %s: +Eval-group not allowed at run time, Explicit blessing to '' (assuming +package main), Illegal hex digit ignored, No such array field, No such +field "%s" in variable %s of type %s, Out of memory during ridiculously +large request, Range iterator outside integer range, Recursive inheritance +detected while looking for method '%s' in package '%s', Reference found +where even-sized list expected, Undefined value assigned to typeglob, Use +of reserved word "%s" is deprecated, perl: warning: Setting locale failed -=item Debugging regular expressions +=item Obsolete Diagnostics -=item Debugging memory usage +Can't mktemp(), Can't write to temp file for B<-e>: %s, Cannot open +temporary file, regexp too big -=item SEE ALSO +=item Configuration Changes =item BUGS +=item SEE ALSO + +=item HISTORY + =back -=head2 perlnumber - semantics of numbers and numeric operations in Perl +=head2 perl5004delta, perldelta - what's new for perl5.004 =over -=item SYNOPSIS - =item DESCRIPTION -=item Storing numbers +=item Supported Environments -=item Numeric operators and numeric conversions +=item Core Changes -=item Flavors of Perl numeric operations +=over -Arithmetic operators except, C<no integer>, Arithmetic operators except, -C<use integer>, Bitwise operators, C<no integer>, Bitwise operators, C<use -integer>, Operators which expect an integer, Operators which expect a -string +=item List assignment to %ENV works -=item AUTHOR +=item "Can't locate Foo.pm in @INC" error now lists @INC -=item SEE ALSO +=item Compilation option: Binary compatibility with 5.003 -=back +=item $PERL5OPT environment variable -=head2 perldebguts - Guts of Perl debugging +=item Limitations on B<-M>, B<-m>, and B<-T> options -=over +=item More precise warnings -=item DESCRIPTION +=item Deprecated: Inherited C<AUTOLOAD> for non-methods -=item Debugger Internals +=item Previously deprecated %OVERLOAD is no longer usable -=over +=item Subroutine arguments created only when they're modified -=item Writing Your Own Debugger +=item Group vector changeable with C<$)> -=back +=item Fixed parsing of $$<digit>, &$<digit>, etc. -=item Frame Listing Output Examples +=item Fixed localization of $<digit>, $&, etc. -=item Debugging regular expressions +=item No resetting of $. on implicit close -=over +=item C<wantarray> may return undef -=item Compile-time output +=item C<eval EXPR> determines value of EXPR in scalar context -C<anchored> I<STRING> C<at> I<POS>, C<floating> I<STRING> C<at> -I<POS1..POS2>, C<matching floating/anchored>, C<minlen>, C<stclass> -I<TYPE>, C<noscan>, C<isall>, C<GPOS>, C<plus>, C<implicit>, C<with eval>, -C<anchored(TYPE)> +=item Changes to tainting checks -=item Types of nodes +No glob() or <*>, No spawning if tainted $CDPATH, $ENV, $BASH_ENV, No +spawning if tainted $TERM doesn't look like a terminal name -=item Run-time output +=item New Opcode module and revised Safe module -=back +=item Embedding improvements -=item Debugging Perl memory usage +=item Internal change: FileHandle class based on IO::* classes -=over +=item Internal change: PerlIO abstraction interface -=item Using C<$ENV{PERL_DEBUG_MSTATS}> +=item New and changed syntax -C<buckets SMALLEST(APPROX)..GREATEST(APPROX)>, Free/Used, C<Total sbrk(): -SBRKed/SBRKs:CONTINUOUS>, C<pad: 0>, C<heads: 2192>, C<chain: 0>, C<tail: -6144> +$coderef->(PARAMS) -=item Example of using B<-DL> switch +=item New and changed builtin constants -C<717>, C<002>, C<054>, C<602>, C<702>, C<704> +__PACKAGE__ -=item B<-DL> details +=item New and changed builtin variables -C<!!!>, C<!!>, C<!> +$^E, $^H, $^M -=item Limitations of B<-DL> statistics +=item New and changed builtin functions -=back +delete on slices, flock, printf and sprintf, keys as an lvalue, my() in +Control Structures, pack() and unpack(), sysseek(), use VERSION, use Module +VERSION LIST, prototype(FUNCTION), srand, $_ as Default, C<m//gc> does not +reset search position on failure, C<m//x> ignores whitespace before ?*+{}, +nested C<sub{}> closures work now, formats work right on changing lexicals -=item SEE ALSO +=item New builtin methods -=back +isa(CLASS), can(METHOD), VERSION( [NEED] ) -=head2 perldiag - various Perl diagnostics +=item TIEHANDLE now supported -=over +TIEHANDLE classname, LIST, PRINT this, LIST, PRINTF this, LIST, READ this +LIST, READLINE this, GETC this, DESTROY this -=item DESCRIPTION +=item Malloc enhancements -=back +-DPERL_EMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE -=head2 perlsec - Perl security +=item Miscellaneous efficiency enhancements -=over +=back -=item DESCRIPTION +=item Support for More Operating Systems =over -=item Laundering and Detecting Tainted Data +=item Win32 -=item Switches On the "#!" Line +=item Plan 9 -=item Cleaning Up Your Path +=item QNX -=item Security Bugs - -=item Protecting Your Programs +=item AmigaOS =back -=item SEE ALSO +=item Pragmata -=back +use autouse MODULE => qw(sub1 sub2 sub3), use blib, use blib 'dir', use +constant NAME => VALUE, use locale, use ops, use vmsish -=head2 perltrap - Perl traps for the unwary +=item Modules =over -=item DESCRIPTION +=item Required Updates -=over +=item Installation directories -=item Awk Traps +=item Module information summary -=item C Traps +=item Fcntl -=item Sed Traps +=item IO -=item Shell Traps +=item Math::Complex -=item Perl Traps - -=item Perl4 to Perl5 Traps - -Discontinuance, Deprecation, and BugFix traps, Parsing Traps, Numerical -Traps, General data type traps, Context Traps - scalar, list contexts, -Precedence Traps, General Regular Expression Traps using s///, etc, -Subroutine, Signal, Sorting Traps, OS Traps, DBM Traps, Unclassified Traps +=item Math::Trig -=item Discontinuance, Deprecation, and BugFix traps - -Discontinuance, Deprecation, BugFix, Discontinuance, Discontinuance, -Discontinuance, BugFix, Discontinuance, Discontinuance, BugFix, -Discontinuance, Deprecation, Discontinuance +=item DB_File -=item Parsing Traps +=item Net::Ping -Parsing, Parsing, Parsing, Parsing +=item Object-oriented overrides for builtin operators -=item Numerical Traps +=back -Numerical, Numerical, Numerical, Bitwise string ops +=item Utility Changes -=item General data type traps +=over -(Arrays), (Arrays), (Hashes), (Globs), (Globs), (Scalar String), -(Constants), (Scalars), (Variable Suicide) +=item pod2html -=item Context Traps - scalar, list contexts +Sends converted HTML to standard output -(list context), (scalar context), (scalar context), (list, builtin) +=item xsubpp -=item Precedence Traps +C<void> XSUBs now default to returning nothing -Precedence, Precedence, Precedence, Precedence, Precedence, Precedence, -Precedence +=back -=item General Regular Expression Traps using s///, etc. +=item C Language API Changes -Regular Expression, Regular Expression, Regular Expression, Regular -Expression, Regular Expression, Regular Expression, Regular Expression, -Regular Expression +C<gv_fetchmethod> and C<perl_call_sv>, C<perl_eval_pv>, Extended API for +manipulating hashes -=item Subroutine, Signal, Sorting Traps +=item Documentation Changes -(Signals), (Sort Subroutine), warn() won't let you specify a filehandle +L<perldelta>, L<perlfaq>, L<perllocale>, L<perltoot>, L<perlapio>, +L<perlmodlib>, L<perldebug>, L<perlsec> -=item OS Traps +=item New Diagnostics -(SysV), (SysV) +"my" variable %s masks earlier declaration in same scope, %s argument is +not a HASH element or slice, Allocation too large: %lx, Allocation too +large, Applying %s to %s will act on scalar(%s), Attempt to free +nonexistent shared string, Attempt to use reference as lvalue in substr, +Bareword "%s" refers to nonexistent package, Can't redefine active sort +subroutine %s, Can't use bareword ("%s") as %s ref while "strict refs" in +use, Cannot resolve method `%s' overloading `%s' in package `%s', Constant +subroutine %s redefined, Constant subroutine %s undefined, Copy method did +not return a reference, Died, Exiting pseudo-block via %s, Identifier too +long, Illegal character %s (carriage return), Illegal switch in PERL5OPT: +%s, Integer overflow in hex number, Integer overflow in octal number, +internal error: glob failed, Invalid conversion in %s: "%s", Invalid type +in pack: '%s', Invalid type in unpack: '%s', Name "%s::%s" used only once: +possible typo, Null picture in formline, Offset outside string, Out of +memory!, Out of memory during request for %s, panic: frexp, Possible +attempt to put comments in qw() list, Possible attempt to separate words +with commas, Scalar value @%s{%s} better written as $%s{%s}, Stub found +while resolving method `%s' overloading `%s' in package `%s', Too late for +"B<-T>" option, untie attempted while %d inner references still exist, +Unrecognized character %s, Unsupported function fork, Use of "$$<digit>" to +mean "${$}<digit>" is deprecated, Value of %s can be "0"; test with +defined(), Variable "%s" may be unavailable, Variable "%s" will not stay +shared, Warning: something's wrong, Ill-formed logical name |%s| in +prime_env_iter, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX, +PERL_SH_DIR too long, Process terminated by SIG%s -=item Interpolation Traps +=item BUGS -Interpolation, Interpolation, Interpolation, Interpolation, Interpolation, -Interpolation, Interpolation, Interpolation, Interpolation +=item SEE ALSO -=item DBM Traps +=item HISTORY -DBM, DBM +=back -=item Unclassified Traps +=head2 perlamiga - Perl under Amiga OS (possibly very outdated information) -C<require>/C<do> trap using returned value, C<split> on empty string with -LIMIT specified +=over -=back +=item SYNOPSIS =back -=head2 perlport - Writing portable Perl - =over =item DESCRIPTION -Not all Perl programs have to be portable, Nearly all of Perl already I<is> -portable - -=item ISSUES - =over -=item Newlines +=item Prerequisites -=item Numbers endianness and Width +B<Unix emulation for AmigaOS: ixemul.library>, B<Version of Amiga OS> -=item Files and Filesystems +=item Starting Perl programs under AmigaOS -=item System Interaction +=item Shortcomings of Perl under AmigaOS -=item Interprocess Communication (IPC) +fork(), some features of the UNIX filesystem regarding link count and file +dates, inplace operation (the -i switch) without backup file, umask() +works, but the correct permissions are only set when the file is +finally close()d -=item External Subroutines (XS) +=back -=item Standard Modules +=item INSTALLATION -=item Time and Date +=item Accessing documentation -=item Character sets and character encoding +=over -=item Internationalisation +=item Manpages -=item System Resources +=item B<HTML> -=item Security +=item B<GNU> C<info> files -=item Style +=item C<LaTeX> docs =back -=item CPAN Testers - -Mailing list: cpan-testers@perl.org, Testing results: -http://testers.cpan.org/ - -=item PLATFORMS +=item BUILD =over -=item Unix +=item Prerequisites -=item DOS and Derivatives +=item Getting the perl source -Build instructions for OS/2, L<perlos2> +=item Making -=item S<Mac OS> +=item Testing -=item VMS - -=item VOS - -=item EBCDIC Platforms - -=item Acorn RISC OS - -=item Other perls +=item Installing the built perl =back -=item FUNCTION IMPLEMENTATIONS - -=over - -=item Alphabetical Listing of Perl Functions +=item AUTHOR --I<X> FILEHANDLE, -I<X> EXPR, -I<X>, alarm SECONDS, alarm, binmode -FILEHANDLE, chmod LIST, chown LIST, chroot FILENAME, chroot, crypt -PLAINTEXT,SALT, dbmclose HASH, dbmopen HASH,DBNAME,MODE, dump LABEL, exec -LIST, fcntl FILEHANDLE,FUNCTION,SCALAR, flock FILEHANDLE,OPERATION, fork, -getlogin, getpgrp PID, getppid, getpriority WHICH,WHO, getpwnam NAME, -getgrnam NAME, getnetbyname NAME, getpwuid UID, getgrgid GID, getnetbyaddr -ADDR,ADDRTYPE, getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent, -getgrent, gethostent, getnetent, getprotoent, getservent, setpwent, -setgrent, sethostent STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, -setservent STAYOPEN, endpwent, endgrent, endhostent, endnetent, -endprotoent, endservent, getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, -ioctl FILEHANDLE,FUNCTION,SCALAR, kill SIGNAL, LIST, link OLDFILE,NEWFILE, -lstat FILEHANDLE, lstat EXPR, lstat, msgctl ID,CMD,ARG, msgget KEY,FLAGS, -msgsnd ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, open FILEHANDLE,EXPR, -open FILEHANDLE, pipe READHANDLE,WRITEHANDLE, readlink EXPR, readlink, -select RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget -KEY,NSEMS,FLAGS, semop KEY,OPSTRING, setgrent, setpgrp PID,PGRP, -setpriority WHICH,WHO,PRIORITY, setpwent, setsockopt -SOCKET,LEVEL,OPTNAME,OPTVAL, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, -shmread ID,VAR,POS,SIZE, shmwrite ID,STRING,POS,SIZE, socketpair -SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, stat FILEHANDLE, stat EXPR, stat, -symlink OLDFILE,NEWFILE, syscall LIST, sysopen -FILEHANDLE,FILENAME,MODE,PERMS, system LIST, times, truncate -FILEHANDLE,LENGTH, truncate EXPR,LENGTH, umask EXPR, umask, utime LIST, -wait, waitpid PID,FLAGS +=item SEE ALSO =back -=item CHANGES +=head2 perlcygwin, README.cygwin - Perl for Cygwin -v1.47, 22 March 2000, v1.46, 12 February 2000, v1.45, 20 December 1999, -v1.44, 19 July 1999, v1.43, 24 May 1999, v1.42, 22 May 1999, v1.41, 19 May -1999, v1.40, 11 April 1999, v1.39, 11 February 1999, v1.38, 31 December -1998, v1.37, 19 December 1998, v1.36, 9 September 1998, v1.35, 13 August -1998, v1.33, 06 August 1998, v1.32, 05 August 1998, v1.30, 03 August 1998, -v1.23, 10 July 1998 - -=item Supported Platforms - -=item SEE ALSO - -=item AUTHORS / CONTRIBUTORS - -=item VERSION +=over -=back +=item SYNOPSIS -=head2 perlstyle - Perl style guide +=item PREREQUISITES =over -=item DESCRIPTION +=item Cygwin = GNU+Cygnus+Windows (Don't leave UNIX without it) -=back +=item Cygwin Configuration -=head2 perlpod - plain old documentation +C<PATH>, I<nroff>, Permissions -=over +=back -=item DESCRIPTION +=item CONFIGURE =over -=item Verbatim Paragraph +=item Strip Binaries -=item Command Paragraph +=item Optional Libraries -=item Ordinary Block of Text +C<-lcrypt>, C<-lgdbm> (C<use GDBM_File>), C<-ldb> (C<use DB_File>), +C<-lcygipc> (C<use IPC::SysV>) -=item The Intent +=item Configure-time Options -=item Embedding Pods in Perl Modules +C<-Uusedl>, C<-Uusemymalloc>, C<-Dusemultiplicity>, C<-Duseperlio>, +C<-Duse64bitint>, C<-Duselongdouble>, C<-Dusethreads>, C<-Duselargefiles> -=item Common Pod Pitfalls - -=back - -=item SEE ALSO +=item Suspicious Warnings -=item AUTHOR +Whoa There, I<dlsym()>, Win9x and C<d_eofnblk>, Checking how std your stdio +is.., Compiler/Preprocessor defines =back -=head2 perlbook - Perl book information +=item MAKE =over -=item DESCRIPTION +=item Warnings + +=item ld2 =back -=head2 perlembed - how to embed perl in your C program +=item TEST =over -=item DESCRIPTION +=item File Permissions -=over +=item Hard Links -=item PREAMBLE +=item Filetime Granularity -B<Use C from Perl?>, B<Use a Unix program from Perl?>, B<Use Perl from -Perl?>, B<Use C from C?>, B<Use Perl from C?> +=item Tainting Checks -=item ROADMAP +=item /etc/group -=item Compiling your C program +=item Script Portability -=item Adding a Perl interpreter to your C program +Pathnames, Text/Binary, F<.exe>, chown(), Miscellaneous -=item Calling a Perl subroutine from your C program +=back -=item Evaluating a Perl statement from your C program +=item INSTALL -=item Performing Perl pattern matches and substitutions from your C program +=item MANIFEST -=item Fiddling with the Perl stack from your C program +Documentation, Build, Configure, Make, Install, Tests, Compiled Perl +Source, Compiled Module Source, Perl Modules/Scripts -=item Maintaining a persistent interpreter +=item BUGS -=item Maintaining multiple interpreter instances +=item AUTHORS -=item Using Perl modules, which themselves use C libraries, from your C -program +=item HISTORY =back -=item Embedding Perl under Win32 - -=item MORAL +=head2 perldos - Perl under DOS, W31, W95. -=item AUTHOR - -=item COPYRIGHT +=over -=back +=item SYNOPSIS -=head2 perlapio - perl's IO abstraction interface. +=item DESCRIPTION =over -=item SYNOPSIS +=item Prerequisites -=item DESCRIPTION +DJGPP, Pthreads -B<PerlIO *>, B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()>, -B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)>, -B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)>, -B<PerlIO_stdoutf(fmt,...)>, B<PerlIO_read(f,buf,count)>, -B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(f,s)>, -B<PerlIO_putc(f,c)>, B<PerlIO_ungetc(f,c)>, B<PerlIO_getc(f)>, -B<PerlIO_eof(f)>, B<PerlIO_error(f)>, B<PerlIO_fileno(f)>, -B<PerlIO_clearerr(f)>, B<PerlIO_flush(f)>, B<PerlIO_tell(f)>, -B<PerlIO_seek(f,o,w)>, B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)>, -B<PerlIO_rewind(f)>, B<PerlIO_tmpfile()> +=item Shortcomings of Perl under DOS -=over +=item Building -=item Co-existence with stdio +=item Testing -B<PerlIO_importFILE(f,flags)>, B<PerlIO_exportFILE(f,flags)>, -B<PerlIO_findFILE(f)>, B<PerlIO_releaseFILE(p,f)>, B<PerlIO_setlinebuf(f)>, -B<PerlIO_has_cntptr(f)>, B<PerlIO_get_ptr(f)>, B<PerlIO_get_cnt(f)>, -B<PerlIO_canset_cnt(f)>, B<PerlIO_fast_gets(f)>, -B<PerlIO_set_ptrcnt(f,p,c)>, B<PerlIO_set_cnt(f,c)>, B<PerlIO_has_base(f)>, -B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> +=item Installation =back +=item AUTHOR + +=item SEE ALSO + =back -=head2 perlxs - XS language reference manual +=head2 perlhpux, README.hpux - Perl version 5 on Hewlett-Packard Unix +(HP-UX) systems =over @@ -3388,522 +5483,480 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =over -=item Introduction +=item Compiling Perl 5 on HP-UX -=item On The Road +=item PA-RISC -=item The Anatomy of an XSUB +=item PA-RISC 1.0 -=item The Argument Stack +=item PA-RISC 1.1 -=item The RETVAL Variable +=item PA-RISC 2.0 -=item The MODULE Keyword +=item Portability Between PA-RISC Versions -=item The PACKAGE Keyword +=item Building Dynamic Extensions on HP-UX -=item The PREFIX Keyword +=item The HP ANSI C Compiler -=item The OUTPUT: Keyword +=item Using Large Files with Perl -=item The CODE: Keyword +=item Threaded Perl -=item The INIT: Keyword +=item 64-bit Perl -=item The NO_INIT Keyword +=item GDBM and Threads -=item Initializing Function Parameters +=item NFS filesystems and utime(2) -=item Default Parameter Values +=item perl -P and // -=item The PREINIT: Keyword +=back -=item The SCOPE: Keyword +=item AUTHOR -=item The INPUT: Keyword +=item DATE -=item Variable-length Parameter Lists +=back -=item The C_ARGS: Keyword +=head2 perlmachten, README.machten - Perl version 5 on Power MachTen +systems -=item The PPCODE: Keyword +=over -=item Returning Undef And Empty Lists +=item DESCRIPTION -=item The REQUIRE: Keyword +=over -=item The CLEANUP: Keyword +=item Compiling Perl 5 on MachTen -=item The BOOT: Keyword +=item Failures during C<make test> -=item The VERSIONCHECK: Keyword +op/lexassign.t, pragma/warnings.t -=item The PROTOTYPES: Keyword +=item Building external modules -=item The PROTOTYPE: Keyword +=back -=item The ALIAS: Keyword +=item AUTHOR -=item The INTERFACE: Keyword +=item DATE -=item The INTERFACE_MACRO: Keyword +=back -=item The INCLUDE: Keyword +=head2 perlos2 - Perl under OS/2, DOS, Win0.3*, Win0.95 and WinNT. -=item The CASE: Keyword +=over -=item The & Unary Operator +=item SYNOPSIS -=item Inserting Comments and C Preprocessor Directives +=back -=item Using XS With C++ +=over -=item Interface Strategy +=item Target -=item Perl Objects And C Structures +=item Other OSes -=item The Typemap +=item Prerequisites -=back +EMX, RSX, HPFS, pdksh -=item EXAMPLES +=item Starting Perl programs under OS/2 (and DOS and...) -=item XS VERSION - -=item AUTHOR +=item Starting OS/2 (and DOS) programs under Perl =back -=head2 perlxstut, perlXStut - Tutorial for writing XSUBs - =over -=item DESCRIPTION - -=item SPECIAL NOTES +=item Frequently asked questions =over -=item make +=item I cannot run external programs -=item Version caveat +=item I cannot embed perl into my program, or use F<perl.dll> from my +program. -=item Dynamic Loading versus Static Loading +Is your program EMX-compiled with C<-Zmt -Zcrtdll>?, Did you use +L<ExtUtils::Embed>? + +=item C<``> and pipe-C<open> do not work under DOS. + +=item Cannot start C<find.exe "pattern" file> =back -=item TUTORIAL +=item INSTALLATION =over -=item EXAMPLE 1 +=item Automatic binary installation -=item EXAMPLE 2 +C<PERL_BADLANG>, C<PERL_BADFREE>, F<Config.pm> -=item What has gone on? +=item Manual binary installation -=item Writing good test scripts +Perl VIO and PM executables (dynamically linked), Perl_ VIO executable +(statically linked), Executables for Perl utilities, Main Perl library, +Additional Perl modules, Tools to compile Perl modules, Manpages for Perl +and utilities, Manpages for Perl modules, Source for Perl documentation, +Perl manual in F<.INF> format, Pdksh -=item EXAMPLE 3 +=item B<Warning> -=item What's new here? +=back -=item Input and Output Parameters +=item Accessing documentation -=item The XSUBPP Program +=over -=item The TYPEMAP file +=item OS/2 F<.INF> file -=item Warning about Output Arguments +=item Plain text -=item EXAMPLE 4 +=item Manpages -=item What has happened here? +=item HTML -=item Anatomy of .xs file +=item GNU C<info> files -=item Getting the fat out of XSUBs +=item F<.PDF> files -=item More about XSUB arguments +=item C<LaTeX> docs -=item The Argument Stack +=back -=item Extending your Extension +=item BUILD -=item Documenting your Extension +=over -=item Installing your Extension +=item Prerequisites -=item EXAMPLE 5 +=item Getting perl source -=item New Things in this Example +=item Application of the patches -=item EXAMPLE 6 (Coming Soon) +=item Hand-editing -=item EXAMPLE 7 (Coming Soon) +=item Making -=item EXAMPLE 8 (Coming Soon) +=item Testing -=item EXAMPLE 9 (Coming Soon) +A lot of C<bad free>, Process terminated by SIGTERM/SIGINT, F<op/fs.t>, +F<lib/io_pipe.t>, F<lib/io_sock.t>, F<op/stat.t>, F<lib/io_udp.t> -=item Troubleshooting these Examples +=item Installing the built perl -=back +=item C<a.out>-style build -=item See also +=back -=item Author +=item Build FAQ =over -=item Last Changed +=item Some C</> became C<\> in pdksh. -=back +=item C<'errno'> - unresolved external -=back +=item Problems with tr or sed -=head2 perlguts - Introduction to the Perl API +=item Some problem (forget which ;-) -=over +=item Library ... not found -=item DESCRIPTION +=item Segfault in make -=item Variables +=back + +=item Specific (mis)features of OS/2 port =over -=item Datatypes +=item C<setpriority>, C<getpriority> -=item What is an "IV"? +=item C<system()> -=item Working with SVs +=item C<extproc> on the first line -=item What's Really Stored in an SV? +=item Additional modules: -=item Working with AVs +=item Prebuilt methods: -=item Working with HVs +C<File::Copy::syscopy>, C<DynaLoader::mod2fname>, C<Cwd::current_drive()>, + C<Cwd::sys_chdir(name)>, C<Cwd::change_drive(name)>, +C<Cwd::sys_is_absolute(name)>, C<Cwd::sys_is_rooted(name)>, +C<Cwd::sys_is_relative(name)>, C<Cwd::sys_cwd(name)>, +C<Cwd::sys_abspath(name, dir)>, C<Cwd::extLibpath([type])>, +C<Cwd::extLibpath_set( path [, type ] )> -=item Hash API Extensions +=item Misfeatures -=item References +=item Modifications -=item Blessed References and Class Objects +C<popen>, C<tmpnam>, C<tmpfile>, C<ctermid>, C<stat>, C<flock> -=item Creating New Variables +=back -=item Reference Counts and Mortality +=item Perl flavors -=item Stashes and Globs +=over -=item Double-Typed SVs +=item F<perl.exe> -=item Magic Variables +=item F<perl_.exe> -=item Assigning Magic +=item F<perl__.exe> -=item Magic Virtual Tables +=item F<perl___.exe> -=item Finding Magic +=item Why strange names? -=item Understanding the Magic of Tied Hashes and Arrays +=item Why dynamic linking? -=item Localizing changes +=item Why chimera build? -C<SAVEINT(int i)>, C<SAVEIV(IV i)>, C<SAVEI32(I32 i)>, C<SAVELONG(long i)>, -C<SAVESPTR(s)>, C<SAVEPPTR(p)>, C<SAVEFREESV(SV *sv)>, C<SAVEFREEOP(OP -*op)>, C<SAVEFREEPV(p)>, C<SAVECLEARSV(SV *sv)>, C<SAVEDELETE(HV *hv, char -*key, I32 length)>, C<SAVEDESTRUCTOR(DESTRUCTORFUNC_NOCONTEXT_t f, void -*p)>, C<SAVEDESTRUCTOR_X(DESTRUCTORFUNC_t f, void *p)>, C<SAVESTACK_POS()>, -C<SV* save_scalar(GV *gv)>, C<AV* save_ary(GV *gv)>, C<HV* save_hash(GV -*gv)>, C<void save_item(SV *item)>, C<void save_list(SV **sarg, I32 -maxsarg)>, C<SV* save_svref(SV **sptr)>, C<void save_aptr(AV **aptr)>, -C<void save_hptr(HV **hptr)> +explicit fork(), open FH, "|-", open FH, "-|" =back -=item Subroutines +=item ENVIRONMENT =over -=item XSUBs and the Argument Stack - -=item Calling Perl Routines from within C Programs +=item C<PERLLIB_PREFIX> -=item Memory Allocation +=item C<PERL_BADLANG> -=item PerlIO +=item C<PERL_BADFREE> -=item Putting a C value on Perl stack +=item C<PERL_SH_DIR> -=item Scratchpads +=item C<USE_PERL_FLOCK> -=item Scratchpads and recursion +=item C<TMP> or C<TEMP> =back -=item Compiled code +=item Evolution =over -=item Code tree +=item Priorities -=item Examining the tree +=item DLL name mangling -=item Compile pass 1: check routines +=item Threading -=item Compile pass 1a: constant folding +=item Calls to external programs -=item Compile pass 2: context propagation +=item Memory allocation -=item Compile pass 3: peephole optimization +=item Threads + +C<COND_WAIT>, F<os2.c> =back -=item How multiple interpreters and concurrency are supported +=back =over -=item Background and PERL_IMPLICIT_CONTEXT - -=item How do I use all this in extensions? - -=item Future Plans and PERL_IMPLICIT_SYS - -=back - -=item AUTHORS +=item AUTHOR =item SEE ALSO =back -=head2 perlcall - Perl calling conventions from C +=head2 perlos390, README.os390 - building and installing Perl for OS/390. =over -=item DESCRIPTION +=item SYNOPSIS -An Error Handler, An Event Driven Program +=item DESCRIPTION -=item THE CALL_ FUNCTIONS +=over -call_sv, call_pv, call_method, call_argv +=item Unpacking -=item FLAG VALUES +=item Setup and utilities -=over +=item Configure -=item G_VOID +=item Build, test, install -=item G_SCALAR +=item Usage Hints -=item G_ARRAY +=item Extensions -=item G_DISCARD +=back -=item G_NOARGS +=item AUTHORS -=item G_EVAL +=item SEE ALSO -=item G_KEEPERR +=over -=item Determining the Context +=item Mailing list =back -=item KNOWN PROBLEMS +=item HISTORY -=item EXAMPLES +=back + +=head2 perlposix-bc, README.posix-bc - building and installing Perl for +BS2000 POSIX. =over -=item No Parameters, Nothing returned +=item SYNOPSIS -=item Passing Parameters +=item DESCRIPTION -=item Returning a Scalar +=over -=item Returning a list of values +=item gzip -=item Returning a list in a scalar context +=item bison -=item Returning Data from Perl via the parameter list +=item Unpacking -=item Using G_EVAL +=item Compiling -=item Using G_KEEPERR +=item Testing -=item Using call_sv +=item Install -=item Using call_argv +=item Using Perl -=item Using call_method +=back -=item Using GIMME_V +=item AUTHORS -=item Using Perl to dispose of temporaries +=item SEE ALSO -=item Strategies for storing Callback Context Information +=over -1. Ignore the problem - Allow only 1 callback, 2. Create a sequence of -callbacks - hard wired limit, 3. Use a parameter to map to the Perl -callback +=item Mailing list -=item Alternate Stack Manipulation +=back -=item Creating and calling an anonymous subroutine in C +=item HISTORY =back -=item SEE ALSO +=head2 perlvms - VMS-specific documentation for Perl -=item AUTHOR +=over -=item DATE +=item DESCRIPTION -=back +=item Installation -=head2 perlcompile - Introduction to the Perl Compiler-Translator +=item Organization of Perl Images =over -=item DESCRIPTION +=item Core Images -=over +=item Perl Extensions -=item Layout +=item Installing static extensions -B::Bytecode, B::C, B::CC, B::Lint, B::Deparse, B::Xref +=item Installing dynamic extensions =back -=item Using The Back Ends +=item File specifications =over -=item The Cross Referencing Back End +=item Syntax -i, &, s, r +=item Wildcard expansion -=item The Decompiling Back End +=item Pipes -=item The Lint Back End +=back -=item The Simple C Back End +=item PERL5LIB and PERLLIB -=item The Bytecode Back End +=item Command line -=item The Optimized C Back End +=over -B, O, B::Asmdata, B::Assembler, B::Bblock, B::Bytecode, B::C, B::CC, -B::Debug, B::Deparse, B::Disassembler, B::Lint, B::Showlex, B::Stackobj, -B::Stash, B::Terse, B::Xref +=item I/O redirection and backgrounding -=back +=item Command line switches -=item KNOWN PROBLEMS - -=item AUTHOR +-i, -S, -u =back -=head2 perlapi - autogenerated documentation for the perl public API +=item Perl functions -=over +File tests, backticks, binmode FILEHANDLE, crypt PLAINTEXT, USER, dump, +exec LIST, fork, getpwent, getpwnam, getpwuid, gmtime, kill, qx//, select +(system call), stat EXPR, system LIST, time, times, unlink LIST, utime +LIST, waitpid PID,FLAGS -=item DESCRIPTION +=item Perl variables -AvFILL, av_clear, av_extend, av_fetch, av_len, av_make, av_pop, av_push, -av_shift, av_store, av_undef, av_unshift, call_argv, call_method, call_pv, -call_sv, CLASS, Copy, croak, CvSTASH, dMARK, dORIGMARK, dSP, dXSARGS, -dXSI32, ENTER, eval_pv, eval_sv, EXTEND, fbm_compile, fbm_instr, FREETMPS, -get_av, get_cv, get_hv, get_sv, GIMME, GIMME_V, GvSV, gv_fetchmeth, -gv_fetchmethod, gv_fetchmethod_autoload, gv_stashpv, gv_stashsv, G_ARRAY, -G_DISCARD, G_EVAL, G_NOARGS, G_SCALAR, G_VOID, HEf_SVKEY, HeHASH, HeKEY, -HeKLEN, HePV, HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, HvNAME, hv_clear, -hv_delete, hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, -hv_iterinit, hv_iterkey, hv_iterkeysv, hv_iternext, hv_iternextsv, -hv_iterval, hv_magic, hv_store, hv_store_ent, hv_undef, isALNUM, isALPHA, -isDIGIT, isLOWER, isSPACE, isUPPER, items, ix, LEAVE, looks_like_number, -MARK, mg_clear, mg_copy, mg_find, mg_free, mg_get, mg_length, mg_magical, -mg_set, Move, New, newAV, Newc, newCONSTSUB, newHV, newRV_inc, newRV_noinc, -NEWSV, newSViv, newSVnv, newSVpv, newSVpvf, newSVpvn, newSVrv, newSVsv, -newSVuv, newXS, newXSproto, Newz, Nullav, Nullch, Nullcv, Nullhv, Nullsv, -ORIGMARK, perl_alloc, perl_construct, perl_destruct, perl_free, perl_parse, -perl_run, PL_DBsingle, PL_DBsub, PL_DBtrace, PL_dowarn, PL_modglobal, -PL_na, PL_sv_no, PL_sv_undef, PL_sv_yes, POPi, POPl, POPn, POPp, POPs, -PUSHi, PUSHMARK, PUSHn, PUSHp, PUSHs, PUSHu, PUTBACK, Renew, Renewc, -require_pv, RETVAL, Safefree, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, -strEQ, strGE, strGT, strLE, strLT, strNE, strnEQ, strnNE, StructCopy, -SvCUR, SvCUR_set, SvEND, SvGETMAGIC, SvGROW, SvIOK, SvIOKp, SvIOK_off, -SvIOK_on, SvIOK_only, SvIV, SvIVX, SvLEN, SvNIOK, SvNIOKp, SvNIOK_off, -SvNOK, SvNOKp, SvNOK_off, SvNOK_on, SvNOK_only, SvNV, SvNVX, SvOK, SvOOK, -SvPOK, SvPOKp, SvPOK_off, SvPOK_on, SvPOK_only, SvPV, SvPVX, SvPV_force, -SvPV_nolen, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, -SvROK_on, SvRV, SvSETMAGIC, SvSetSV, SvSetSV_nosteal, SvSTASH, SvTAINT, -SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, SvTYPE, svtype, SVt_IV, -SVt_NV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUPGRADE, SvUV, -SvUVX, sv_2mortal, sv_bless, sv_catpv, sv_catpvf, sv_catpvf_mg, sv_catpvn, -sv_catpvn_mg, sv_catpv_mg, sv_catsv, sv_catsv_mg, sv_chop, sv_cmp, sv_dec, -sv_derived_from, sv_eq, sv_grow, sv_inc, sv_insert, sv_isa, sv_isobject, -sv_len, sv_magic, sv_mortalcopy, sv_newmortal, sv_setiv, sv_setiv_mg, -sv_setnv, sv_setnv_mg, sv_setpv, sv_setpvf, sv_setpvf_mg, sv_setpviv, -sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpv_mg, sv_setref_iv, -sv_setref_nv, sv_setref_pv, sv_setref_pvn, sv_setsv, sv_setsv_mg, sv_setuv, -sv_setuv_mg, sv_unref, sv_upgrade, sv_usepvn, sv_usepvn_mg, sv_vcatpvfn, -sv_vsetpvfn, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs, -XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO, -XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNO, -XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK, -Zero +%ENV, CRTL_ENV, CLISYM_[LOCAL], Any other string, $!, $^E, $?, $^S, $| -=item AUTHORS +=item Standard modules with VMS-specific differences -=item SEE ALSO +=over + +=item SDBM_File =back -=head2 perlintern - autogenerated documentation of purely B<internal> - Perl functions +=item Revision date -=over +=item AUTHOR -=item DESCRIPTION +=back -=item AUTHORS +=head2 perlwin32 - Perl under Win32 -=item SEE ALSO +=over -=back +=item SYNOPSIS -=head2 perlhist - the Perl history records +=item DESCRIPTION =over -=item DESCRIPTION +=item Setting Up -=item INTRODUCTION +Make, Command Shell, Borland C++, Microsoft Visual C++, Mingw32 with GCC -=item THE KEEPERS OF THE PUMPKIN +=item Building -=over +=item Testing -=item PUMPKIN? +=item Installation -=back +=item Usage Hints -=item THE RECORDS +Environment Variables, File Globbing, Using perl from the command line, +Building Extensions, Command-line Wildcard Expansion, Win32 Specific +Extensions, Running Perl Scripts, Miscellaneous Things -=over +=back -=item SELECTED RELEASE SIZES +=item BUGS AND CAVEATS -=item SELECTED PATCH SIZES +=item AUTHORS -=back +=item SEE ALSO -=item THE KEEPERS OF THE RECORDS +=item HISTORY =back @@ -4411,6 +6464,8 @@ warnings::warn([$category,] $message) =back +=head2 warnings::register - warnings import function + =head1 MODULE DOCUMENTATION =head2 AnyDBM_File - provide framework for multiple DBMs @@ -4451,6 +6506,8 @@ warnings::warn([$category,] $message) =item Package Lexicals +=item Not Using AutoLoader + =item B<AutoLoader> vs. B<SelfLoader> =back @@ -4849,6 +6906,8 @@ B<-u Package> =back +=head2 B::Stash - show what stashes are loaded + =head2 B::Terse - Walk Perl syntax tree, printing terse info about ops =over @@ -4987,7 +7046,7 @@ B<-On>, B<-D>, B<-Do>, B<-Db>, B<-Da>, B<-DC>, B<-S>, B<-m> =item CALLING CGI.PM ROUTINES -1. Use another name for the argument, if one is available. Forexample, +1. Use another name for the argument, if one is available. For example, -value is an alias for -values, 2. Change the capitalization, e.g. -Values, 3. Put quotes around the argument name, e.g. '-values' @@ -5026,8 +7085,8 @@ B<:standard>, B<:all> =item PRAGMAS --any, -compile, -nph, -newstyle_urls, -autoload, -no_debug, --private_tempfiles +-any, -compile, -nosticky, -nph, -newstyle_urls, -oldstyle_urls, -autoload, +-no_debug, -debug, -private_tempfiles =item SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS @@ -5074,6 +7133,11 @@ B<-absolute>, B<-relative>, B<-full>, B<-path> (B<-path_info>), B<-query> =item NON-STANDARD HTML SHORTCUTS +=item AUTOESCAPING HTML + +$escaped_string = escapeHTML("unescaped string");, $charset = +charset([$charset]);, $flag = autoEscape([$flag]); + =item PRETTY-PRINTING HTML =back @@ -5132,9 +7196,8 @@ B<Parameters:> =item CREATING A CLICKABLE IMAGE BUTTON -B<Parameters:>, 3.The third option (-align, optional) is an alignment type, -and may be -TOP, BOTTOM or MIDDLE +B<Parameters:>, 3. The third option (-align, optional) is an alignment +type, and may be TOP, BOTTOM or MIDDLE =item CREATING A JAVASCRIPT ACTION BUTTON @@ -5164,11 +7227,11 @@ the <FORM> tag =item FETCHING ENVIRONMENT VARIABLES B<Accept()>, B<raw_cookie()>, B<user_agent()>, B<path_info()>, -B<path_translated()>, B<remote_host()>, B<script_name()>Return the script -name as a partial URL, for self-refering -scripts, B<referer()>, B<auth_type ()>, B<server_name ()>, B<virtual_host -()>, B<server_software ()>, B<remote_user ()>, B<user_name ()>, -B<request_method()>, B<content_type()>, B<http()>, B<https()> +B<path_translated()>, B<remote_host()>, B<script_name()> Return the script +name as a partial URL, for self-refering scripts, B<referer()>, B<auth_type +()>, B<server_name ()>, B<virtual_host ()>, B<server_software ()>, +B<remote_user ()>, B<user_name ()>, B<request_method()>, B<content_type()>, +B<http()>, B<https()> =item USING NPH SCRIPTS @@ -5388,6 +7451,8 @@ B<name()>, B<value()>, B<domain()>, B<path()>, B<expires()> =back +=head2 CGI::Util - various utilities + =head2 CPAN - query, download and build perl modules from CPAN sites =over @@ -5600,55 +7665,56 @@ C<d_closedir>, C<d_const>, C<d_crypt>, C<d_csh>, C<d_cuserid>, C<d_dbl_dig>, C<d_difftime>, C<d_dirnamlen>, C<d_dlerror>, C<d_dlopen>, C<d_dlsymun>, C<d_dosuid>, C<d_drand48proto>, C<d_dup2>, C<d_eaccess>, C<d_endgrent>, C<d_endhent>, C<d_endnent>, C<d_endpent>, C<d_endpwent>, -C<d_endsent>, C<d_endspent>, C<d_eofnblk>, C<d_eunice>, C<d_fchmod>, -C<d_fchown>, C<d_fcntl>, C<d_fd_macros>, C<d_fd_set>, C<d_fds_bits>, -C<d_fgetpos>, C<d_flexfnam>, C<d_flock>, C<d_fork>, C<d_fpathconf>, -C<d_fpos64_t>, C<d_fs_data_s>, C<d_fseeko>, C<d_fsetpos>, C<d_fstatfs>, +C<d_endsent>, C<d_eofnblk>, C<d_eunice>, C<d_fchmod>, C<d_fchown>, +C<d_fcntl>, C<d_fd_macros>, C<d_fd_set>, C<d_fds_bits>, C<d_fgetpos>, +C<d_flexfnam>, C<d_flock>, C<d_fork>, C<d_fpathconf>, C<d_fpos64_t>, +C<d_frexpl>, C<d_fs_data_s>, C<d_fseeko>, C<d_fsetpos>, C<d_fstatfs>, C<d_fstatvfs>, C<d_ftello>, C<d_ftime>, C<d_Gconvert>, C<d_getcwd>, -C<d_getfsstat>, C<d_getgrent>, C<d_getgrps>, C<d_gethbyaddr>, -C<d_gethbyname>, C<d_gethent>, C<d_gethname>, C<d_gethostprotos>, -C<d_getlogin>, C<d_getmnt>, C<d_getmntent>, C<d_getnbyaddr>, -C<d_getnbyname>, C<d_getnent>, C<d_getnetprotos>, C<d_getpbyname>, -C<d_getpbynumber>, C<d_getpent>, C<d_getpgid>, C<d_getpgrp2>, C<d_getpgrp>, -C<d_getppid>, C<d_getprior>, C<d_getprotoprotos>, C<d_getpwent>, -C<d_getsbyname>, C<d_getsbyport>, C<d_getsent>, C<d_getservprotos>, -C<d_getspent>, C<d_getspnam>, C<d_gettimeod>, C<d_gnulibc>, C<d_grpasswd>, -C<d_hasmntopt>, C<d_htonl>, C<d_iconv>, C<d_index>, C<d_inetaton>, -C<d_int64_t>, C<d_isascii>, C<d_killpg>, C<d_lchown>, C<d_ldbl_dig>, +C<d_getespwnam>, C<d_getfsstat>, C<d_getgrent>, C<d_getgrps>, +C<d_gethbyaddr>, C<d_gethbyname>, C<d_gethent>, C<d_gethname>, +C<d_gethostprotos>, C<d_getlogin>, C<d_getmnt>, C<d_getmntent>, +C<d_getnbyaddr>, C<d_getnbyname>, C<d_getnent>, C<d_getnetprotos>, +C<d_getpbyname>, C<d_getpbynumber>, C<d_getpent>, C<d_getpgid>, +C<d_getpgrp2>, C<d_getpgrp>, C<d_getppid>, C<d_getprior>, +C<d_getprotoprotos>, C<d_getprpwnam>, C<d_getpwent>, C<d_getsbyname>, +C<d_getsbyport>, C<d_getsent>, C<d_getservprotos>, C<d_getspnam>, +C<d_gettimeod>, C<d_gnulibc>, C<d_grpasswd>, C<d_hasmntopt>, C<d_htonl>, +C<d_iconv>, C<d_index>, C<d_inetaton>, C<d_int64_t>, C<d_isascii>, +C<d_isnan>, C<d_isnanl>, C<d_killpg>, C<d_lchown>, C<d_ldbl_dig>, C<d_link>, C<d_locconv>, C<d_lockf>, C<d_longdbl>, C<d_longlong>, C<d_lseekproto>, C<d_lstat>, C<d_madvise>, C<d_mblen>, C<d_mbstowcs>, C<d_mbtowc>, C<d_memchr>, C<d_memcmp>, C<d_memcpy>, C<d_memmove>, C<d_memset>, C<d_mkdir>, C<d_mkdtemp>, C<d_mkfifo>, C<d_mkstemp>, -C<d_mkstemps>, C<d_mktime>, C<d_mmap>, C<d_mprotect>, C<d_msg>, +C<d_mkstemps>, C<d_mktime>, C<d_mmap>, C<d_modfl>, C<d_mprotect>, C<d_msg>, C<d_msg_ctrunc>, C<d_msg_dontroute>, C<d_msg_oob>, C<d_msg_peek>, C<d_msg_proxy>, C<d_msgctl>, C<d_msgget>, C<d_msgrcv>, C<d_msgsnd>, C<d_msync>, C<d_munmap>, C<d_mymalloc>, C<d_nice>, C<d_nv_preserves_uv>, -C<d_off64_t>, C<d_old_pthread_create_joinable>, C<d_oldpthreads>, -C<d_oldsock>, C<d_open3>, C<d_pathconf>, C<d_pause>, C<d_phostname>, -C<d_pipe>, C<d_poll>, C<d_portable>, C<d_PRId64>, C<d_PRIeldbl>, -C<d_PRIEldbl>, C<d_PRIfldbl>, C<d_PRIFldbl>, C<d_PRIgldbl>, C<d_PRIGldbl>, -C<d_PRIi64>, C<d_PRIo64>, C<d_PRIu64>, C<d_PRIx64>, C<d_PRIX64>, -C<d_pthread_yield>, C<d_pwage>, C<d_pwchange>, C<d_pwclass>, -C<d_pwcomment>, C<d_pwexpire>, C<d_pwgecos>, C<d_pwpasswd>, C<d_pwquota>, -C<d_qgcvt>, C<d_quad>, C<d_readdir>, C<d_readlink>, C<d_rename>, -C<d_rewinddir>, C<d_rmdir>, C<d_safebcpy>, C<d_safemcpy>, C<d_sanemcmp>, -C<d_sched_yield>, C<d_scm_rights>, C<d_seekdir>, C<d_select>, C<d_sem>, -C<d_semctl>, C<d_semctl_semid_ds>, C<d_semctl_semun>, C<d_semget>, -C<d_semop>, C<d_setegid>, C<d_seteuid>, C<d_setgrent>, C<d_setgrps>, -C<d_sethent>, C<d_setlinebuf>, C<d_setlocale>, C<d_setnent>, C<d_setpent>, -C<d_setpgid>, C<d_setpgrp2>, C<d_setpgrp>, C<d_setprior>, C<d_setpwent>, -C<d_setregid>, C<d_setresgid>, C<d_setresuid>, C<d_setreuid>, C<d_setrgid>, -C<d_setruid>, C<d_setsent>, C<d_setsid>, C<d_setspent>, C<d_setvbuf>, -C<d_sfio>, C<d_shm>, C<d_shmat>, C<d_shmatprototype>, C<d_shmctl>, -C<d_shmdt>, C<d_shmget>, C<d_sigaction>, C<d_sigsetjmp>, C<d_socket>, -C<d_socklen_t>, C<d_sockpair>, C<d_sqrtl>, C<d_statblks>, -C<d_statfs_f_flags>, C<d_statfs_s>, C<d_statvfs>, C<d_stdio_cnt_lval>, -C<d_stdio_ptr_lval>, C<d_stdio_stream_array>, C<d_stdiobase>, -C<d_stdstdio>, C<d_strchr>, C<d_strcoll>, C<d_strctcpy>, C<d_strerrm>, -C<d_strerror>, C<d_strtod>, C<d_strtol>, C<d_strtold>, C<d_strtoll>, -C<d_strtoul>, C<d_strtoull>, C<d_strtouq>, C<d_strxfrm>, C<d_suidsafe>, -C<d_symlink>, C<d_syscall>, C<d_sysconf>, C<d_sysernlst>, C<d_syserrlst>, -C<d_system>, C<d_tcgetpgrp>, C<d_tcsetpgrp>, C<d_telldir>, +C<d_nv_preserves_uv_bits>, C<d_off64_t>, C<d_old_pthread_create_joinable>, +C<d_oldpthreads>, C<d_oldsock>, C<d_open3>, C<d_pathconf>, C<d_pause>, +C<d_perl_otherlibdirs>, C<d_phostname>, C<d_pipe>, C<d_poll>, +C<d_portable>, C<d_PRId64>, C<d_PRIeldbl>, C<d_PRIEldbl>, C<d_PRIfldbl>, +C<d_PRIFldbl>, C<d_PRIgldbl>, C<d_PRIGldbl>, C<d_PRIi64>, C<d_PRIo64>, +C<d_PRIu64>, C<d_PRIx64>, C<d_PRIX64>, C<d_pthread_yield>, C<d_pwage>, +C<d_pwchange>, C<d_pwclass>, C<d_pwcomment>, C<d_pwexpire>, C<d_pwgecos>, +C<d_pwpasswd>, C<d_pwquota>, C<d_qgcvt>, C<d_quad>, C<d_readdir>, +C<d_readlink>, C<d_rename>, C<d_rewinddir>, C<d_rmdir>, C<d_safebcpy>, +C<d_safemcpy>, C<d_sanemcmp>, C<d_sched_yield>, C<d_scm_rights>, +C<d_seekdir>, C<d_select>, C<d_sem>, C<d_semctl>, C<d_semctl_semid_ds>, +C<d_semctl_semun>, C<d_semget>, C<d_semop>, C<d_setegid>, C<d_seteuid>, +C<d_setgrent>, C<d_setgrps>, C<d_sethent>, C<d_setlinebuf>, C<d_setlocale>, +C<d_setnent>, C<d_setpent>, C<d_setpgid>, C<d_setpgrp2>, C<d_setpgrp>, +C<d_setprior>, C<d_setpwent>, C<d_setregid>, C<d_setresgid>, +C<d_setresuid>, C<d_setreuid>, C<d_setrgid>, C<d_setruid>, C<d_setsent>, +C<d_setsid>, C<d_setvbuf>, C<d_sfio>, C<d_shm>, C<d_shmat>, +C<d_shmatprototype>, C<d_shmctl>, C<d_shmdt>, C<d_shmget>, C<d_sigaction>, +C<d_sigsetjmp>, C<d_socket>, C<d_socklen_t>, C<d_sockpair>, C<d_sqrtl>, +C<d_statblks>, C<d_statfs_f_flags>, C<d_statfs_s>, C<d_statvfs>, +C<d_stdio_cnt_lval>, C<d_stdio_ptr_lval>, C<d_stdio_stream_array>, +C<d_stdiobase>, C<d_stdstdio>, C<d_strchr>, C<d_strcoll>, C<d_strctcpy>, +C<d_strerrm>, C<d_strerror>, C<d_strtod>, C<d_strtol>, C<d_strtold>, +C<d_strtoll>, C<d_strtoul>, C<d_strtoull>, C<d_strtouq>, C<d_strxfrm>, +C<d_suidsafe>, C<d_symlink>, C<d_syscall>, C<d_sysconf>, C<d_sysernlst>, +C<d_syserrlst>, C<d_system>, C<d_tcgetpgrp>, C<d_tcsetpgrp>, C<d_telldir>, C<d_telldirproto>, C<d_time>, C<d_times>, C<d_truncate>, C<d_tzname>, C<d_umask>, C<d_uname>, C<d_union_semun>, C<d_ustat>, C<d_vendorarch>, C<d_vendorbin>, C<d_vendorlib>, C<d_vfork>, C<d_void_closedir>, @@ -5684,12 +7750,12 @@ C<i_dirent>, C<i_dld>, C<i_dlfcn>, C<i_fcntl>, C<i_float>, C<i_gdbm>, C<i_grp>, C<i_iconv>, C<i_ieeefp>, C<i_inttypes>, C<i_limits>, C<i_locale>, C<i_machcthr>, C<i_malloc>, C<i_math>, C<i_memory>, C<i_mntent>, C<i_ndbm>, C<i_netdb>, C<i_neterrno>, C<i_netinettcp>, C<i_niin>, C<i_poll>, -C<i_pthread>, C<i_pwd>, C<i_rpcsvcdbm>, C<i_sfio>, C<i_sgtty>, C<i_shadow>, -C<i_socks>, C<i_stdarg>, C<i_stddef>, C<i_stdlib>, C<i_string>, -C<i_sunmath>, C<i_sysaccess>, C<i_sysdir>, C<i_sysfile>, C<i_sysfilio>, -C<i_sysin>, C<i_sysioctl>, C<i_syslog>, C<i_sysmman>, C<i_sysmode>, -C<i_sysmount>, C<i_sysndir>, C<i_sysparam>, C<i_sysresrc>, C<i_syssecrt>, -C<i_sysselct>, C<i_syssockio>, C<i_sysstat>, C<i_sysstatfs>, +C<i_prot>, C<i_pthread>, C<i_pwd>, C<i_rpcsvcdbm>, C<i_sfio>, C<i_sgtty>, +C<i_shadow>, C<i_socks>, C<i_stdarg>, C<i_stddef>, C<i_stdlib>, +C<i_string>, C<i_sunmath>, C<i_sysaccess>, C<i_sysdir>, C<i_sysfile>, +C<i_sysfilio>, C<i_sysin>, C<i_sysioctl>, C<i_syslog>, C<i_sysmman>, +C<i_sysmode>, C<i_sysmount>, C<i_sysndir>, C<i_sysparam>, C<i_sysresrc>, +C<i_syssecrt>, C<i_sysselct>, C<i_syssockio>, C<i_sysstat>, C<i_sysstatfs>, C<i_sysstatvfs>, C<i_systime>, C<i_systimek>, C<i_systimes>, C<i_systypes>, C<i_sysuio>, C<i_sysun>, C<i_sysutsname>, C<i_sysvfs>, C<i_syswait>, C<i_termio>, C<i_termios>, C<i_time>, C<i_unistd>, C<i_ustat>, C<i_utime>, @@ -5736,7 +7802,7 @@ C<nvsize>, C<nvtype> =item o C<o_nonblock>, C<obj_ext>, C<old_pthread_create_joinable>, C<optimize>, -C<orderlib>, C<osname>, C<osvers> +C<orderlib>, C<osname>, C<osvers>, C<otherlibdirs> =item p @@ -6198,7 +8264,7 @@ variables =item DESCRIPTION -=item BUGS +=item PERFORMANCE =back @@ -7345,14 +9411,92 @@ splitdir catpath -abs2rel +=over -rel2abs +=item SEE ALSO + +=back + +=head2 File::Temp - return name and handle of a temporary file safely + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=back + +=over + +=item FUNCTIONS + +B<tempfile> + +=back + +B<tempdir> + +=over + +=item MKTEMP FUNCTIONS + +B<mkstemp> + +=back + +B<mkstemps> + +B<mkdtemp> + +B<mktemp> + +=over + +=item POSIX FUNCTIONS + +B<tmpnam> + +=back + +B<tmpfile> =over +=item ADDITIONAL FUNCTIONS + +B<tempnam> + +=back + +=over + +=item UTILITY FUNCTIONS + +B<unlink0> + +=back + +=over + +=item PACKAGE VARIABLES + +B<safe_level>, STANDARD, MEDIUM, HIGH + +=back + +TopSystemUID + +=over + +=item WARNING + +=item HISTORY + =item SEE ALSO +=item AUTHOR + =back =head2 File::stat - by-name interface to Perl's built-in stat() functions @@ -8188,6 +10332,39 @@ Canonical notation, Input, Output =back +=head2 Math::Complex - complex numbers and associated mathematical +functions + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPERATIONS + +=item CREATION + +=item STRINGIFICATION + +=over + +=item CHANGED IN PERL 5.6 + +=back + +=item USAGE + +=item ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO + +=item ERRORS DUE TO INDIGESTIBLE ARGUMENTS + +=item BUGS + +=item AUTHORS + +=back + =head2 Math::Trig - trigonometric functions =over @@ -8484,12 +10661,12 @@ rewinddir, rmdir, scanf, setgid, setjmp, setlocale, setpgid, setsid, setuid, sigaction, siglongjmp, sigpending, sigprocmask, sigsetjmp, sigsuspend, sin, sinh, sleep, sprintf, sqrt, srand, sscanf, stat, strcat, strchr, strcmp, strcoll, strcpy, strcspn, strerror, strftime, strlen, -strncat, strncmp, strncpy, stroul, strpbrk, strrchr, strspn, strstr, -strtod, strtok, strtol, strtoul, strxfrm, sysconf, system, tan, tanh, -tcdrain, tcflow, tcflush, tcgetpgrp, tcsendbreak, tcsetpgrp, time, times, -tmpfile, tmpnam, tolower, toupper, ttyname, tzname, tzset, umask, uname, -ungetc, unlink, utime, vfprintf, vprintf, vsprintf, wait, waitpid, -wcstombs, wctomb, write +strncat, strncmp, strncpy, strpbrk, strrchr, strspn, strstr, strtod, +strtok, strtol, strtoul, strxfrm, sysconf, system, tan, tanh, tcdrain, +tcflow, tcflush, tcgetpgrp, tcsendbreak, tcsetpgrp, time, times, tmpfile, +tmpnam, tolower, toupper, ttyname, tzname, tzset, umask, uname, ungetc, +unlink, utime, vfprintf, vprintf, vsprintf, wait, waitpid, wcstombs, +wctomb, write =item CLASSES @@ -8577,8 +10754,6 @@ Constants Constants, Macros -=item CREATION - =back =head2 Pod::Checker, podchecker() - check pod documents for syntax errors @@ -8928,6 +11103,124 @@ B<Pod::ParseTree> =back +=head2 Pod::LaTeX - Convert Pod data to formatted Latex + +=over + +=item SYNOPSIS + +=item DESCRIPTION + +=back + +=over + +=item OBJECT METHODS + +C<initialize> + +=back + +=over + +=item Data Accessors + +B<AddPreamble> + +=back + +B<AddPostamble> + +B<Head1Level> + +B<Label> + +B<LevelNoNum> + +B<MakeIndex> + +B<ReplaceNAMEwithSection> + +B<StartWithNewPage> + +B<TableOfContents> + +B<UniqueLabels> + +B<UserPreamble> + +B<UserPostamble> + +B<Lists> + +=over + +=item Subclassed methods + +=back + +B<begin_pod> + +B<end_pod> + +B<command> + +B<verbatim> + +B<textblock> + +B<interior_sequence> + +=over + +=item List Methods + +B<begin_list> + +=back + +B<end_list> + +B<add_item> + +=over + +=item Methods for headings + +B<head> + +=back + +=over + +=item Internal methods + +B<_output> + +=back + +B<_replace_special_chars> + +B<_create_label> + +B<_create_index> + +B<_clean_latex_commands> + +=over + +=item NOTES + +=item SEE ALSO + +=item AUTHORS + +=item COPYRIGHT + +=item REVISION + +=back + =head2 Pod::Man - Convert POD data to formatted *roff input =over @@ -9516,6 +11809,18 @@ C<-pathlist> =item DESCRIPTION +C<O_RDONLY>, C<O_WRONLY>, C<O_RDWR> + +=item DIAGNOSTICS + +=over + +=item C<sdbm store returned -1, errno 22, key "..." at ...> + +=back + +=item BUGS AND WARNINGS + =back =head2 Safe - Compile and execute code in restricted compartments @@ -9844,10 +12149,10 @@ arrays =item EXAMPLES -0a simple word, 1multiple spaces are skipped because of our $delim, 2use of -quotes to include a space in a word, 3use of a backslash to include a space -in a word, 4use of a backslash to remove the special meaning of a -double-quote, 5another simple word (note the lack of effect of the +0 a simple word, 1 multiple spaces are skipped because of our $delim, 2 use +of quotes to include a space in a word, 3 use of a backslash to include a +space in a word, 4 use of a backslash to remove the special meaning of a +double-quote, 5 another simple word (note the lack of effect of the backslashed double-quote) =item AUTHORS @@ -10185,6 +12490,38 @@ March 18th, 2000 =back +=head2 Win32 - Interfaces to some Win32 API Functions + +=over + +=item DESCRIPTION + +=over + +=item Alphabetical Listing of Win32 Functions + +Win32::AbortSystemShutdown(MACHINE), Win32::BuildNumber(), +Win32::CopyFile(FROM, TO, OVERWRITE), Win32::DomainName(), +Win32::ExpandEnvironmentStrings(STRING), Win32::FormatMessage(ERRORCODE), +Win32::FsType(), Win32::FreeLibrary(HANDLE), Win32::GetArchName(), +Win32::GetChipName(), Win32::GetCwd(), Win32::GetFullPathName(FILENAME), +Win32::GetLastError(), Win32::GetLongPathName(PATHNAME), +Win32::GetNextAvailDrive(), Win32::GetOSVersion(), +Win32::GetShortPathName(PATHNAME), Win32::GetProcAddress(INSTANCE, +PROCNAME), Win32::GetTickCount(), Win32::InitiateSystemShutdown(MACHINE, +MESSAGE, TIMEOUT, FORCECLOSE, REBOOT), Win32::IsWinNT(), Win32::IsWin95(), +Win32::LoadLibrary(LIBNAME), Win32::LoginName(), +Win32::LookupAccountName(SYSTEM, ACCOUNT, DOMAIN, SID, SIDTYPE), +Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE), +Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]]), Win32::NodeName(), +Win32::RegisterServer(LIBRARYNAME), Win32::SetCwd(NEWDIRECTORY), +Win32::SetLastError(ERROR), Win32::Sleep(TIME), Win32::Spawn(COMMAND, ARGS, +PID), Win32::UnregisterServer(LIBRARYNAME) + +=back + +=back + =head2 XSLoader - Dynamically load C libraries into Perl code =over diff --git a/pod/perltrap.pod b/pod/perltrap.pod index c477272abe..c59ecc4daf 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -586,6 +586,12 @@ Some error messages will be different. =item * Discontinuance +In Perl 4, if in list context the delimiters to the first argument of +C<split()> were C<??>, the result would be placed in C<@_> as well as +being returned. Perl 5 has more respect for your subroutine arguments. + +=item * Discontinuance + Some bugs may have been inadvertently removed. :-) =back @@ -1296,7 +1302,8 @@ within certain expressions, statements, contexts, or whatever. print "To: someone@somewhere.com\n"; # perl4 prints: To:someone@somewhere.com - # perl5 errors : In string, @somewhere now must be written as \@somewhere + # perl < 5.6.1, error : In string, @somewhere now must be written as \@somewhere + # perl >= 5.6.1, warning : Possible unintended interpolation of @somewhere in string =item * Interpolation diff --git a/pod/perlutil.pod b/pod/perlutil.pod new file mode 100644 index 0000000000..1b2c178b1f --- /dev/null +++ b/pod/perlutil.pod @@ -0,0 +1,185 @@ +=head1 NAME + +perlutil - utilities packaged with the Perl distribution + +=head1 DESCRIPTION + +Along with the Perl interpreter itself, the Perl distribution installs a +range of utilities on your system. There are also several utilities +which are used by the Perl distribution itself as part of the install +process. This document exists to list all of these utilities, explain +what they are for and provide pointers to each module's documentation, +if appropriate. + +=head2 DOCUMENTATION + +=over 3 + +=item L<perldoc|perldoc> + +The main interface to Perl's documentation is C<perldoc>, although +if you're reading this, it's more than likely that you've already found +it. F<perldoc> will extract and format the documentation from any file +in the current directory, any Perl module installed on the system, or +any of the standard documentation pages, such as this one. Use +C<perldoc E<lt>nameE<gt>> to get information on any of the utilities +described in this document. + +=item L<pod2man|pod2man> and L<pod2text|pod2text> + +If it's run from a terminal, F<perldoc> will usually call F<pod2man> to +translate POD (Plain Old Documentation - see L<perlpod> for an +explanation) into a man page, and then run F<man> to display it; if +F<man> isn't available, F<pod2text> will be used instead and the output +piped through your favourite pager. + +=item L<pod2html|pod2html> and L<pod2latex|pod2latex> + +As well as these two, there are two other convertors: F<pod2html> will +produce HTML pages from POD, and F<pod2latex>, which produces LaTeX +files. + +=item L<pod2usage|pod2usage> + +If you just want to know how to use the utilities described here, +F<pod2usage> will just extract the "USAGE" section; some of +the utilities will automatically call F<pod2usage> on themselves when +you call them with C<-help>. + +=item L<podselect|podselect> + +F<pod2usage> is a special case of F<podselect>, a utility to extract +named sections from documents written in POD. For instance, while +utilities have "USAGE" sections, Perl modules usually have "SYNOPSIS" +sections: C<podselect -s "SYNOPSIS" ...> will extract this section for +a given file. + +=item L<podchecker|podchecker> + +If you're writing your own documentation in POD, the F<podchecker> +utility will look for errors in your markup. + +=item L<splain|splain> + +F<splain> is an interface to L<perldiag> - paste in your error message +to it, and it'll explain it for you. + +=item L<roffitall|roffitall> + +The C<roffitall> utility is not installed on your system but lives in +the F<pod/> directory of your Perl source kit; it converts all the +documentation from the distribution to F<*roff> format, and produces a +typeset PostScript or text file of the whole lot. + +=back + +=head2 CONVERTORS + +To help you convert legacy programs to Perl, we've included three +conversion filters: + +=over 3 + +=item L<a2p|a2p> + +F<a2p> converts F<awk> scripts to Perl programs; for example, C<a2p -F:> +on the simple F<awk> script C<{print $2}> will produce a Perl program +based around this code: + + while (<>) { + ($Fld1,$Fld2) = split(/[:\n]/, $_, 9999); + print $Fld2; + } + +=item L<s2p|s2p> + +Similarly, F<s2p> converts F<sed> scripts to Perl programs. F<s2p> run +on C<s/foo/bar> will produce a Perl program based around this: + + while (<>) { + chop; + s/foo/bar/g; + print if $printit; + } + +=item L<find2perl|find2perl> + +Finally, F<find2perl> translates C<find> commands to Perl equivalents which +use the L<File::Find|File::Find> module. As an example, +C<find2perl . -user root -perm 4000 -print> produces the following callback +subroutine for C<File::Find>: + + sub wanted { + my ($dev,$ino,$mode,$nlink,$uid,$gid); + (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && + $uid == $uid{'root'}) && + (($mode & 0777) == 04000); + print("$name\n"); + } + +=back + +As well as these filters for converting other languages, the +L<pl2pm|pl2pm> utility will help you convert old-style Perl 4 libraries to +new-style Perl5 modules. + +=head2 Development + +There are a set of utilities which help you in developing Perl programs, +and in particular, extending Perl with C. + +=over 3 + +=item L<perlbug|perlbug> + +F<perlbug> is the recommended way to report bugs in the perl interpreter +itself or any of the standard library modules back to the developers; +please read through the documentation for F<perlbug> thoroughly before +using it to submit a bug report. + +=item L<h2ph|h2ph> + +Back before Perl had the XS system for connecting with C libraries, +programmers used to get library constants by reading through the C +header files. You may still see C<require 'syscall.ph'> or similar +around - the F<.ph> file should be created by running F<h2ph> on the +corresponding F<.h> file. See the F<h2ph> documentation for more on how +to convert a whole bunch of header files at ones. + +=item L<c2ph|c2ph> and L<pstruct|pstruct> + +F<c2ph> and F<pstruct>, which are actually the same program but behave +differently depending on how they are called, provide another way of +getting at C with Perl - they'll convert C structures and union declarations +to Perl code. This is deprecated in favour of F<h2xs> these days. + +=item L<h2xs|h2xs> + +F<h2xs> converts C header files into XS modules, and will try and write +as much glue between C libraries and Perl modules as it can. It's also +very useful for creating skeletons of pure Perl modules. + +=item L<dprofpp|dprofpp> + +Perl comes with a profiler, the F<Devel::Dprof> module. The +F<dprofpp> utility analyzes the output of this profiler and tells you +which subroutines are taking up the most run time. See L<Devel::Dprof> +for more information. + +=item L<perlcc|perlcc> + +F<perlcc> is the interface to the experimental Perl compiler suite. + +=back + +=head2 SEE ALSO + +L<perldoc|perldoc>, L<pod2man|pod2man>, L<perlpod>, +L<pod2html|pod2html>, L<pod2usage|pod2usage>, L<podselect|podselect>, +L<podchecker|podchecker>, L<splain|splain>, L<perldiag>, +L<roffitall|roffitall>, L<a2p|a2p>, L<s2p|s2p>, L<find2perl|find2perl>, +L<File::Find|File::Find>, L<pl2pm|pl2pm>, L<perlbug|perlbug>, +L<h2ph|h2ph>, L<c2ph|c2ph>, L<h2xs|h2xs>, L<dprofpp|dprofpp>, +L<Devel::Dprof>, L<perlcc|perlcc> + +=cut diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 15308e45aa..e75cf35f73 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -691,6 +691,11 @@ program sees. This is more useful as a way of indicating the current program state than it is for hiding the program you're running. (Mnemonic: same as B<sh> and B<ksh>.) +Note for BSD users: setting C<$0> does not completely remove "perl" +from the ps(1) output. For example, setting C<$0> to C<"foobar"> will +result in C<"perl: foobar (perl)">. This is an operating system +feature. + =item $[ The index of the first element in an array, and of the first character diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 4756a9edbb..347b46e4f5 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -5,8 +5,8 @@ perlXStut - Tutorial for writing XSUBs =head1 DESCRIPTION This tutorial will educate the reader on the steps involved in creating -a Perl extension. The reader is assumed to have access to L<perlguts> and -L<perlxs>. +a Perl extension. The reader is assumed to have access to L<perlguts>, +L<perlapi> and L<perlxs>. This tutorial starts with very simple examples and becomes more complex, with each new example adding new features. Certain concepts may not be @@ -187,7 +187,8 @@ been deleted): Manifying ./blib/man3/Mytest.3 % -You can safely ignore the line about "prototyping behavior". +You can safely ignore the line about "prototyping behavior" - it is +explained in the section "The PROTOTYPES: Keyword" in L<perlxs>. If you are on a Win32 system, and the build process fails with linker errors for functions in the C library, check if your Perl is configured @@ -1056,9 +1057,143 @@ the stack is I<always> large enough to take one return value. =back -=head2 EXAMPLE 6 (Coming Soon) +=head2 EXAMPLE 6 -Passing in and returning references to arrays and/or hashes +In this example, we will accept a reference to an array as an input +parameter, and return a reference to an array of hashes. This will +demonstrate manipulation of complex Perl data types from an XSUB. + +This extension is somewhat contrived. It is based on the code in +the previous example. It calls the statfs function multiple times, +accepting a reference to an array of filenames as input, and returning +a reference to an array of hashes containing the data for each of the +filesystems. + +Return to the Mytest directory and add the following code to the end of +Mytest.xs: + + SV * + multi_statfs(paths) + SV * paths + INIT: + AV * results; + I32 numpaths = 0; + int i, n; + struct statfs buf; + + if ((!SvROK(paths)) + || (SvTYPE(SvRV(paths)) != SVt_PVAV) + || ((numpaths = av_len((AV *)SvRV(paths))) < 0)) + { + XSRETURN_UNDEF; + } + results = (AV *)sv_2mortal((SV *)newAV()); + CODE: + for (n = 0; n <= numpaths; n++) { + HV * rh; + STRLEN l; + char * fn = SvPV(*av_fetch((AV *)SvRV(paths), n, 0), l); + + i = statfs(fn, &buf); + if (i != 0) { + av_push(results, newSVnv(errno)); + continue; + } + + rh = (HV *)sv_2mortal((SV *)newHV()); + + hv_store(rh, "f_bavail", 8, newSVnv(buf.f_bavail), 0); + hv_store(rh, "f_bfree", 7, newSVnv(buf.f_bfree), 0); + hv_store(rh, "f_blocks", 8, newSVnv(buf.f_blocks), 0); + hv_store(rh, "f_bsize", 7, newSVnv(buf.f_bsize), 0); + hv_store(rh, "f_ffree", 7, newSVnv(buf.f_ffree), 0); + hv_store(rh, "f_files", 7, newSVnv(buf.f_files), 0); + hv_store(rh, "f_type", 6, newSVnv(buf.f_type), 0); + + av_push(results, newRV((SV *)rh)); + } + RETVAL = newRV((SV *)results); + OUTPUT: + RETVAL + +And add the following code to test.pl, while incrementing the "1..11" +string in the BEGIN block to "1..13": + + $results = Mytest::multi_statfs([ '/', '/blech' ]); + print ((ref $results->[0]) ? "ok 12\n" : "not ok 12\n"); + print ((! ref $results->[1]) ? "ok 13\n" : "not ok 13\n"); + +=head2 New Things in this Example + +There are a number of new concepts introduced here, described below: + +=over 4 + +=item * + +This function does not use a typemap. Instead, we declare it as accepting +one SV* (scalar) parameter, and returning an SV* value, and we take care of +populating these scalars within the code. Because we are only returning +one value, we don't need a C<PPCODE:> directive - instead, we use C<CODE:> +and C<OUTPUT:> directives. + +=item * + +When dealing with references, it is important to handle them with caution. +The C<INIT:> block first checks that +C<SvROK> returns true, which indicates that paths is a valid reference. It +then verifies that the object referenced by paths is an array, using C<SvRV> +to dereference paths, and C<SvTYPE> to discover its type. As an added test, +it checks that the array referenced by paths is non-empty, using the C<av_len> +function (which returns -1 if the array is empty). The XSRETURN_UNDEF macro +is used to abort the XSUB and return the undefined value whenever all three of +these conditions are not met. + +=item * + +We manipulate several arrays in this XSUB. Note that an array is represented +internally by an AV* pointer. The functions and macros for manipulating +arrays are similar to the functions in Perl: C<av_len> returns the highest +index in an AV*, much like $#array; C<av_fetch> fetches a single scalar value +from an array, given its index; C<av_push> pushes a scalar value onto the +end of the array, automatically extending the array as necessary. + +Specifically, we read pathnames one at a time from the input array, and +store the results in an output array (results) in the same order. If +statfs fails, the element pushed onto the return array is the value of +errno after the failure. If statfs succeeds, though, the value pushed +onto the return array is a reference to a hash containing some of the +information in the statfs structure. + +As with the return stack, it would be possible (and a small performance win) +to pre-extend the return array before pushing data into it, since we know +how many elements we will return: + + av_extend(results, numpaths); + +=item * + +We are performing only one hash operation in this function, which is storing +a new scalar under a key using C<hv_store>. A hash is represented by an HV* +pointer. Like arrays, the functions for manipulating hashes from an XSUB +mirror the functionality available from Perl. See L<perlguts> and L<perlapi> +for details. + +=item * + +To create a reference, we use the C<newRV> function. Note that you can +cast an AV* or an HV* to type SV* in this case (and many others). This +allows you to take references to arrays, hashes and scalars with the same +function. Conversely, the C<SvRV> function always returns an SV*, which may +need to be be cast to the appropriate type if it is something other than a +scalar (check with C<SvTYPE>). + +=item * + +At this point, xsubpp is doing very little work - the differences between +Mytest.xs and Mytest.c are minimal. + +=back =head2 EXAMPLE 7 (Coming Soon) @@ -1112,7 +1247,7 @@ Some systems may have installed Perl version 5 as "perl5". =head1 See also -For more information, consult L<perlguts>, L<perlxs>, L<perlmod>, +For more information, consult L<perlguts>, L<perlapi>, L<perlxs>, L<perlmod>, and L<perlpod>. =head1 Author diff --git a/pod/pod2latex.PL b/pod/pod2latex.PL index 71115f3f21..3d3cfb65bc 100644 --- a/pod/pod2latex.PL +++ b/pod/pod2latex.PL @@ -34,676 +34,314 @@ $Config{startperl} # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; -# -# pod2latex, version 1.1 -# by Taro Kawagish (kawagish@imslab.co.jp), Jan 11, 1995. -# -# pod2latex filters Perl pod documents to LaTeX documents. -# -# What pod2latex does: -# 1. Pod file 'perl_doc_entry.pod' is filtered to 'perl_doc_entry.tex'. -# 2. Indented paragraphs are translated into -# '\begin{verbatim} ... \end{verbatim}'. -# 3. '=head1 heading' command is translated into '\section{heading}' -# 4. '=head2 heading' command is translated into '\subsection*{heading}' -# 5. '=over N' command is translated into -# '\begin{itemize}' if following =item starts with *, -# '\begin{enumerate}' if following =item starts with 1., -# '\begin{description}' if else. -# (indentation level N is ignored.) -# 6. '=item * heading' command is translated into '\item heading', -# '=item 1. heading' command is translated into '\item heading', -# '=item heading' command(other) is translated into '\item[heading]'. -# 7. '=back' command is translated into -# '\end{itemize}' if started with '\begin{itemize}', -# '\end{enumerate}' if started with '\begin{enumerate}', -# '\end{description}' if started with '\begin{description}'. -# 8. other paragraphs are translated into strings with TeX special characters -# escaped. -# 9. In heading text, and other paragraphs, the following translation of pod -# quotes are done, and then TeX special characters are escaped after that. -# I<text> to {\em text\/}, -# B<text> to {\bf text}, -# S<text> to text1, -# where text1 is a string with blank characters replaced with ~, -# C<text> to {\tt text2}, -# where text2 is a string with TeX special characters escaped to -# obtain a literal printout, -# E<text> (HTML escape) to TeX escaped string, -# L<text> to referencing string as is done by pod2man, -# F<file> to {\em file\/}, -# Z<> to a null string, -# 10. those headings are indexed: -# '=head1 heading' => \section{heading}\index{heading} -# '=head2 heading' => \subsection*{heading}\index{heading} -# only when heading does not match frequent patterns such as -# DESCRIPTION, DIAGNOSTICS,... -# '=item heading' => \item{heading}\index{heading} -# -# Usage: -# pod2latex perl_doc_entry.pod -# this will write to a file 'perl_doc_entry.tex'. -# -# To LaTeX: -# The following commands need to be defined in the preamble of the LaTeX -# document: -# \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}} -# \def\underscore{\leavevmode\kern.04em\vbox{\hrule width 0.4em height 0.3pt}} -# and \parindent should be set zero: -# \setlength{\parindent}{0pt} -# -# Note: -# This script was written modifing pod2man. -# -# Bug: -# If HTML escapes E<text> other than E<amp>,E<lt>,E<gt>,E<quot> are used -# in C<>, translation will produce wrong character strings. -# Translation of HTML escapes of various European accents might be wrong. - - -# TeX special characters. -##$tt_ables = "!@*()-=+|;:'\"`,./?<>"; -$backslash_escapables = "#\$%&{}_"; -$backslash_escapables2 = "#\$%&{}"; # except _ -##$nonverbables = "^\\~"; -##$bracketesc = "[]"; -##@tex_verb_fences = unpack("aaaaaaaaa","|#@!*+?:;"); - -@head1_freq_patterns # =head1 patterns which need not be index'ed - = ("AUTHOR","Author","BUGS","DATE","DESCRIPTION","DIAGNOSTICS", - "ENVIRONMENT","EXAMPLES","FILES","INTRODUCTION","NAME","NOTE", - "SEE ALSO","SYNOPSIS","WARNING"); - -$indent = 0; - -# parse the pods, produce LaTeX. - -use Pod::Plainer; -open(POD,"-|") or Pod::Plainer -> new() -> parse_from_file($ARGV[0]), exit; - -($pod=$ARGV[0]) =~ s/\.pod$//; -open(LATEX,">$pod.tex"); -&do_hdr(); - -$cutting = 1; -$begun = ""; -$/ = ""; # record separator is blank lines -while (<POD>) { - if ($cutting) { - next unless /^=/; - $cutting = 0; - } - if ($begun) { - if (/^=end\s+$begun/) { - $begun = ""; - } - elsif ($begun =~ /^(tex|latex)$/) { - print LATEX $_; - } - next; - } - chop; - length || (print LATEX "\n") && next; - - # translate indented lines as a verabatim paragraph - if (/^\s/) { - @lines = split(/\n/); - print LATEX "\\begin{verbatim}\n"; - for (@lines) { - 1 while s - {^( [^\t]* ) \t ( \t* ) } - { $1 . ' ' x (8 - (length($1)%8) + 8*(length($2))) }ex; - print LATEX $_,"\n"; - } - print LATEX "\\end{verbatim}\n"; - next; - } - if (/^=for\s+(\S+)\s*/s) { - if ($1 eq "tex" or $1 eq "latex") { - print LATEX $',"\n"; - } else { - # ignore unknown for - } - next; - } - elsif (/^=begin\s+(\S+)\s*/s) { - $begun = $1; - if ($1 eq "tex" or $1 eq "latex") { - print LATEX $'."\n"; - } - next; - } +# pod2latex conversion program + +use Pod::LaTeX; +use Pod::Find qw/ pod_find /; +use Pod::Usage; +use Getopt::Long; +use File::Basename; + +# Read command line arguments + +my %options = ( + "help" => 0, + "man" => 0, + "sections" => [], + "full" => 0, + "out" => undef, + "verbose" => 0, + "modify" => 0, + ); + +GetOptions(\%options, + "help", + "man", + "verbose", + "full", + "sections=s@", + "out=s", + "modify", + ) || pod2usage(2); + +pod2usage(1) if ($options{help}); +pod2usage(-verbose => 2) if ($options{man}); + + +# Read all the files from the command line +my @files = @ARGV; + +# Now find which ones are real pods and convert +# directories to their contents. + +# Extract the pods from each arg since some of them might +# be directories +# This is not as efficient as using pod_find to search through +# everything at once but it allows us to preserve the order +# supplied by the user + +my @pods; +foreach my $arg (@files) { + my %pods = pod_find($arg); + push(@pods, sort keys %pods); +} - # preserve '=item' line with pod quotes as they are. - if (/^=item/) { - ($bareitem = $_) =~ s/^=item\s*//; - } +# Abort if nothing to do +if ($#pods == -1) { + warn "None of the supplied Pod files actually exist\n"; + exit; +} - # check for things that'll hosed our noremap scheme; affects $_ - &init_noremap(); - - # expand strings "func()" as pod quotes. - if (!/^=item/) { - # first hide pod escapes. - # escaped strings are mapped into the ones with the MSB's on. - s/([A-Z]<[^<>]*>)/noremap($1)/ge; - - # func() is a reference to a perl function - s{\b([:\w]+\(\))}{I<$1>}g; - # func(n) is a reference to a man page - s{(\w+)(\([^\s,\051]+\))}{I<$1>$2}g; - # convert simple variable references -# s/([\$\@%][\w:]+)/C<$1>/g; -# s/\$[\w:]+\[[0-9]+\]/C<$&>/g; - - if (m{ ([\-\w]+\([^\051]*?[\@\$,][^\051]*?\)) - }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) - { - warn "``$1'' should be a [LCI]<$1> ref"; - } - while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { - warn "``$1'' should be [CB]<$1> ref"; - } - - # put back pod quotes so we get the inside of <> processed; - $_ = &clear_noremap($_); - } - # process TeX special characters - - # First hide HTML quotes E<> since they can be included in C<>. - s/(E<[^<>]+>)/noremap($1)/ge; - - # Then hide C<> type literal quotes. - # String inside of C<> will later be expanded into {\tt ..} strings - # with TeX special characters escaped as needed. - s/(C<[^<>]*>)/&noremap($1)/ge; - - # Next escape TeX special characters including other pod quotes B< >,... - # - # NOTE: s/re/&func($str)/e evaluates $str just once in perl5. - # (in perl4 evaluation takes place twice before getting passed to func().) - - # - hyphen => --- - s/(\S+)(\s+)-+(\s+)(\S+)/"$1".&noremap(" --- ")."$4"/ge; - # '-', '--', "-" => '{\tt -}', '{\tt --}', "{\tt -}" -## s/("|')(\s*)(-+)(\s*)\1/&noremap("$1$2\{\\tt $3\}$4$1")/ge; -## changed Wed Jan 25 15:26:39 JST 1995 - # '-', '--', "-" => '$-$', '$--$', "$-$" - s/(\s+)(['"])(-+)([^'"\-]*)\2(\s+|[,.])/"$1$2".&noremap("\$$3\$")."$4$2$5"/ge; - s/(\s+)(['"])([^'"\-]*)(-+)(\s*)\2(\s+|[,.])/"$1$2$3".&noremap("\$$4\$")."$5$2$6"/ge; - # (--|-) => ($--$|$-$) - s/(\s+)\((-+)([=@%\$\+\\\|\w]*)(-*)([=@%\$\+\\\|\w]*)\)(\s+|[,.])/"$1\(".&noremap("\$$2\$")."$3".&noremap("\$$4\$")."$5\)$6"/ge; - # numeral - => $-$ - s/(\(|[0-9]+|\s+)-(\s*\(?\s*[0-9]+)/&noremap("$1\$-\$$2")/ge; - # -- in quotes => two separate - - s/B<([^<>]*)--([^<>]*)>/&noremap("B<$1\{\\tt --\}$2>")/ge; - - # backslash escapable characters except _. - s/([$backslash_escapables2])/&noremap("\\$1")/ge; - s/_/&noremap("\\underscore{}")/ge; # a litle thicker than \_. - # quote TeX special characters |, ^, ~, \. - s/\|/&noremap("\$|\$")/ge; - s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge; - s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge; - s/\\/&noremap("\$\\backslash{}\$")/ge; - # quote [ and ] to be used in \item[] - s/([\[\]])/&noremap("{\\tt $1}")/ge; - # characters need to be treated differently in TeX - # keep * if an item heading - s/^(=item[ \t]+)[*]((.|\n)*)/"$1" . &noremap("*") . "$2"/ge; - s/[*]/&noremap("\$\\ast\$")/ge; # other * - - # hide other pod quotes. - s/([ABD-Z]<[^<>]*>)/&noremap($1)/ge; - - # escape < and > as math strings, - # now that we are done with hiding pod <> quotes. - s/</&noremap("\$<\$")/ge; - s/>/&noremap("\$>\$")/ge; - - # put it back so we get the <> processed again; - $_ = &clear_noremap($_); - - - # Expand pod quotes recursively: - # (1) type face directives [BIFS]<[^<>]*> to appropriate TeX commands, - # (2) L<[^<>]*> to reference strings, - # (3) C<[^<>]*> to TeX literal quotes, - # (4) HTML quotes E<> inside of C<> quotes. - - # Hide E<> again since they can be included in C<>. - s/(E<[^<>]+>)/noremap($1)/ge; - - $maxnest = 10; - while ($maxnest-- && /[A-Z]</) { - - # bold and italic quotes - s/B<([^<>]*)>/"{\\bf $1}"/eg; - s#I<([^<>]*)>#"{\\em $1\\/}"#eg; - - # files and filelike refs in italics - s#F<([^<>]*)>#"{\\em $1\\/}"#eg; - - # no break quote -- usually we want C<> for this - s/S<([^<>]*)>/&nobreak($1)/eg; - - # LREF: a manpage(3f) - s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the {\\em $1\\/}$2 manpage:g; - - # LREF: an =item on another manpage - s{ - L<([^/]+)/([:\w]+(\(\))?)> - } {the C<$2> entry in the I<$1> manpage}gx; - - # LREF: an =item on this manpage - s{ - ((?:L</([:\w]+(\(\))?)> - (,?\s+(and\s+)?)?)+) - } { &internal_lrefs($1) }gex; - - # LREF: a =head2 (head1?), maybe on a manpage, maybe right here - # the "func" can disambiguate - s{ - L<(?:([a-zA-Z]\S+?) /)?"?(.*?)"?> - }{ - do { - $1 # if no $1, assume it means on this page. - ? "the section on I<$2> in the I<$1> manpage" - : "the section on I<$2>" - } - }gex; - - s/X<([^<>]*)>/\\index{$1}/g; - - s/Z<>/\\&/g; # the "don't format me" thing - - # comes last because not subject to reprocessing - s{ - C<([^<>]*)> - }{ - do { - ($str = $1) =~ tr/\200-\377/\000-\177/; #normalize hidden stuff - # expand HTML escapes if any; - # WARNING: if HTML escapes other than E<amp>,E<lt>,E<gt>, - # E<quot> are in C<>, they will not be printed correctly. - $str = &expand_HTML_escapes($str); - $strverb = &alltt($str); # Tex verbatim escape of a string. - &noremap("$strverb"); - } - }gex; - -# if ( /C<([^<>]*)/ ) { -# $str = $1; -# if ($str !~ /\|/) { # if includes | -# s/C<([^<>]*)>/&noremap("\\verb|$str|")/eg; -# } else { -# print STDERR "found \| in C<.*> at paragraph $.\n"; -# # find a character not contained in $str to use it as a -# # separator of the \verb -# ($chars = $str) =~ s/(\W)/\\$1/g; -# ## ($chars = $str) =~ s/([\$<>,\|"'\-^{}()*+?\\])/\\$1/g; -# @fence = grep(!/[ $chars]/,@tex_verb_fences); -# s/C<([^<>]*)>/&noremap("\\verb$fence[0]$str$fence[0]")/eg; -# } -# } - } +# If $options{'out'} is set we are processing to a single output file +my $multi_documents; +if (exists $options{'out'} && defined $options{'out'}) { + $multi_documents = 0; +} else { + $multi_documents = 1; +} + +# If the output file is not specified it is assumed that +# a single output file is required per input file using +# a .tex extension rather than any exisiting extension + +if ($multi_documents) { + + # Case where we just generate one input per output + + foreach my $pod (@pods) { + + if (-f $pod) { + + my $output = $pod; + $output = basename($output, '.pm', '.pod','.pl') . '.tex'; + # Create a new parser object + my $parser = new Pod::LaTeX( + AddPreamble => $options{'full'}, + AddPostamble => $options{'full'}, + MakeIndex => $options{'full'}, + TableOfContents => $options{'full'}, + ReplaceNAMEwithSection => $options{'modify'}, + UniqueLabels => $options{'modify'}, + ); - # process each pod command - if (s/^=//) { # if a command - s/\n/ /g; - ($cmd, $rest) = split(' ', $_, 2); - $rest =~ s/^\s*//; - $rest =~ s/\s*$//; - - if (defined $rest) { - &escapes; - } - - $rest = &clear_noremap($rest); - $rest = &expand_HTML_escapes($rest); - - if ($cmd eq 'cut') { - $cutting = 1; - $lastcmd = 'cut'; - } - elsif ($cmd eq 'head1') { # heading type 1 - $rest =~ s/^\s*//; $rest =~ s/\s*$//; - print LATEX "\n\\subsection*{$rest}"; - # put index entry - ($index = $rest) =~ s/^(An?\s+|The\s+)//i; # remove 'A' and 'The' - # index only those heads not matching the frequent patterns. - foreach $pat (@head1_freq_patterns) { - if ($index =~ /^$pat/) { - goto freqpatt; - } - } - print LATEX "%\n\\index{$index}\n" if ($index); - freqpatt: - $lastcmd = 'head1'; - } - elsif ($cmd eq 'head2') { # heading type 2 - $rest =~ s/^\s*//; $rest =~ s/\s*$//; - print LATEX "\n\\subsubsection*{$rest}"; - # put index entry - ($index = $rest) =~ s/^(An?\s+|The\s+)//i; # remove 'A' and 'The' - $index =~ s/^Example\s*[1-9][0-9]*\s*:\s*//; # remove 'Example :' - print LATEX "%\n\\index{$index}\n" if ($index); - $lastcmd = 'head2'; - } - elsif ($cmd eq 'over') { # 1 level within a listing environment - push(@indent,$indent); - $indent = $rest + 0; - $lastcmd = 'over'; - } - elsif ($cmd eq 'back') { # 1 level out of a listing environment - $indent = pop(@indent); - warn "Unmatched =back\n" unless defined $indent; - $listingcmd = pop(@listingcmd); - print LATEX "\n\\end{$listingcmd}\n" if ($listingcmd); - $lastcmd = 'back'; - } - elsif ($cmd eq 'item') { # an item paragraph starts - if ($lastcmd eq 'over') { # if we have just entered listing env - # see what type of list environment we are in. - if ($rest =~ /^[0-9]\.?/) { # if numeral heading - $listingcmd = 'enumerate'; - } elsif ($rest =~ /^\*\s*/) { # if * heading - $listingcmd = 'itemize'; - } elsif ($rest =~ /^[^*]/) { # if other headings - $listingcmd = 'description'; - } else { - warn "unknown list type for item $rest"; - } - print LATEX "\n\\begin{$listingcmd}\n"; - push(@listingcmd,$listingcmd); - } elsif ( !@listingcmd ) { - warn "Illegal '=item' command without preceding 'over':"; - warn "=item $bareitem"; - } - - if ($listingcmd eq 'enumerate') { - $rest =~ s/^[0-9]+\.?\s*//; # remove numeral heading - print LATEX "\n\\item"; - print LATEX "{\\bf $rest}" if $rest; - } elsif ($listingcmd eq 'itemize') { - $rest =~ s/^\*\s*//; # remove * heading - print LATEX "\n\\item"; - print LATEX "{\\bf $rest}" if $rest; - } else { # description item - print LATEX "\n\\item[$rest]"; - } - $lastcmd = 'item'; - $rightafter_item = 'yes'; - - # check if the item heading is short or long. - ($itemhead = $rest) =~ s/{\\bf (\S*)}/$1/g; - if (length($itemhead) < 4) { - $itemshort = "yes"; - } else { - $itemshort = "no"; - } - # write index entry - if ($pod =~ "perldiag") { # skip 'perldiag.pod' - goto noindex; - } - # strip out the item of pod quotes and get a plain text entry - $bareitem =~ s/\n/ /g; # remove newlines - $bareitem =~ s/\s*$//; # remove trailing space - $bareitem =~ s/[A-Z]<([^<>]*)>/$1/g; # remove <> quotes - ($index = $bareitem) =~ s/^\*\s+//; # remove leading '*' - $index =~ s/^(An?\s+|The\s+)//i; # remove 'A' and 'The' - $index =~ s/^\s*[1-9][0-9]*\s*[.]\s*$//; # remove numeral only - $index =~ s/^\s*\w\s*$//; # remove 1 char only's - # quote ", @ and ! with " to be used in makeindex. - $index =~ s/"/""/g; # quote " - $index =~ s/@/"@/g; # quote @ - $index =~ s/!/"!/g; # quote ! - ($rest2=$rest) =~ s/^\*\s+//; # remove * - $rest2 =~ s/"/""/g; # quote " - $rest2 =~ s/@/"@/g; # quote @ - $rest2 =~ s/!/"!/g; # quote ! - if ($pod =~ "(perlfunc|perlvar)") { # when doc is perlfunc,perlvar - # take only the 1st word of item heading - $index =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/; - $rest2 =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/; - } - if ($index =~ /[A-Za-z\$@%]/) { - # write \index{plain_text_entry@TeX_string_entry} - print LATEX "%\n\\index{$index\@$rest2}%\n"; - } - noindex: - ; - } - elsif ($cmd eq 'pod') { - ; # recognise the pod directive, as no op (hs) - } - elsif ($cmd eq 'pod') { - ; # recognise the pod directive, as no op (hs) - } - else { - warn "Unrecognized directive: $cmd\n"; - } + # Select sections if supplied + $parser->select(@{ $options{'sections'}}) + if @{$options{'sections'}}; + + # Derive the input file from the output file + $parser->parse_from_file($pod, $output); + + print "Written output to $output\n" if $options{'verbose'}; + + } else { + warn "File $pod not found\n"; } - else { # if not command - &escapes; - $_ = &clear_noremap($_); - $_ = &expand_HTML_escapes($_); - - # if the present paragraphs follows an =item declaration, - # put a line break. - if ($lastcmd eq 'item' && - $rightafter_item eq 'yes' && $itemshort eq "no") { - print LATEX "\\hfil\\\\"; - $rightafter_item = 'no'; - } - print LATEX "\n",$_; + + } +} else { + + # Case where we want everything to be in a single document + + # Need to open the output file ourselves + my $output = $options{'out'}; + $output .= '.tex' unless $output =~ /\.tex$/; + + # Use auto-vivified file handle in perl 5.6 + use Symbol; + my $outfh = gensym; + open ($outfh, ">$output") || die "Could not open output file: $!\n"; + + # Flag to indicate whether we have converted at least one file + # indicates how many files have been converted + my $converted = 0; + + # Loop over the input files + foreach my $pod (@pods) { + + if (-f $pod) { + + warn "Converting $pod\n" if $options{'verbose'}; + + # Open the file (need the handle) + # Use auto-vivified handle in perl 5.6 + my $podfh = gensym; + open ($podfh, "<$pod") || die "Could not open pod file $pod: $!\n"; + + # if this is the first file to be converted we may want to add + # a preamble (controlled by command line option) + if ($converted == 0 && $options{'full'}) { + $preamble = 1; + } else { + $preamble = 0; + } + + # if this is the last file to be converted may want to add + # a postamble (controlled by command line option) + # relies on a previous pass to check existence of all pods we + # are converting. + my $postamble = ( ($converted == $#pods && $options{'full'}) ? 1 : 0 ); + + # Open parser object + # May want to start with a preamble for the first one and + # end with an index for the last + my $parser = new Pod::LaTeX( + MakeIndex => $options{'full'}, + TableOfContents => $preamble, + ReplaceNAMEwithSection => $options{'modify'}, + UniqueLabels => $options{'modify'}, + StartWithNewPage => $options{'full'}, + AddPreamble => $preamble, + AddPostamble => $postamble, + ); + + # Store the file name for error messages + # This is a kluge that breaks the data hiding of the object + $parser->{_INFILE} = $pod; + + # Select sections if supplied + $parser->select(@{ $options{'sections'}}) + if @{$options{'sections'}}; + + # Parse it + $parser->parse_from_filehandle($podfh, $outfh); + + # We have converted at least one file + $converted++; + + } else { + warn "File $pod not found\n"; } -} -print LATEX "\n"; -close(POD); -close(LATEX); + } + # Should unlink the file if we didn't convert anything! + # dont check for return status of unlink + # since there is not a lot to be done if the unlink failed + # and the program does not rely upon it. + unlink "$output" unless $converted; -######################################################################### + # If verbose + warn "Converted $converted files\n" if $options{'verbose'}; -sub do_hdr { - print LATEX "% LaTeX document produced by pod2latex from \"$pod.pod\".\n"; - print LATEX "% The followings need be defined in the preamble of this document:\n"; - print LATEX "%\\def\\C++{{\\rm C\\kern-.05em\\raise.3ex\\hbox{\\footnotesize ++}}}\n"; - print LATEX "%\\def\\underscore{\\leavevmode\\kern.04em\\vbox{\\hrule width 0.4em height 0.3pt}}\n"; - print LATEX "%\\setlength{\\parindent}{0pt}\n"; - print LATEX "\n"; - $podq = &escape_tex_specials("\U$pod\E"); - print LATEX "\\section{$podq}%\n"; - print LATEX "\\index{$podq}"; - print LATEX "\n"; } -sub nobreak { - my $string = shift; - $string =~ s/ +/~/g; # TeX no line break - $string; -} +exit; -sub noremap { - local($thing_to_hide) = shift; - $thing_to_hide =~ tr/\000-\177/\200-\377/; - return $thing_to_hide; -} +__END__ -sub init_noremap { - # escape high bit characters in input stream - s/([\200-\377])/"E<".ord($1).">"/ge; -} +=head1 NAME -sub clear_noremap { - local($tmp) = shift; - $tmp =~ tr/\200-\377/\000-\177/; - return $tmp; -} +pod2latex - convert pod documentation to latex format -sub expand_HTML_escapes { - local($s) = $_[0]; - $s =~ s { E<((\d+)|([A-Za-z]+))> } - { - do { - defined($2) - ? do { chr($2) } - : - exists $HTML_Escapes{$3} - ? do { $HTML_Escapes{$3} } - : do { - warn "Unknown escape: $& in $_"; - "E<$1>"; - } - } - }egx; - return $s; -} +=head1 SYNOPSIS -sub escapes { - # make C++ into \C++, which is to be defined as - # \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}} - s/\bC\+\+/\\C++{}/g; -} + pod2latex *.pm -# Translate a string into a TeX \tt string to obtain a verbatim print out. -# TeX special characters are escaped by \. -# This can be used inside of LaTeX command arguments. -# We don't use LaTeX \verb since it doesn't work inside of command arguments. -sub alltt { - local($str) = shift; - # other chars than #,\,$,%,&,{,},_,\,^,~ ([ and ] included). - $str =~ s/([^${backslash_escapables}\\\^\~]+)/&noremap("$&")/eg; - # chars #,\,$,%,&,{,} => \# , ... - $str =~ s/([$backslash_escapables2])/&noremap("\\$&")/eg; - # chars _,\,^,~ => \char`\_ , ... - $str =~ s/_/&noremap("\\char`\\_")/eg; - $str =~ s/\\/&noremap("\\char`\\\\")/ge; - $str =~ s/\^/\\char`\\^/g; - $str =~ s/\~/\\char`\\~/g; - - $str =~ tr/\200-\377/\000-\177/; # put back - $str = "{\\tt ".$str."}"; # make it a \tt string - return $str; -} + pod2latex -out mytex.tex *.pod -sub escape_tex_specials { - local($str) = shift; - # other chars than #,\,$,%,&,{,}, _,\,^,~ ([ and ] included). - # backslash escapable characters #,\,$,%,&,{,} except _. - $str =~ s/([$backslash_escapables2])/&noremap("\\$1")/ge; - $str =~ s/_/&noremap("\\underscore{}")/ge; # \_ is too thin. - # quote TeX special characters |, ^, ~, \. - $str =~ s/\|/&noremap("\$|\$")/ge; - $str =~ s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge; - $str =~ s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge; - $str =~ s/\\/&noremap("\$\\backslash{}\$")/ge; - # characters need to be treated differently in TeX - # * - $str =~ s/[*]/&noremap("\$\\ast\$")/ge; - # escape < and > as math string, - $str =~ s/</&noremap("\$<\$")/ge; - $str =~ s/>/&noremap("\$>\$")/ge; - $str =~ tr/\200-\377/\000-\177/; # put back - return $str; -} + pod2latex -full -sections 'DESCRIPTION|NAME' SomeDir -sub internal_lrefs { - local($_) = shift; - - s{L</([^>]+)>}{$1}g; - my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); - my $retstr = "the "; - my $i; - for ($i = 0; $i <= $#items; $i++) { - $retstr .= "C<$items[$i]>"; - $retstr .= ", " if @items > 2 && $i != $#items; - $retstr .= " and " if $i+2 == @items; - } - $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) - . " elsewhere in this document"; +=head1 DESCRIPTION - return $retstr; -} +C<pod2latex> is a program to convert POD format documentation +(L<perlpod>) into latex. It can process multiple input documents at a +time and either generate a latex file per input document or a single +combined output file. + +=head1 OPTIONS AND ARGUMENTS + +This section describes the supported command line options. Minium +matching is supported. + +=over 4 + +=item B<-out> + +Name of the output file to be used. If there are multiple input pods +it is assumed that the intention is to write all translated output +into a single file. C<.tex> is appended if not present. If the +argument is not supplied, a single document will be created for each +input file. + +=item B<-full> + +Creates a complete C<latex> file that can be processed immediately +(unless C<=for/=begin> directives are used that rely on extra packages). +Table of contents and index generation commands are included in the +wrapper C<latex> code. + +=item B<-sections> + +Specify pod sections to include (or remove if negated) in the +translation. See L<Pod::Select/"SECTION SPECIFICATIONS"> for the +format to use for I<section-spec>. This option may be given multiple +times on the command line.This is identical to the similar option in +the C<podselect()> command. + +=item B<-modify> + +This option causes the output C<latex> to be slightly +modified from the input pod such that when a C<=head1 NAME> +is encountered a section is created containing the actual +pod name (rather than B<NAME>) and all subsequent C<=head1> +directives are treated as subsections. This has the advantage +that the description of a module will be in its own section +which is helpful for including module descriptions in documentation. +Also forces C<latex> label and index entries to be prefixed by the +name of the module. + +=item B<-help> + +Print a brief help message and exit. + +=item B<-man> + +Print the manual page and exit. + +=item B<-verbose> + +Print information messages as each document is processed. + +=back + +=head1 BUGS + +Known bugs are: + +=over 4 + +=item * + +Cross references between documents are not resolved when multiple +pod documents are converted into a single output C<latex> file. + +=item * + +Functions and variables are not automatically recognized +and they will therefore not be marked up in any special way +unless instructed by an explicit pod command. + +=back + +=head1 SEE ALSO + +L<Pod::LaTeX> + +=head1 AUTHOR + +Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> + +This program is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +Copyright (C) 2000 Tim Jenness. + +=cut -# map of HTML escapes to TeX escapes. -BEGIN { -%HTML_Escapes = ( - 'amp' => '&', # ampersand - 'lt' => '<', # left chevron, less-than - 'gt' => '>', # right chevron, greater-than - 'quot' => '"', # double quote - - "Aacute" => "\\'{A}", # capital A, acute accent - "aacute" => "\\'{a}", # small a, acute accent - "Acirc" => "\\^{A}", # capital A, circumflex accent - "acirc" => "\\^{a}", # small a, circumflex accent - "AElig" => '\\AE', # capital AE diphthong (ligature) - "aelig" => '\\ae', # small ae diphthong (ligature) - "Agrave" => "\\`{A}", # capital A, grave accent - "agrave" => "\\`{a}", # small a, grave accent - "Aring" => '\\u{A}', # capital A, ring - "aring" => '\\u{a}', # small a, ring - "Atilde" => '\\~{A}', # capital A, tilde - "atilde" => '\\~{a}', # small a, tilde - "Auml" => '\\"{A}', # capital A, dieresis or umlaut mark - "auml" => '\\"{a}', # small a, dieresis or umlaut mark - "Ccedil" => '\\c{C}', # capital C, cedilla - "ccedil" => '\\c{c}', # small c, cedilla - "Eacute" => "\\'{E}", # capital E, acute accent - "eacute" => "\\'{e}", # small e, acute accent - "Ecirc" => "\\^{E}", # capital E, circumflex accent - "ecirc" => "\\^{e}", # small e, circumflex accent - "Egrave" => "\\`{E}", # capital E, grave accent - "egrave" => "\\`{e}", # small e, grave accent - "ETH" => '\\OE', # capital Eth, Icelandic - "eth" => '\\oe', # small eth, Icelandic - "Euml" => '\\"{E}', # capital E, dieresis or umlaut mark - "euml" => '\\"{e}', # small e, dieresis or umlaut mark - "Iacute" => "\\'{I}", # capital I, acute accent - "iacute" => "\\'{i}", # small i, acute accent - "Icirc" => "\\^{I}", # capital I, circumflex accent - "icirc" => "\\^{i}", # small i, circumflex accent - "Igrave" => "\\`{I}", # capital I, grave accent - "igrave" => "\\`{i}", # small i, grave accent - "Iuml" => '\\"{I}', # capital I, dieresis or umlaut mark - "iuml" => '\\"{i}', # small i, dieresis or umlaut mark - "Ntilde" => '\\~{N}', # capital N, tilde - "ntilde" => '\\~{n}', # small n, tilde - "Oacute" => "\\'{O}", # capital O, acute accent - "oacute" => "\\'{o}", # small o, acute accent - "Ocirc" => "\\^{O}", # capital O, circumflex accent - "ocirc" => "\\^{o}", # small o, circumflex accent - "Ograve" => "\\`{O}", # capital O, grave accent - "ograve" => "\\`{o}", # small o, grave accent - "Oslash" => "\\O", # capital O, slash - "oslash" => "\\o", # small o, slash - "Otilde" => "\\~{O}", # capital O, tilde - "otilde" => "\\~{o}", # small o, tilde - "Ouml" => '\\"{O}', # capital O, dieresis or umlaut mark - "ouml" => '\\"{o}', # small o, dieresis or umlaut mark - "szlig" => '\\ss{}', # small sharp s, German (sz ligature) - "THORN" => '\\L', # capital THORN, Icelandic - "thorn" => '\\l',, # small thorn, Icelandic - "Uacute" => "\\'{U}", # capital U, acute accent - "uacute" => "\\'{u}", # small u, acute accent - "Ucirc" => "\\^{U}", # capital U, circumflex accent - "ucirc" => "\\^{u}", # small u, circumflex accent - "Ugrave" => "\\`{U}", # capital U, grave accent - "ugrave" => "\\`{u}", # small u, grave accent - "Uuml" => '\\"{U}', # capital U, dieresis or umlaut mark - "uuml" => '\\"{u}', # small u, dieresis or umlaut mark - "Yacute" => "\\'{Y}", # capital Y, acute accent - "yacute" => "\\'{y}", # small y, acute accent - "yuml" => '\\"{y}', # small y, dieresis or umlaut mark -); -} !NO!SUBS! close OUT or die "Can't close $file: $!"; diff --git a/pod/roffitall b/pod/roffitall index 018c0b3475..396da6fae2 100644 --- a/pod/roffitall +++ b/pod/roffitall @@ -27,70 +27,82 @@ case "$1" in ;; esac +# NEEDS TO BE BUILT BASED ON Makefile (or Makefile.SH, should such happen) toroff=` echo \ - $mandir/perl.1 \ - $mandir/perldata.1 \ - $mandir/perlsyn.1 \ - $mandir/perlop.1 \ - $mandir/perlre.1 \ - $mandir/perlrun.1 \ - $mandir/perlfunc.1 \ - $mandir/perlvar.1 \ - $mandir/perlsub.1 \ - $mandir/perlopentut.1 \ - $mandir/perlmod.1 \ - $mandir/perlmodlib.1 \ - $mandir/perlmodinstall.1 \ - $mandir/perlfork.1 \ - $mandir/perlform.1 \ - $mandir/perllocale.1 \ - $mandir/perlref.1 \ - $mandir/perlreftut.1 \ - $mandir/perldsc.1 \ - $mandir/perllol.1 \ - $mandir/perlboot.1 \ - $mandir/perltoot.1 \ - $mandir/perlobj.1 \ - $mandir/perltie.1 \ - $mandir/perlbot.1 \ - $mandir/perlipc.1 \ - $mandir/perlthrtut.1 \ - $mandir/perldebguts.1 \ - $mandir/perldebug.1 \ - $mandir/perlnumber.1 \ - $mandir/perldiag.1 \ - $mandir/perlsec.1 \ - $mandir/perltrap.1 \ - $mandir/perlport.1 \ - $mandir/perlstyle.1 \ - $mandir/perlpod.1 \ - $mandir/perlbook.1 \ - $mandir/perlembed.1 \ - $mandir/perlapio.1 \ - $mandir/perlxs.1 \ - $mandir/perlxstut.1 \ - $mandir/perlguts.1 \ - $mandir/perlcall.1 \ - $mandir/perlcompile.1 \ - $mandir/perltodo.1 \ - $mandir/perlapi.1 \ - $mandir/perlintern.1 \ - $mandir/perlhack.1 \ - $mandir/perlhist.1 \ - $mandir/perldelta.1 \ - $mandir/perl5004delta.1 \ - $mandir/perl5005delta.1 \ - $mandir/perlfaq.1 \ - $mandir/perlfaq1.1 \ - $mandir/perlfaq2.1 \ - $mandir/perlfaq3.1 \ - $mandir/perlfaq4.1 \ - $mandir/perlfaq5.1 \ - $mandir/perlfaq6.1 \ - $mandir/perlfaq7.1 \ - $mandir/perlfaq8.1 \ - $mandir/perlfaq9.1 \ + $mandir/perl.1 \ + $mandir/perl5004delta.1 \ + $mandir/perl5005delta.1 \ + $mandir/perl56delta.1 \ + $mandir/perlapi.1 \ + $mandir/perlapio.1 \ + $mandir/perlbook.1 \ + $mandir/perlboot.1 \ + $mandir/perlbot.1 \ + $mandir/perlcall.1 \ + $mandir/perlcompile.1 \ + $mandir/perldata.1 \ + $mandir/perldbmfilter.1 \ + $mandir/perldebguts.1 \ + $mandir/perldebug.1 \ + $mandir/perldelta.1 \ + $mandir/perldiag.1 \ + $mandir/perldsc.1 \ + $mandir/perlembed.1 \ + $mandir/perlfaq.1 \ + $mandir/perlfaq1.1 \ + $mandir/perlfaq2.1 \ + $mandir/perlfaq3.1 \ + $mandir/perlfaq4.1 \ + $mandir/perlfaq5.1 \ + $mandir/perlfaq6.1 \ + $mandir/perlfaq7.1 \ + $mandir/perlfaq8.1 \ + $mandir/perlfaq9.1 \ + $mandir/perlfilter.1 \ + $mandir/perlfork.1 \ + $mandir/perlform.1 \ + $mandir/perlfunc.1 \ + $mandir/perlguts.1 \ + $mandir/perlhack.1 \ + $mandir/perlhist.1 \ + $mandir/perlintern.1 \ + $mandir/perlipc.1 \ + $mandir/perllexwarn.1 \ + $mandir/perllocale.1 \ + $mandir/perllol.1 \ + $mandir/perlmod.1 \ + $mandir/perlmodinstall.1 \ + $mandir/perlmodlib.1 \ + $mandir/perlnewmod.1 \ + $mandir/perlnumber.1 \ + $mandir/perlobj.1 \ + $mandir/perlop.1 \ + $mandir/perlopentut.1 \ + $mandir/perlpod.1 \ + $mandir/perlport.1 \ + $mandir/perlre.1 \ + $mandir/perlref.1 \ + $mandir/perlreftut.1 \ + $mandir/perlrequick.1 \ + $mandir/perlretut.1 \ + $mandir/perlrun.1 \ + $mandir/perlsec.1 \ + $mandir/perlstyle.1 \ + $mandir/perlsub.1 \ + $mandir/perlsyn.1 \ + $mandir/perlthrtut.1 \ + $mandir/perltie.1 \ + $mandir/perltoc.1 \ + $mandir/perltodo.1 \ + $mandir/perltoot.1 \ + $mandir/perltootc.1 \ + $mandir/perltrap.1 \ + $mandir/perlunicode.1 \ + $mandir/perlutil.1 \ + $mandir/perlvar.1 \ + $mandir/perlxs.1 \ + $mandir/perlxstut.1 \ \ $mandir/a2p.1 \ $mandir/c2ph.1 \ @@ -198,7 +198,7 @@ PP(pp_rv2gv) else { if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN n_a; + STRLEN len; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -236,13 +236,17 @@ PP(pp_rv2gv) report_uninit(); RETSETUNDEF; } - sym = SvPV(sv, n_a); + sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV); - if (!sv) + if (!sv + && (!is_gv_magical(sym,len,0) + || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -276,7 +280,7 @@ PP(pp_rv2sv) else { GV *gv = (GV*)sv; char *sym; - STRLEN n_a; + STRLEN len; if (SvTYPE(gv) != SVt_PVGV) { if (SvGMAGICAL(sv)) { @@ -292,13 +296,17 @@ PP(pp_rv2sv) report_uninit(); RETSETUNDEF; } - sym = SvPV(sv, n_a); + sym = SvPV(sv, len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV); - if (!gv) + if (!gv + && (!is_gv_magical(sym,len,0) + || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -591,6 +599,9 @@ PP(pp_gelem) case 'F': if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ tmpRef = (SV*)GvIOp(gv); + else + if (strEQ(elem, "FORMAT")) + tmpRef = (SV*)GvFORM(gv); break; case 'G': if (strEQ(elem, "GLOB")) @@ -961,7 +972,7 @@ PP(pp_modulo) NV dright; NV dleft; - if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); right = (right_neg = (i < 0)) ? -i : i; } @@ -973,7 +984,7 @@ PP(pp_modulo) dright = -dright; } - if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + if (!use_double && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); left = (left_neg = (i < 0)) ? -i : i; } @@ -2195,7 +2206,7 @@ PP(pp_chr) (void)SvUPGRADE(TARG,SVt_PV); - if (value > 255 && !IN_BYTE) { + if ((value > 255 && !IN_BYTE) || (value & 0x80 && PL_hints & HINT_UTF8) ) { SvGROW(TARG, UTF8_MAXLEN+1); tmps = SvPVX(TARG); tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value); @@ -4367,6 +4378,7 @@ PP(pp_pack) register I32 items; STRLEN fromlen; register char *pat = SvPVx(*++MARK, fromlen); + char *patcopy; register char *patend = pat + fromlen; register I32 len; I32 datumtype; @@ -4397,6 +4409,7 @@ PP(pp_pack) items = SP - MARK; MARK++; sv_setpvn(cat, "", 0); + patcopy = pat; while (pat < patend) { SV *lengthcode = Nullsv; #define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no) @@ -4404,8 +4417,12 @@ PP(pp_pack) #ifdef PERL_NATINT_PACK natint = 0; #endif - if (isSPACE(datumtype)) + if (isSPACE(datumtype)) { + patcopy++; continue; + } + if (datumtype == 'U' && pat == patcopy+1) + SvUTF8_on(cat); if (datumtype == '#') { while (pat < patend && *pat != '\n') pat++; @@ -5249,24 +5266,7 @@ PP(pp_lock) dTOPss; SV *retsv = sv; #ifdef USE_THREADS - MAGIC *mg; - - if (SvROK(sv)) - sv = SvRV(sv); - - mg = condpair_magic(sv); - MUTEX_LOCK(MgMUTEXP(mg)); - if (MgOWNER(mg) == thr) - MUTEX_UNLOCK(MgMUTEXP(mg)); - else { - while (MgOWNER(mg)) - COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); - MgOWNER(mg) = thr; - DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n", - PTR2UV(thr), PTR2UV(sv));) - MUTEX_UNLOCK(MgMUTEXP(mg)); - SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); - } + sv_lock(sv); #endif /* USE_THREADS */ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV || SvTYPE(retsv) == SVt_PVCV) { @@ -725,36 +725,60 @@ PP(pp_mapstart) PP(pp_mapwhile) { djSP; - I32 diff = (SP - PL_stack_base) - *PL_markstack_ptr; + I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */ I32 count; I32 shift; SV** src; SV** dst; + /* first, move source pointer to the next item in the source list */ ++PL_markstack_ptr[-1]; - if (diff) { - if (diff > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) { - shift = diff - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]); - count = (SP - PL_stack_base) - PL_markstack_ptr[-1] + 2; + + /* if there are new items, push them into the destination list */ + if (items) { + /* might need to make room back there first */ + if (items > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) { + /* XXX this implementation is very pessimal because the stack + * is repeatedly extended for every set of items. Is possible + * to do this without any stack extension or copying at all + * by maintaining a separate list over which the map iterates + * (like foreach does). --gsar */ + + /* everything in the stack after the destination list moves + * towards the end the stack by the amount of room needed */ + shift = items - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]); + + /* items to shift up (accounting for the moved source pointer) */ + count = (SP - PL_stack_base) - (PL_markstack_ptr[-1] - 1); + + /* This optimization is by Ben Tilly and it does + * things differently from what Sarathy (gsar) + * is describing. The downside of this optimization is + * that leaves "holes" (uninitialized and hopefully unused areas) + * to the Perl stack, but on the other hand this + * shouldn't be a problem. If Sarathy's idea gets + * implemented, this optimization should become + * irrelevant. --jhi */ + if (shift < count) + shift = count; /* Avoid shifting too often --Ben Tilly */ EXTEND(SP,shift); src = SP; dst = (SP += shift); PL_markstack_ptr[-1] += shift; *PL_markstack_ptr += shift; - while (--count) + while (count--) *dst-- = *src--; } - dst = PL_stack_base + (PL_markstack_ptr[-2] += diff) - 1; - ++diff; - while (--diff) + /* copy the new items down to the destination list */ + dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1; + while (items--) *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs); } LEAVE; /* exit inner scope */ /* All done yet? */ if (PL_markstack_ptr[-1] > *PL_markstack_ptr) { - I32 items; I32 gimme = GIMME_V; (void)POPMARK; /* pop top */ @@ -777,6 +801,7 @@ PP(pp_mapwhile) ENTER; /* enter inner scope */ SAVEVPTR(PL_curpm); + /* set $_ to the new source item */ src = PL_stack_base[PL_markstack_ptr[-1]]; SvTEMP_off(src); DEFSV = src; @@ -891,6 +916,10 @@ PP(pp_sort) PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV); PL_sortstash = stash; } +#ifdef USE_THREADS + sv_lock((SV *)PL_firstgv); + sv_lock((SV *)PL_secondgv); +#endif SAVESPTR(GvSV(PL_firstgv)); SAVESPTR(GvSV(PL_secondgv)); } @@ -913,6 +942,7 @@ PP(pp_sort) cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ + cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; } qsortsv((myorigmark+1), max, @@ -1555,7 +1585,7 @@ PP(pp_caller) PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV))); GvMULTI_on(tmpgv); - AvREAL_off(PL_dbargs); /* XXX Should be REIFY */ + AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */ } if (AvMAX(PL_dbargs) < AvFILLp(ary) + off) @@ -1571,9 +1601,12 @@ PP(pp_caller) { SV * mask ; SV * old_warnings = cx->blk_oldcop->cop_warnings ; - if (old_warnings == pWARN_NONE || old_warnings == pWARN_STD) + + if (old_warnings == pWARN_NONE || + (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0)) mask = newSVpvn(WARN_NONEstring, WARNsize) ; - else if (old_warnings == pWARN_ALL) + else if (old_warnings == pWARN_ALL || + (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) mask = newSVpvn(WARN_ALLstring, WARNsize) ; else mask = newSVsv(old_warnings); @@ -2305,6 +2338,7 @@ PP(pp_goto) cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ + cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; ++mark; @@ -2631,11 +2665,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) /* switch to eval mode */ if (PL_curcop == &PL_compiling) { - SAVECOPSTASH(&PL_compiling); + SAVECOPSTASH_FREE(&PL_compiling); CopSTASH_set(&PL_compiling, PL_curstash); } - SAVECOPFILE(&PL_compiling); - SAVECOPLINE(&PL_compiling); if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { SV *sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]", @@ -2645,7 +2677,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) } else sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); + SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); + SAVECOPLINE(&PL_compiling); CopLINE_set(&PL_compiling, 1); /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs @@ -2993,8 +3027,19 @@ PP(pp_require) { tryname = name; tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE); +#ifdef MACOS_TRADITIONAL + /* We consider paths of the form :a:b ambiguous and interpret them first + as global then as local + */ + if (!tryrsfp && name[0] == ':' && name[1] != ':' && strchr(name+2, ':')) + goto trylocal; + } + else +trylocal: { +#else } else { +#endif AV *ar = GvAVn(PL_incgv); I32 i; #ifdef VMS @@ -3112,6 +3157,10 @@ PP(pp_require) } else { char *dir = SvPVx(dirsv, n_a); +#ifdef MACOS_TRADITIONAL + char buf[256]; + Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf), name+(name[0] == ':')); +#else #ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, Nullch)) == Nullch) @@ -3121,8 +3170,17 @@ PP(pp_require) #else Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); #endif +#endif TAINT_PROPER("require"); tryname = SvPVX(namesv); +#ifdef MACOS_TRADITIONAL + { + /* Convert slashes in the name part, but not the directory part, to colons */ + char * colon; + for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); ) + *colon++ = ':'; + } +#endif tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE); if (tryrsfp) { if (tryname[0] == '.' && tryname[1] == '/') @@ -3133,7 +3191,7 @@ PP(pp_require) } } } - SAVECOPFILE(&PL_compiling); + SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tryrsfp ? tryname : name); SvREFCNT_dec(namesv); if (!tryrsfp) { @@ -3243,7 +3301,6 @@ PP(pp_entereval) /* switch to eval mode */ - SAVECOPFILE(&PL_compiling); if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { SV *sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]", @@ -3253,7 +3310,9 @@ PP(pp_entereval) } else sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); + SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); + SAVECOPLINE(&PL_compiling); CopLINE_set(&PL_compiling, 1); /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs @@ -145,38 +145,72 @@ PP(pp_concat) { dPOPTOPssrl; STRLEN len; - char *s; + U8 *s; bool left_utf = DO_UTF8(left); bool right_utf = DO_UTF8(right); + if (left_utf != right_utf) { + if (TARG == right && !right_utf) { + sv_utf8_upgrade(TARG); /* Now straight binary copy */ + SvUTF8_on(TARG); + } + else { + /* Set TARG to PV(left), then add right */ + U8 *l, *c, *olds = NULL; + STRLEN targlen; + if (TARG == right) { + /* Need a safe copy elsewhere since we're just about to + write onto TARG */ + olds = (U8*)SvPV(right,len); + s = (U8*)savepv((char*)olds); + } + else + s = (U8*)SvPV(right,len); + l = (U8*)SvPV(left, targlen); + if (TARG != left) + sv_setpvn(TARG, (char*)l, targlen); + if (!left_utf) + sv_utf8_upgrade(TARG); + /* Extend TARG to length of right (s) */ + targlen = SvCUR(TARG) + len; + if (!right_utf) { + /* plus one for each hi-byte char if we have to upgrade */ + for (c = s; *c; c++) { + if (*c & 0x80) + targlen++; + } + } + SvGROW(TARG, targlen+1); + /* And now copy, maybe upgrading right to UTF8 on the fly */ + for (c = (U8*)SvEND(TARG); *s; s++) { + if (*s & 0x80 && !right_utf) + c = uv_to_utf8(c, *s); + else + *c++ = *s; + } + SvCUR_set(TARG, targlen); + *SvEND(TARG) = '\0'; + SvUTF8_on(TARG); + SETs(TARG); + Safefree(olds); + RETURN; + } + } + if (TARG != left) { - if (right_utf && !left_utf) - sv_utf8_upgrade(left); - s = SvPV(left,len); - SvUTF8_off(TARG); + s = (U8*)SvPV(left,len); if (TARG == right) { - if (left_utf && !right_utf) - sv_utf8_upgrade(right); - sv_insert(TARG, 0, 0, s, len); - if (left_utf || right_utf) - SvUTF8_on(TARG); + sv_insert(TARG, 0, 0, (char*)s, len); SETs(TARG); RETURN; } - sv_setpvn(TARG,s,len); + sv_setpvn(TARG, (char *)s, len); } - else if (SvGMAGICAL(TARG)) { + else if (SvGMAGICAL(TARG)) mg_get(TARG); - if (right_utf && !left_utf) - sv_utf8_upgrade(left); - } - else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) { + else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) sv_setpv(TARG, ""); /* Suppress warning. */ - s = SvPV_force(TARG, len); - } - if (left_utf && !right_utf) - sv_utf8_upgrade(right); - s = SvPV(right,len); + s = (U8*)SvPV(right,len); if (SvOK(TARG)) { #if defined(PERL_Y2KWARN) if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) { @@ -190,11 +224,11 @@ PP(pp_concat) } } #endif - sv_catpvn(TARG,s,len); + sv_catpvn(TARG, (char *)s, len); } else - sv_setpvn(TARG,s,len); /* suppress warning */ - if (left_utf || right_utf) + sv_setpvn(TARG, (char *)s, len); /* suppress warning */ + if (left_utf) SvUTF8_on(TARG); SETTARG; RETURN; @@ -366,7 +400,7 @@ PP(pp_print) if (!(io = GvIO(gv))) { if (ckWARN(WARN_UNOPENED)) { SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a)); } @@ -377,7 +411,7 @@ PP(pp_print) if (ckWARN2(WARN_CLOSED, WARN_IO)) { if (IoIFP(io)) { SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", SvPV(sv,n_a)); @@ -462,7 +496,7 @@ PP(pp_rv2av) if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN n_a; + STRLEN len; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -481,13 +515,17 @@ PP(pp_rv2av) } RETSETUNDEF; } - sym = SvPV(sv,n_a); + sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV); - if (!gv) + if (!gv + && (!is_gv_magical(sym,len,0) + || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -562,7 +600,7 @@ PP(pp_rv2hv) if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN n_a; + STRLEN len; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -581,13 +619,17 @@ PP(pp_rv2hv) } RETSETUNDEF; } - sym = SvPV(sv,n_a); + sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV); - if (!gv) + if (!gv + && (!is_gv_magical(sym,len,0) + || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -1340,7 +1382,7 @@ Perl_do_readline(pTHX) || fp == PerlIO_stderr())) { SV* sv = sv_newmortal(); - gv_efullname3(sv, PL_last_in_gv, Nullch); + gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", SvPV_nolen(sv)); } @@ -1382,8 +1424,7 @@ Perl_do_readline(pTHX) /* delay EOF state for a snarfed empty file */ #define SNARF_EOF(gimme,rs,io,sv) \ (gimme != G_SCALAR || SvCUR(sv) \ - || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE) \ - || ((IoFLAGS(io) |= IOf_NOLINE), FALSE)) + || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs)) for (;;) { if (!sv_gets(sv, fp, offset) @@ -1416,6 +1457,7 @@ Perl_do_readline(pTHX) SvTAINTED_on(sv); } IoLINES(io)++; + IoFLAGS(io) |= IOf_NOLINE; SvSETMAGIC(sv); XPUSHs(sv); if (type == OP_GLOB) { @@ -1879,7 +1921,7 @@ PP(pp_subst) SPAGAIN; PUSHs(sv_2mortal(newSViv((I32)iters))); } - (void)SvPOK_only(TARG); + (void)SvPOK_only_UTF8(TARG); TAINT_IF(rxtainted); if (SvSMAGICAL(TARG)) { PUTBACK; @@ -2228,7 +2270,9 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) && (gv = (GV*)*svp) ))) { /* Use GV from the stack as a fallback. */ /* GV is potentially non-unique, or contain different CV. */ - sv_setsv(dbsv, newRV((SV*)cv)); + SV *tmp = newRV((SV*)cv); + sv_setsv(dbsv, tmp); + SvREFCNT_dec(tmp); } else { gv_efullname3(dbsv, gv, Nullch); @@ -2651,6 +2695,7 @@ try_autoload: cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ + cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; ++MARK; @@ -2875,6 +2920,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) char* leaf = name; char* sep = Nullch; char* p; + GV* gv; for (p = name; *p; p++) { if (*p == '\'') @@ -2890,9 +2936,18 @@ S_method_common(pTHX_ SV* meth, U32* hashp) packname = name; packlen = sep - name; } - Perl_croak(aTHX_ - "Can't locate object method \"%s\" via package \"%s\"", - leaf, packname); + gv = gv_fetchpv(packname, 0, SVt_PVHV); + if (gv && isGV(gv)) { + Perl_croak(aTHX_ + "Can't locate object method \"%s\" via package \"%s\"", + leaf, packname); + } + else { + Perl_croak(aTHX_ + "Can't locate object method \"%s\" via package \"%s\"" + " (perhaps you forgot to load \"%s\"?)", + leaf, packname, packname); + } } return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv; } @@ -21,13 +21,18 @@ #ifdef I_SHADOW /* Shadow password support for solaris - pdo@cs.umd.edu * Not just Solaris: at least HP-UX, IRIX, Linux. - * the API is from SysV. --jhi */ -#ifdef __hpux__ + * The API is from SysV. + * + * There are at least two more shadow interfaces, + * see the comments in pp_gpwent(). + * + * --jhi */ +# ifdef __hpux__ /* There is a MAXINT coming from <shadow.h> <- <hpsecurity.h> <- <values.h> * and another MAXINT from "perl.h" <- <sys/param.h>. */ -#undef MAXINT -#endif -#include <shadow.h> +# undef MAXINT +# endif +# include <shadow.h> #endif /* XXX If this causes problems, set i_unistd=undef in the hint file. */ @@ -195,7 +200,7 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; #endif #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS) -# if defined(I_SYS_SECURITY) +# ifdef I_SYS_SECURITY # include <sys/security.h> # endif # ifdef ACC_SELF @@ -1065,7 +1070,7 @@ PP(pp_select) else { GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE); if (gvp && *gvp == egv) { - gv_efullname3(TARG, PL_defoutgv, Nullch); + gv_efullname4(TARG, PL_defoutgv, Nullch, FALSE); XPUSHTARG; } else { @@ -1171,7 +1176,7 @@ PP(pp_enterwrite) if (!cv) { if (fgv) { SV *tmpsv = sv_newmortal(); - gv_efullname3(tmpsv, fgv, Nullch); + gv_efullname4(tmpsv, fgv, Nullch, FALSE); DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv)); } DIE(aTHX_ "Not a format reference"); @@ -1252,7 +1257,7 @@ PP(pp_leavewrite) cv = GvFORM(fgv); if (!cv) { SV *tmpsv = sv_newmortal(); - gv_efullname3(tmpsv, fgv, Nullch); + gv_efullname4(tmpsv, fgv, Nullch, FALSE); DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv)); } if (CvCLONE(cv)) @@ -1270,7 +1275,7 @@ PP(pp_leavewrite) if (ckWARN2(WARN_CLOSED,WARN_IO)) { if (IoIFP(io)) { SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", SvPV_nolen(sv)); @@ -1340,7 +1345,7 @@ PP(pp_prtf) sv = NEWSV(0,0); if (!(io = GvIO(gv))) { if (ckWARN(WARN_UNOPENED)) { - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a)); } @@ -1350,7 +1355,7 @@ PP(pp_prtf) else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED,WARN_IO)) { if (IoIFP(io)) { - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", SvPV(sv,n_a)); @@ -1546,7 +1551,7 @@ PP(pp_sysread) || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO)) { SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", SvPV_nolen(sv)); } @@ -3054,7 +3059,7 @@ PP(pp_fttext) else { if (ckWARN(WARN_UNOPENED)) { gv = cGVOP_gv; - Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>", + Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file %s", GvENAME(gv)); } SETERRNO(EBADF,RMS$_IFI); @@ -3744,7 +3749,7 @@ PP(pp_system) } } PERL_FLUSHALL_FOR_CHILD; -#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) && !defined(__CYGWIN__) +#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) && !defined(__CYGWIN__) || defined(PERL_MICRO) if (PerlProc_pipe(pp) >= 0) did_pipes = 1; while ((childpid = vfork()) == -1) { @@ -3763,13 +3768,17 @@ PP(pp_system) if (childpid > 0) { if (did_pipes) PerlLIO_close(pp[1]); +#ifndef PERL_MICRO rsignal_save(SIGINT, SIG_IGN, &ihand); rsignal_save(SIGQUIT, SIG_IGN, &qhand); +#endif do { result = wait4pid(childpid, &status, 0); } while (result == -1 && errno == EINTR); +#ifndef PERL_MICRO (void)rsignal_restore(SIGINT, &ihand); (void)rsignal_restore(SIGQUIT, &qhand); +#endif STATUS_NATIVE_SET(result == -1 ? -1 : status); do_execfree(); /* free any memory child malloced on vfork */ SP = ORIGMARK; @@ -4773,11 +4782,59 @@ PP(pp_gpwent) register SV *sv; STRLEN n_a; struct passwd *pwent = NULL; -/* We do not use HAS_GETSPENT in pp_gpwent() but leave it here in the case - * somebody wants to write an XS to access the shadow passwords. --jhi */ -# ifdef HAS_GETSPNAM - struct spwd *spwent = NULL; -# endif + /* + * We currently support only the SysV getsp* shadow password interface. + * The interface is declared in <shadow.h> and often one needs to link + * with -lsecurity or some such. + * This interface is used at least by Solaris, HP-UX, IRIX, and Linux. + * (and SCO?) + * + * AIX getpwnam() is clever enough to return the encrypted password + * only if the caller (euid?) is root. + * + * There are at least two other shadow password APIs. Many platforms + * seem to contain more than one interface for accessing the shadow + * password databases, possibly for compatibility reasons. + * The getsp*() is by far he simplest one, the other two interfaces + * are much more complicated, but also very similar to each other. + * + * <sys/types.h> + * <sys/security.h> + * <prot.h> + * struct pr_passwd *getprpw*(); + * The password is in + * char getprpw*(...).ufld.fd_encrypt[] + * Mention HAS_GETPRPWNAM here so that Configure probes for it. + * + * <sys/types.h> + * <sys/security.h> + * <prot.h> + * struct es_passwd *getespw*(); + * The password is in + * char *(getespw*(...).ufld.fd_encrypt) + * Mention HAS_GETESPWNAM here so that Configure probes for it. + * + * Mention I_PROT here so that Configure probes for it. + * + * In HP-UX for getprpw*() the manual page claims that one should include + * <hpsecurity.h> instead of <sys/security.h>, but that is not needed + * if one includes <shadow.h> as that includes <hpsecurity.h>, + * and pp_sys.c already includes <shadow.h> if there is such. + * + * Note that <sys/security.h> is already probed for, but currently + * it is only included in special cases. + * + * In Digital UNIX/Tru64 if using the getespw*() (which seems to be + * be preferred interface, even though also the getprpw*() interface + * is available) one needs to link with -lsecurity -ldb -laud -lm. + * One also needs to call set_auth_parameters() in main() before + * doing anything else, whether one is using getespw*() or getprpw*(). + * + * Note that accessing the shadow databases can be magnitudes + * slower than accessing the standard databases. + * + * --jhi + */ switch (which) { case OP_GPWNAM: @@ -4816,17 +4873,44 @@ PP(pp_gpwent) sv_setpv(sv, pwent->pw_name); PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + SvPOK_off(sv); + /* If we have getspnam(), we try to dig up the shadow + * password. If we are underprivileged, the shadow + * interface will set the errno to EACCES or similar, + * and return a null pointer. If this happens, we will + * use the dummy password (usually "*" or "x") from the + * standard password database. + * + * In theory we could skip the shadow call completely + * if euid != 0 but in practice we cannot know which + * security measures are guarding the shadow databases + * on a random platform. + * + * Resist the urge to use additional shadow interfaces. + * Divert the urge to writing an extension instead. + * + * --jhi */ # ifdef HAS_GETSPNAM - spwent = getspnam(pwent->pw_name); - if (spwent) - sv_setpv(sv, spwent->sp_pwdp); - else - sv_setpv(sv, pwent->pw_passwd); -# else - sv_setpv(sv, pwent->pw_passwd); + { + struct spwd *spwent; + int saverrno; /* Save and restore errno so that + * underprivileged attempts seem + * to have never made the unsccessful + * attempt to retrieve the shadow password. */ + + saverrno = errno; + spwent = getspnam(pwent->pw_name); + errno = saverrno; + if (spwent && spwent->sp_pwdp) + sv_setpv(sv, spwent->sp_pwdp); + } # endif + if (!SvPOK(sv)) /* Use the standard password, then. */ + sv_setpv(sv, pwent->pw_passwd); + # ifndef INCOMPLETE_TAINTS - /* passwd is tainted because user himself can diddle with it. */ + /* passwd is tainted because user himself can diddle with it. + * admittedly not much and in a very limited way, but nevertheless. */ SvTAINTED_on(sv); # endif @@ -4843,7 +4927,11 @@ PP(pp_gpwent) # else sv_setuv(sv, (UV)pwent->pw_gid); # endif - /* pw_change, pw_quota, and pw_age are mutually exclusive. */ + /* pw_change, pw_quota, and pw_age are mutually exclusive-- + * because of the poor interface of the Perl getpw*(), + * not because there's some standard/convention saying so. + * A better interface would have been to return a hash, + * but we are accursed by our history, alas. --jhi. */ PUSHs(sv = sv_mortalcopy(&PL_sv_no)); # ifdef PWCHANGE sv_setiv(sv, (IV)pwent->pw_change); @@ -4857,7 +4945,8 @@ PP(pp_gpwent) # endif # endif - /* pw_class and pw_comment are mutually exclusive. */ + /* pw_class and pw_comment are mutually exclusive--. + * see the above note for pw_change, pw_quota, and pw_age. */ PUSHs(sv = sv_mortalcopy(&PL_sv_no)); # ifdef PWCLASS sv_setpv(sv, pwent->pw_class); @@ -4902,9 +4991,6 @@ PP(pp_spwent) djSP; #if defined(HAS_PASSWD) && defined(HAS_SETPWENT) setpwent(); -# ifdef HAS_SETSPENT - setspent(); -# endif RETPUSHYES; #else DIE(aTHX_ PL_no_func, "setpwent"); @@ -4916,9 +5002,6 @@ PP(pp_epwent) djSP; #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) endpwent(); -# ifdef HAS_ENDSPENT - endspent(); -# endif RETPUSHYES; #else DIE(aTHX_ PL_no_func, "endpwent"); @@ -61,6 +61,7 @@ PERL_CALLCONV bool Perl_Gv_AMupdate(pTHX_ HV* stash); PERL_CALLCONV OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail); PERL_CALLCONV OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last); PERL_CALLCONV I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp); +PERL_CALLCONV void Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, char *attrstr, STRLEN len); PERL_CALLCONV SV* Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash); PERL_CALLCONV bool Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash); PERL_CALLCONV SV** Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash); @@ -280,7 +281,7 @@ PERL_CALLCONV char* Perl_vform(pTHX_ const char* pat, va_list* args); PERL_CALLCONV void Perl_free_tmps(pTHX); PERL_CALLCONV OP* Perl_gen_constant_list(pTHX_ OP* o); #if !defined(HAS_GETENV_LEN) -PERL_CALLCONV char* Perl_getenv_len(pTHX_ char* key, unsigned long *len); +PERL_CALLCONV char* Perl_getenv_len(pTHX_ const char* key, unsigned long *len); #endif PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv); PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp); @@ -291,6 +292,7 @@ PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN le PERL_CALLCONV void Perl_gv_check(pTHX_ HV* stash); PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, GV* gv); PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char* prefix); +PERL_CALLCONV void Perl_gv_efullname4(pTHX_ SV* sv, GV* gv, const char* prefix, bool keepmain); PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name); PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level); PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name); @@ -298,6 +300,7 @@ PERL_CALLCONV GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name PERL_CALLCONV GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type); PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, GV* gv); PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix); +PERL_CALLCONV void Perl_gv_fullname4(pTHX_ SV* sv, GV* gv, const char* prefix, bool keepmain); PERL_CALLCONV void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi); PERL_CALLCONV HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create); PERL_CALLCONV HV* Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 create); @@ -331,6 +334,7 @@ PERL_CALLCONV U32 Perl_intro_my(pTHX); PERL_CALLCONV char* Perl_instr(pTHX_ const char* big, const char* little); PERL_CALLCONV bool Perl_io_close(pTHX_ IO* io, bool not_implicit); PERL_CALLCONV OP* Perl_invert(pTHX_ OP* cmd); +PERL_CALLCONV bool Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags); PERL_CALLCONV bool Perl_is_uni_alnum(pTHX_ U32 c); PERL_CALLCONV bool Perl_is_uni_alnumc(pTHX_ U32 c); PERL_CALLCONV bool Perl_is_uni_idfirst(pTHX_ U32 c); @@ -366,6 +370,7 @@ PERL_CALLCONV U32 Perl_to_uni_upper_lc(pTHX_ U32 c); PERL_CALLCONV U32 Perl_to_uni_title_lc(pTHX_ U32 c); PERL_CALLCONV U32 Perl_to_uni_lower_lc(pTHX_ U32 c); PERL_CALLCONV int Perl_is_utf8_char(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len); PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ U8 *p); PERL_CALLCONV bool Perl_is_utf8_alnumc(pTHX_ U8 *p); PERL_CALLCONV bool Perl_is_utf8_idfirst(pTHX_ U8 *p); @@ -650,6 +655,7 @@ PERL_CALLCONV void Perl_save_freesv(pTHX_ SV* sv); PERL_CALLCONV void Perl_save_freeop(pTHX_ OP* o); PERL_CALLCONV void Perl_save_freepv(pTHX_ char* pv); PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr); +PERL_CALLCONV void Perl_save_generic_pvref(pTHX_ char** str); PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty); PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv); PERL_CALLCONV void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr); @@ -803,10 +809,12 @@ PERL_CALLCONV void Perl_unlock_condpair(pTHX_ void* svv); PERL_CALLCONV void Perl_unsharepvn(pTHX_ const char* sv, I32 len, U32 hash); PERL_CALLCONV void Perl_unshare_hek(pTHX_ HEK* hek); PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* id, OP* arg); -PERL_CALLCONV U8* Perl_utf16_to_utf8(pTHX_ U16* p, U8 *d, I32 bytelen); -PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8 *d, I32 bytelen); +PERL_CALLCONV U8* Perl_utf16_to_utf8(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newlen); +PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newlen); PERL_CALLCONV I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b); PERL_CALLCONV U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off); +PERL_CALLCONV U8* Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN len); +PERL_CALLCONV U8* Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN *len); PERL_CALLCONV UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen); PERL_CALLCONV U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv); PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv); @@ -855,6 +863,9 @@ PERL_CALLCONV struct perl_vars * Perl_GetVars(pTHX); #endif PERL_CALLCONV int Perl_runops_standard(pTHX); PERL_CALLCONV int Perl_runops_debug(pTHX); +#if defined(USE_THREADS) +PERL_CALLCONV SV* Perl_sv_lock(pTHX_ SV *sv); +#endif PERL_CALLCONV void Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...) #ifdef CHECK_FORMAT __attribute__((format(printf,pTHX_2,pTHX_3))) @@ -939,6 +950,7 @@ PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl); #endif #if defined(HAVE_INTERP_INTERN) +PERL_CALLCONV void Perl_sys_intern_clear(pTHX); PERL_CALLCONV void Perl_sys_intern_init(pTHX); #endif @@ -954,16 +966,12 @@ STATIC I32 S_avhv_index(pTHX_ AV* av, SV* sv, U32 hash); #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -STATIC I32 S_do_trans_CC_simple(pTHX_ SV *sv); -STATIC I32 S_do_trans_CC_count(pTHX_ SV *sv); -STATIC I32 S_do_trans_CC_complex(pTHX_ SV *sv); -STATIC I32 S_do_trans_UU_simple(pTHX_ SV *sv); -STATIC I32 S_do_trans_UU_count(pTHX_ SV *sv); -STATIC I32 S_do_trans_UU_complex(pTHX_ SV *sv); -STATIC I32 S_do_trans_UC_simple(pTHX_ SV *sv); -STATIC I32 S_do_trans_CU_simple(pTHX_ SV *sv); -STATIC I32 S_do_trans_UC_trivial(pTHX_ SV *sv); -STATIC I32 S_do_trans_CU_trivial(pTHX_ SV *sv); +STATIC I32 S_do_trans_simple(pTHX_ SV *sv); +STATIC I32 S_do_trans_count(pTHX_ SV *sv); +STATIC I32 S_do_trans_complex(pTHX_ SV *sv); +STATIC I32 S_do_trans_simple_utf8(pTHX_ SV *sv); +STATIC I32 S_do_trans_count_utf8(pTHX_ SV *sv); +STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv); #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) @@ -1217,6 +1225,7 @@ STATIC char* S_scan_subst(pTHX_ char *start); STATIC char* S_scan_trans(pTHX_ char *start); STATIC char* S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp); STATIC char* S_skipspace(pTHX_ char *s); +STATIC char* S_swallow_bom(pTHX_ U8 *s); STATIC void S_checkcomma(pTHX_ char *s, char *name, char *what); STATIC void S_force_ident(pTHX_ char *s, int kind); STATIC void S_incline(pTHX_ char *s); @@ -1230,6 +1239,7 @@ STATIC I32 S_sublex_done(pTHX); STATIC I32 S_sublex_push(pTHX); STATIC I32 S_sublex_start(pTHX); STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append); +STATIC HV * S_find_in_my_stash(pTHX_ char *pkgname, I32 len); STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type); STATIC int S_ao(pTHX_ int toketype); STATIC void S_depcom(pTHX); @@ -901,6 +901,11 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da sv_catsv(data->last_found, last_str); data->last_end += l * (mincount - 1); } + } else { + /* start offset must point into the last copy */ + data->last_start_min += minnext * (mincount - 1); + data->last_start_max += is_inf ? 0 : (maxcount - 1) + * (minnext + data->pos_delta); } } /* It is counted once already... */ @@ -2812,6 +2817,7 @@ S_regpposixcc(pTHX_ I32 value) if (strnEQ(posixcc, "space", 5)) namedclass = complement ? ANYOF_NSPACE : ANYOF_SPACE; + break; case 'u': if (strnEQ(posixcc, "upper", 5)) namedclass = @@ -2838,10 +2844,10 @@ S_regpposixcc(pTHX_ I32 value) Perl_croak(aTHX_ "Character class [:%.*s:] unknown", t - s - 1, s + 1); - } else if (ckWARN(WARN_REGEXP) && !SIZE_ONLY) + } else if (!SIZE_ONLY) /* [[=foo=]] and [[.foo.]] are still future. */ - Perl_warner(aTHX_ WARN_REGEXP, - "Character class syntax [%c %c] is reserved for future extensions", c, c); + Perl_croak(aTHX_ + "Character class syntax [%c %c] is reserved for future extensions", c, c); } else { /* Maternal grandfather: * "[:" ending in ":" but not in ":]" */ @@ -2869,8 +2875,8 @@ S_checkposixcc(pTHX) Perl_warner(aTHX_ WARN_REGEXP, "Character class syntax [%c %c] belongs inside character classes", c, c); if (c == '=' || c == '.') - Perl_warner(aTHX_ WARN_REGEXP, - "Character class syntax [%c %c] is reserved for future extensions", c, c); + Perl_croak(aTHX_ + "Character class syntax [%c %c] is reserved for future extensions", c, c); } } } @@ -221,6 +221,22 @@ typedef struct re_cc_state #define regcpblow(cp) LEAVE_SCOPE(cp) +#define TRYPAREN(paren, n, input) { \ + if (paren) { \ + if (n) { \ + PL_regstartp[paren] = HOPc(input, -1) - PL_bostr; \ + PL_regendp[paren] = input - PL_bostr; \ + } \ + else \ + PL_regendp[paren] = -1; \ + } \ + if (regmatch(next)) \ + sayYES; \ + if (paren && n) \ + PL_regendp[paren] = -1; \ +} + + /* * pregexec and friends */ @@ -599,9 +615,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, find_anchor: while (t < strend - prog->minlen) { if (*t == '\n') { - if (t < s - prog->check_offset_min) { + if (t < check_at - prog->check_offset_min) { if (prog->anchored_substr) { - /* We definitely contradict the found anchored + /* Since we moved from the found position, + we definitely contradict the found anchored substr. Due to the above check we do not contradict "check" substr. Thus we can arrive here only if check substr @@ -612,14 +629,19 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, PL_colors[0],PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset))); goto do_other_anchored; } + /* We don't contradict the found floating substring. */ + /* XXXX Why not check for STCLASS? */ s = t + 1; DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n", PL_colors[0],PL_colors[1], (long)(s - i_strpos))); goto set_useful; } - DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting at offset %ld...\n", + /* Position contradicts check-string */ + /* XXXX probably better to look for check-string + than for "\n", so one should lower the limit for t? */ + DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n", PL_colors[0],PL_colors[1], (long)(t + 1 - i_strpos))); - strpos = s = t + 1; + other_last = strpos = s = t + 1; goto restart; } t++; @@ -628,15 +650,20 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, PL_colors[0],PL_colors[1])); goto fail_finish; } + else { + DEBUG_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n", + PL_colors[0],PL_colors[1])); + } s = t; set_useful: ++BmUSEFUL(prog->check_substr); /* hooray/5 */ } else { PL_bostr = tmp; - /* The found string does not prohibit matching at beg-of-str + /* The found string does not prohibit matching at strpos, - no optimization of calling REx engine can be performed, - unless it was an MBOL and we are not after MBOL. */ + unless it was an MBOL and we are not after MBOL, + or a future STCLASS check will fail this. */ try_at_start: /* Even in this situation we may use MBOL flag if strpos is offset wrt the start of the string. */ @@ -649,8 +676,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, goto find_anchor; } DEBUG_r( if (ml_anch) - PerlIO_printf(Perl_debug_log, "Does not contradict /%s^%s/m...\n", - PL_colors[0],PL_colors[1]); + PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n", + (long)(strpos - i_strpos), PL_colors[0],PL_colors[1]); ); success_at_start: if (!(prog->reganch & ROPT_NAUGHTY) /* XXXX If strpos moved? */ @@ -659,6 +686,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, && prog->check_substr == prog->float_substr) { /* If flags & SOMETHING - do not do it many times on the same match */ + DEBUG_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n")); SvREFCNT_dec(prog->check_substr); prog->check_substr = Nullsv; /* disable */ prog->float_substr = Nullsv; /* clear */ @@ -725,7 +753,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, goto fail; } DEBUG_r( PerlIO_printf(Perl_debug_log, - "Trying %s substr starting at offset %ld...\n", + "Looking for %s substr starting at offset %ld...\n", what, (long)(s + start_shift - i_strpos)) ); goto restart; } @@ -735,7 +763,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, /* Recheck anchored substring, but not floating... */ s = check_at; DEBUG_r( PerlIO_printf(Perl_debug_log, - "Trying anchored substr starting at offset %ld...\n", + "Looking for anchored substr starting at offset %ld...\n", (long)(other_last - i_strpos)) ); goto do_other_anchored; } @@ -744,8 +772,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, if (ml_anch) { s = t = t + 1; DEBUG_r( PerlIO_printf(Perl_debug_log, - "Trying /^/m starting at offset %ld...\n", - (long)(t - i_strpos)) ); + "Looking for /%s^%s/m starting at offset %ld...\n", + PL_colors[0],PL_colors[1], (long)(t - i_strpos)) ); goto try_at_offset; } if (!prog->float_substr) /* Could have been deleted */ @@ -1869,7 +1897,7 @@ S_regmatch(pTHX_ regnode *prog) } sayNO; case SBOL: - if (locinput == PL_regbol && PL_regprev == '\n') + if (locinput == PL_bostr) break; sayNO; case GPOS: @@ -3023,16 +3051,7 @@ S_regmatch(pTHX_ regnode *prog) sayNO; } /* PL_reginput == locinput now */ - if (paren) { - if (ln) { - PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr; - PL_regendp[paren] = locinput - PL_bostr; - } - else - PL_regendp[paren] = -1; - } - if (regmatch(next)) - sayYES; + TRYPAREN(paren, ln, locinput); PL_reginput = locinput; /* Could be reset... */ REGCP_UNWIND; /* Couldn't or didn't -- move forward. */ @@ -3046,16 +3065,7 @@ S_regmatch(pTHX_ regnode *prog) UCHARAT(PL_reginput) == c1 || UCHARAT(PL_reginput) == c2) { - if (paren) { - if (n) { - PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr; - PL_regendp[paren] = PL_reginput - PL_bostr; - } - else - PL_regendp[paren] = -1; - } - if (regmatch(next)) - sayYES; + TRYPAREN(paren, n, PL_reginput); REGCP_UNWIND; } /* Couldn't or didn't -- move forward. */ @@ -3089,16 +3099,7 @@ S_regmatch(pTHX_ regnode *prog) UCHARAT(PL_reginput) == c1 || UCHARAT(PL_reginput) == c2) { - if (paren && n) { - if (n) { - PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr; - PL_regendp[paren] = PL_reginput - PL_bostr; - } - else - PL_regendp[paren] = -1; - } - if (regmatch(next)) - sayYES; + TRYPAREN(paren, n, PL_reginput); REGCP_UNWIND; } /* Couldn't or didn't -- back up. */ @@ -3113,8 +3114,7 @@ S_regmatch(pTHX_ regnode *prog) UCHARAT(PL_reginput) == c1 || UCHARAT(PL_reginput) == c2) { - if (regmatch(next)) - sayYES; + TRYPAREN(paren, n, PL_reginput); REGCP_UNWIND; } /* Couldn't or didn't -- back up. */ @@ -249,7 +249,7 @@ Perl_save_svref(pTHX_ SV **sptr) return save_scalar_at(sptr); } -/* Like save_svref(), but doesn't deal with magic. Can be used to +/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to * restore a global SV to its prior contents, freeing new value. */ void Perl_save_generic_svref(pTHX_ SV **sptr) @@ -261,6 +261,19 @@ Perl_save_generic_svref(pTHX_ SV **sptr) SSPUSHINT(SAVEt_GENERIC_SVREF); } +/* Like save_pptr(), but also Safefree()s the new value if it is different + * from the old one. Can be used to restore a global char* to its prior + * contents, freeing new value. */ +void +Perl_save_generic_pvref(pTHX_ char **str) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(str); + SSPUSHPTR(*str); + SSPUSHINT(SAVEt_GENERIC_PVREF); +} + void Perl_save_gp(pTHX_ GV *gv, I32 empty) { @@ -646,6 +659,7 @@ Perl_leave_scope(pTHX_ I32 base) register AV *av; register HV *hv; register void* ptr; + register char* str; I32 i; if (base < -1) @@ -666,14 +680,20 @@ Perl_leave_scope(pTHX_ I32 base) ptr = &GvSV(gv); SvREFCNT_dec(gv); goto restore_sv; + case SAVEt_GENERIC_PVREF: /* generic pv */ + str = (char*)SSPOPPTR; + ptr = SSPOPPTR; + if (*(char**)ptr != str) { + Safefree(*(char**)ptr); + *(char**)ptr = str; + } + break; case SAVEt_GENERIC_SVREF: /* generic sv */ value = (SV*)SSPOPPTR; ptr = SSPOPPTR; - if (ptr) { - sv = *(SV**)ptr; - *(SV**)ptr = value; - SvREFCNT_dec(sv); - } + sv = *(SV**)ptr; + *(SV**)ptr = value; + SvREFCNT_dec(sv); SvREFCNT_dec(value); break; case SAVEt_SVREF: /* scalar reference */ @@ -32,6 +32,7 @@ #define SAVEt_VPTR 31 #define SAVEt_I8 32 #define SAVEt_COMPPAD 33 +#define SAVEt_GENERIC_PVREF 34 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) @@ -105,6 +106,7 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>. #define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) #define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv)) #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) +#define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) #define SAVEDELETE(h,k,l) \ save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) #define SAVEDESTRUCTOR(f,p) \ @@ -147,14 +149,18 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>. } STMT_END #ifdef USE_ITHREADS -# define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop)) -# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop)) +# define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c)) +# define SAVECOPSTASH_FREE(c) SAVEGENERICPV(CopSTASHPV(c)) +# define SAVECOPFILE(c) SAVEPPTR(CopFILE(c)) +# define SAVECOPFILE_FREE(c) SAVEGENERICPV(CopFILE(c)) #else -# define SAVECOPSTASH(cop) SAVESPTR(CopSTASH(cop)) -# define SAVECOPFILE(cop) SAVESPTR(CopFILEGV(cop)) +# define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c)) +# define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */ +# define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) +# define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) #endif -#define SAVECOPLINE(cop) SAVEI16(CopLINE(cop)) +#define SAVECOPLINE(c) SAVEI16(CopLINE(c)) /* SSNEW() temporarily allocates a specified number of bytes of data on the * savestack. It returns an integer index into the savestack, because a @@ -194,6 +194,7 @@ Perl_sv_free_arenas(pTHX) { SV* sva; SV* svanext; + XPV *arena, *arenanext; /* Free arenas here, but be careful about fake ones. (We assume contiguity of the fake ones with the corresponding real ones.) */ @@ -207,6 +208,84 @@ Perl_sv_free_arenas(pTHX) Safefree((void *)sva); } + for (arena = PL_xiv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xiv_arenaroot = 0; + + for (arena = PL_xnv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xnv_arenaroot = 0; + + for (arena = PL_xrv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xrv_arenaroot = 0; + + for (arena = PL_xpv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpv_arenaroot = 0; + + for (arena = (XPV*)PL_xpviv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpviv_arenaroot = 0; + + for (arena = (XPV*)PL_xpvnv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvnv_arenaroot = 0; + + for (arena = (XPV*)PL_xpvcv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvcv_arenaroot = 0; + + for (arena = (XPV*)PL_xpvav_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvav_arenaroot = 0; + + for (arena = (XPV*)PL_xpvhv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvhv_arenaroot = 0; + + for (arena = (XPV*)PL_xpvmg_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvmg_arenaroot = 0; + + for (arena = (XPV*)PL_xpvlv_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvlv_arenaroot = 0; + + for (arena = (XPV*)PL_xpvbm_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_xpvbm_arenaroot = 0; + + for (arena = (XPV*)PL_he_arenaroot; arena; arena = arenanext) { + arenanext = (XPV*)arena->xpv_pv; + Safefree(arena); + } + PL_he_arenaroot = 0; + if (PL_nice_chunk) Safefree(PL_nice_chunk); PL_nice_chunk = Nullch; @@ -300,7 +379,12 @@ S_more_xnv(pTHX) { register NV* xnv; register NV* xnvend; - New(711, xnv, 1008/sizeof(NV), NV); + XPV *ptr; + New(711, ptr, 1008/sizeof(XPV), XPV); + ptr->xpv_pv = (char*)PL_xnv_arenaroot; + PL_xnv_arenaroot = ptr; + + xnv = (NV*) ptr; xnvend = &xnv[1008 / sizeof(NV) - 1]; xnv += (sizeof(XPVIV) - 1) / sizeof(NV) + 1; /* fudge by sizeof XPVIV */ PL_xnv_root = xnv; @@ -338,9 +422,15 @@ S_more_xrv(pTHX) { register XRV* xrv; register XRV* xrvend; - New(712, PL_xrv_root, 1008/sizeof(XRV), XRV); - xrv = PL_xrv_root; + XPV *ptr; + New(712, ptr, 1008/sizeof(XPV), XPV); + ptr->xpv_pv = (char*)PL_xrv_arenaroot; + PL_xrv_arenaroot = ptr; + + xrv = (XRV*) ptr; xrvend = &xrv[1008 / sizeof(XRV) - 1]; + xrv += (sizeof(XPV) - 1) / sizeof(XRV) + 1; + PL_xrv_root = xrv; while (xrv < xrvend) { xrv->xrv_rv = (SV*)(xrv + 1); xrv++; @@ -375,9 +465,12 @@ S_more_xpv(pTHX) { register XPV* xpv; register XPV* xpvend; - New(713, PL_xpv_root, 1008/sizeof(XPV), XPV); - xpv = PL_xpv_root; + New(713, xpv, 1008/sizeof(XPV), XPV); + xpv->xpv_pv = (char*)PL_xpv_arenaroot; + PL_xpv_arenaroot = xpv; + xpvend = &xpv[1008 / sizeof(XPV) - 1]; + PL_xpv_root = ++xpv; while (xpv < xpvend) { xpv->xpv_pv = (char*)(xpv + 1); xpv++; @@ -407,15 +500,17 @@ S_del_xpviv(pTHX_ XPVIV *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpviv(pTHX) { register XPVIV* xpviv; register XPVIV* xpvivend; - New(714, PL_xpviv_root, 1008/sizeof(XPVIV), XPVIV); - xpviv = PL_xpviv_root; + New(714, xpviv, 1008/sizeof(XPVIV), XPVIV); + xpviv->xpv_pv = (char*)PL_xpviv_arenaroot; + PL_xpviv_arenaroot = xpviv; + xpvivend = &xpviv[1008 / sizeof(XPVIV) - 1]; + PL_xpviv_root = ++xpviv; while (xpviv < xpvivend) { xpviv->xpv_pv = (char*)(xpviv + 1); xpviv++; @@ -423,7 +518,6 @@ S_more_xpviv(pTHX) xpviv->xpv_pv = 0; } - STATIC XPVNV* S_new_xpvnv(pTHX) { @@ -446,15 +540,17 @@ S_del_xpvnv(pTHX_ XPVNV *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvnv(pTHX) { register XPVNV* xpvnv; register XPVNV* xpvnvend; - New(715, PL_xpvnv_root, 1008/sizeof(XPVNV), XPVNV); - xpvnv = PL_xpvnv_root; + New(715, xpvnv, 1008/sizeof(XPVNV), XPVNV); + xpvnv->xpv_pv = (char*)PL_xpvnv_arenaroot; + PL_xpvnv_arenaroot = xpvnv; + xpvnvend = &xpvnv[1008 / sizeof(XPVNV) - 1]; + PL_xpvnv_root = ++xpvnv; while (xpvnv < xpvnvend) { xpvnv->xpv_pv = (char*)(xpvnv + 1); xpvnv++; @@ -462,8 +558,6 @@ S_more_xpvnv(pTHX) xpvnv->xpv_pv = 0; } - - STATIC XPVCV* S_new_xpvcv(pTHX) { @@ -486,15 +580,17 @@ S_del_xpvcv(pTHX_ XPVCV *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvcv(pTHX) { register XPVCV* xpvcv; register XPVCV* xpvcvend; - New(716, PL_xpvcv_root, 1008/sizeof(XPVCV), XPVCV); - xpvcv = PL_xpvcv_root; + New(716, xpvcv, 1008/sizeof(XPVCV), XPVCV); + xpvcv->xpv_pv = (char*)PL_xpvcv_arenaroot; + PL_xpvcv_arenaroot = xpvcv; + xpvcvend = &xpvcv[1008 / sizeof(XPVCV) - 1]; + PL_xpvcv_root = ++xpvcv; while (xpvcv < xpvcvend) { xpvcv->xpv_pv = (char*)(xpvcv + 1); xpvcv++; @@ -502,8 +598,6 @@ S_more_xpvcv(pTHX) xpvcv->xpv_pv = 0; } - - STATIC XPVAV* S_new_xpvav(pTHX) { @@ -526,15 +620,17 @@ S_del_xpvav(pTHX_ XPVAV *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvav(pTHX) { register XPVAV* xpvav; register XPVAV* xpvavend; - New(717, PL_xpvav_root, 1008/sizeof(XPVAV), XPVAV); - xpvav = PL_xpvav_root; + New(717, xpvav, 1008/sizeof(XPVAV), XPVAV); + xpvav->xav_array = (char*)PL_xpvav_arenaroot; + PL_xpvav_arenaroot = xpvav; + xpvavend = &xpvav[1008 / sizeof(XPVAV) - 1]; + PL_xpvav_root = ++xpvav; while (xpvav < xpvavend) { xpvav->xav_array = (char*)(xpvav + 1); xpvav++; @@ -542,8 +638,6 @@ S_more_xpvav(pTHX) xpvav->xav_array = 0; } - - STATIC XPVHV* S_new_xpvhv(pTHX) { @@ -566,15 +660,17 @@ S_del_xpvhv(pTHX_ XPVHV *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvhv(pTHX) { register XPVHV* xpvhv; register XPVHV* xpvhvend; - New(718, PL_xpvhv_root, 1008/sizeof(XPVHV), XPVHV); - xpvhv = PL_xpvhv_root; + New(718, xpvhv, 1008/sizeof(XPVHV), XPVHV); + xpvhv->xhv_array = (char*)PL_xpvhv_arenaroot; + PL_xpvhv_arenaroot = xpvhv; + xpvhvend = &xpvhv[1008 / sizeof(XPVHV) - 1]; + PL_xpvhv_root = ++xpvhv; while (xpvhv < xpvhvend) { xpvhv->xhv_array = (char*)(xpvhv + 1); xpvhv++; @@ -582,7 +678,6 @@ S_more_xpvhv(pTHX) xpvhv->xhv_array = 0; } - STATIC XPVMG* S_new_xpvmg(pTHX) { @@ -605,15 +700,17 @@ S_del_xpvmg(pTHX_ XPVMG *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvmg(pTHX) { register XPVMG* xpvmg; register XPVMG* xpvmgend; - New(719, PL_xpvmg_root, 1008/sizeof(XPVMG), XPVMG); - xpvmg = PL_xpvmg_root; + New(719, xpvmg, 1008/sizeof(XPVMG), XPVMG); + xpvmg->xpv_pv = (char*)PL_xpvmg_arenaroot; + PL_xpvmg_arenaroot = xpvmg; + xpvmgend = &xpvmg[1008 / sizeof(XPVMG) - 1]; + PL_xpvmg_root = ++xpvmg; while (xpvmg < xpvmgend) { xpvmg->xpv_pv = (char*)(xpvmg + 1); xpvmg++; @@ -621,8 +718,6 @@ S_more_xpvmg(pTHX) xpvmg->xpv_pv = 0; } - - STATIC XPVLV* S_new_xpvlv(pTHX) { @@ -645,15 +740,17 @@ S_del_xpvlv(pTHX_ XPVLV *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvlv(pTHX) { register XPVLV* xpvlv; register XPVLV* xpvlvend; - New(720, PL_xpvlv_root, 1008/sizeof(XPVLV), XPVLV); - xpvlv = PL_xpvlv_root; + New(720, xpvlv, 1008/sizeof(XPVLV), XPVLV); + xpvlv->xpv_pv = (char*)PL_xpvlv_arenaroot; + PL_xpvlv_arenaroot = xpvlv; + xpvlvend = &xpvlv[1008 / sizeof(XPVLV) - 1]; + PL_xpvlv_root = ++xpvlv; while (xpvlv < xpvlvend) { xpvlv->xpv_pv = (char*)(xpvlv + 1); xpvlv++; @@ -661,7 +758,6 @@ S_more_xpvlv(pTHX) xpvlv->xpv_pv = 0; } - STATIC XPVBM* S_new_xpvbm(pTHX) { @@ -684,15 +780,17 @@ S_del_xpvbm(pTHX_ XPVBM *p) UNLOCK_SV_MUTEX; } - STATIC void S_more_xpvbm(pTHX) { register XPVBM* xpvbm; register XPVBM* xpvbmend; - New(721, PL_xpvbm_root, 1008/sizeof(XPVBM), XPVBM); - xpvbm = PL_xpvbm_root; + New(721, xpvbm, 1008/sizeof(XPVBM), XPVBM); + xpvbm->xpv_pv = (char*)PL_xpvbm_arenaroot; + PL_xpvbm_arenaroot = xpvbm; + xpvbmend = &xpvbm[1008 / sizeof(XPVBM) - 1]; + PL_xpvbm_root = ++xpvbm; while (xpvbm < xpvbmend) { xpvbm->xpv_pv = (char*)(xpvbm + 1); xpvbm++; @@ -2292,6 +2390,14 @@ Perl_sv_2bool(pTHX_ register SV *sv) } } +/* +=for apidoc sv_utf8_upgrade + +Convert the PV of an SV to its UTF8-encoded form. + +=cut +*/ + void Perl_sv_utf8_upgrade(pTHX_ register SV *sv) { @@ -2333,6 +2439,17 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv) } } +/* +=for apidoc sv_utf8_downgrade + +Attempt to convert the PV of an SV from UTF8-encoded to byte encoding. +This may not be possible if the PV contains non-byte encoding characters; +if this is the case, either returns false or, if C<fail_ok> is not +true, croaks. + +=cut +*/ + bool Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok) { @@ -2382,6 +2499,15 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok) return TRUE; } +/* +=for apidoc sv_utf8_encode + +Convert the PV of an SV to UTF8-encoded, but then turn off the C<SvUTF8> +flag so that it looks like bytes again. Nothing calls this. + +=cut +*/ + void Perl_sv_utf8_encode(pTHX_ register SV *sv) { @@ -2561,7 +2687,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) char *name = GvNAME(sstr); STRLEN len = GvNAMELEN(sstr); sv_upgrade(dstr, SVt_PVGV); - sv_magic(dstr, dstr, '*', name, len); + sv_magic(dstr, dstr, '*', Nullch, 0); GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr)); GvNAME(dstr) = savepvn(name, len); GvNAMELEN(dstr) = len; @@ -2670,7 +2796,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) if(const_sv) const_changed = sv_cmp(const_sv, op_const_sv(CvSTART((CV*)sref), - Nullcv)); + (CV*)sref)); /* ahem, death to those who redefine * active sort subs */ if (PL_curstackinfo->si_type == PERLSI_SORT && @@ -2678,7 +2804,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", GvENAME((GV*)dstr)); - if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE)) + if ((const_changed && const_sv) || ckWARN(WARN_REDEFINE)) Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? "Constant subroutine %s redefined" : "Subroutine %s redefined", @@ -2705,6 +2831,13 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) dref = (SV*)GvIOp(dstr); GvIOp(dstr) = (IO*)sref; break; + case SVt_PVFM: + if (intro) + SAVESPTR(GvFORM(dstr)); + else + dref = (SV*)GvFORM(dstr); + GvFORM(dstr) = (CV*)sref; + break; default: if (intro) SAVESPTR(GvSV(dstr)); @@ -3353,6 +3486,14 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); } +/* +=for apidoc sv_unmagic + +Removes magic from an SV. + +=cut +*/ + int Perl_sv_unmagic(pTHX_ SV *sv, int type) { @@ -3387,6 +3528,14 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type) return 0; } +/* +=for apidoc sv_rvweaken + +Weaken a reference. + +=cut +*/ + SV * Perl_sv_rvweaken(pTHX_ SV *sv) { @@ -3538,7 +3687,13 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN SvSETMAGIC(bigstr); } -/* make sv point to what nstr did */ +/* +=for apidoc sv_replace + +Make the first argument a copy of the second, then delete the original. + +=cut +*/ void Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) @@ -3567,6 +3722,15 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) del_SV(nsv); } +/* +=for apidoc sv_clear + +Clear an SV, making it empty. Does not free the memory used by the SV +itself. + +=cut +*/ + void Perl_sv_clear(pTHX_ register SV *sv) { @@ -3760,6 +3924,14 @@ Perl_sv_newref(pTHX_ SV *sv) return sv; } +/* +=for apidoc sv_free + +Free the memory used by an SV. + +=cut +*/ + void Perl_sv_free(pTHX_ SV *sv) { @@ -3828,6 +4000,15 @@ Perl_sv_len(pTHX_ register SV *sv) return len; } +/* +=for apidoc sv_len_utf8 + +Returns the number of characters in the string in an SV, counting wide +UTF8 bytes as a single character. + +=cut +*/ + STRLEN Perl_sv_len_utf8(pTHX_ register SV *sv) { @@ -3923,38 +4104,51 @@ identical. */ I32 -Perl_sv_eq(pTHX_ register SV *str1, register SV *str2) +Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) { char *pv1; STRLEN cur1; char *pv2; STRLEN cur2; + I32 eq = 0; + bool pv1tmp = FALSE; + bool pv2tmp = FALSE; - if (!str1) { + if (!sv1) { pv1 = ""; cur1 = 0; } else - pv1 = SvPV(str1, cur1); + pv1 = SvPV(sv1, cur1); - if (cur1) { - if (!str2) - return 0; - if (SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) { - if (SvUTF8(str1)) { - sv_utf8_upgrade(str2); - } - else { - sv_utf8_upgrade(str1); - } + if (!sv2){ + pv2 = ""; + cur2 = 0; + } + else + pv2 = SvPV(sv2, cur2); + + /* do not utf8ize the comparands as a side-effect */ + if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE && 0) { + if (SvUTF8(sv1)) { + pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2); + pv2tmp = TRUE; + } + else { + pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1); + pv1tmp = TRUE; } } - pv2 = SvPV(str2, cur2); - if (cur1 != cur2) - return 0; + if (cur1 == cur2) + eq = memEQ(pv1, pv2, cur1); + + if (pv1tmp) + Safefree(pv1); + if (pv2tmp) + Safefree(pv2); - return memEQ(pv1, pv2, cur1); + return eq; } /* @@ -3968,60 +4162,72 @@ C<sv2>. */ I32 -Perl_sv_cmp(pTHX_ register SV *str1, register SV *str2) +Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2) { STRLEN cur1, cur2; char *pv1, *pv2; - I32 retval; + I32 cmp; + bool pv1tmp = FALSE; + bool pv2tmp = FALSE; - if (str1) { - pv1 = SvPV(str1, cur1); - } - else { + if (!sv1) { + pv1 = ""; cur1 = 0; } + else + pv1 = SvPV(sv1, cur1); - if (str2) { - if (SvPOK(str2)) { - if (SvPOK(str1) && SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) { - /* must upgrade other to UTF8 first */ - if (SvUTF8(str1)) { - sv_utf8_upgrade(str2); - } - else { - sv_utf8_upgrade(str1); - /* refresh pointer and length */ - pv1 = SvPVX(str1); - cur1 = SvCUR(str1); - } - } - pv2 = SvPVX(str2); - cur2 = SvCUR(str2); - } + if (!sv2){ + pv2 = ""; + cur2 = 0; + } + else + pv2 = SvPV(sv2, cur2); + + /* do not utf8ize the comparands as a side-effect */ + if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) { + if (SvUTF8(sv1)) { + pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2); + pv2tmp = TRUE; + } else { - pv2 = sv_2pv(str2, &cur2); + pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1); + pv1tmp = TRUE; } } - else { - cur2 = 0; + + if (!cur1) { + cmp = cur2 ? -1 : 0; + } else if (!cur2) { + cmp = 1; + } else { + I32 retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2); + + if (retval) { + cmp = retval < 0 ? -1 : 1; + } else if (cur1 == cur2) { + cmp = 0; + } else { + cmp = cur1 < cur2 ? -1 : 1; + } } - if (!cur1) - return cur2 ? -1 : 0; + if (pv1tmp) + Safefree(pv1); + if (pv2tmp) + Safefree(pv2); - if (!cur2) - return 1; + return cmp; +} - retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2); +/* +=for apidoc sv_cmp_locale - if (retval) - return retval < 0 ? -1 : 1; +Compares the strings in two SVs in a locale-aware manner. See +L</sv_cmp_locale> - if (cur1 == cur2) - return 0; - else - return cur1 < cur2 ? -1 : 1; -} +=cut +*/ I32 Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2) @@ -4124,6 +4330,15 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp) #endif /* USE_LOCALE_COLLATE */ +/* +=for apidoc sv_gets + +Get a line from the filehandle and store it into the SV, optionally +appending to the currently-stored string. + +=cut +*/ + char * Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) { @@ -5030,6 +5245,14 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) } } +/* +=for apidoc sv_true + +Returns true if the SV has a true value by Perl's rules. + +=cut +*/ + I32 Perl_sv_true(pTHX_ register SV *sv) { @@ -5108,6 +5331,14 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp) return sv_2pv(sv, lp); } +/* +=for apidoc sv_pvn_force + +Get a sensible string out of the SV somehow. + +=cut +*/ + char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) { @@ -5180,6 +5411,15 @@ Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp) return sv_pvn(sv,lp); } +/* +=for apidoc sv_pvutf8n_force + +Get a sensible UTF8-encoded string out of the SV somehow. See +L</sv_pvn_force>. + +=cut +*/ + char * Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp) { @@ -5187,6 +5427,14 @@ Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp) return sv_pvn_force(sv,lp); } +/* +=for apidoc sv_reftype + +Returns a string describing what the SV is a reference to. + +=cut +*/ + char * Perl_sv_reftype(pTHX_ SV *sv, int ob) { @@ -5865,17 +6113,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 'v': vectorize = TRUE; q++; - if (args) - vecsv = va_arg(*args, SV*); - else if (svix < svmax) - vecsv = svargs[svix++]; - else { - vecstr = (U8*)""; - veclen = 0; - continue; - } - vecstr = (U8*)SvPVx(vecsv,veclen); - utf = DO_UTF8(vecsv); continue; default: @@ -5926,6 +6163,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV has_precis = TRUE; } + if (vectorize) { + if (args) { + vecsv = va_arg(*args, SV*); + vecstr = (U8*)SvPVx(vecsv,veclen); + utf = DO_UTF8(vecsv); + } + else if (svix < svmax) { + vecsv = svargs[svix++]; + vecstr = (U8*)SvPVx(vecsv,veclen); + utf = DO_UTF8(vecsv); + } + else { + vecstr = (U8*)""; + veclen = 0; + } + } + /* SIZE */ switch (*q) { @@ -6035,6 +6289,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV /* INTEGERS */ case 'p': + if (alt) + goto unknown; if (args) uv = PTR2UV(va_arg(*args, void*)); else @@ -6331,7 +6587,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } else if (svix < svmax) - sv_setuv(svargs[svix++], (UV)i); + sv_setuv_mg(svargs[svix++], (UV)i); continue; /* not "break" */ /* UNKNOWN */ @@ -7152,6 +7408,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl) gv = (GV*)POPPTR(ss,ix); TOPPTR(nss,ix) = gv_dup_inc(gv); break; + case SAVEt_GENERIC_PVREF: /* generic char* */ + c = (char*)POPPTR(ss,ix); + TOPPTR(nss,ix) = pv_dup(c); + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + break; case SAVEt_GENERIC_SVREF: /* generic sv */ case SAVEt_SVREF: /* scalar reference */ sv = (SV*)POPPTR(ss,ix); @@ -7430,17 +7692,29 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* arena roots */ PL_xiv_arenaroot = NULL; PL_xiv_root = NULL; + PL_xnv_arenaroot = NULL; PL_xnv_root = NULL; + PL_xrv_arenaroot = NULL; PL_xrv_root = NULL; + PL_xpv_arenaroot = NULL; PL_xpv_root = NULL; + PL_xpviv_arenaroot = NULL; PL_xpviv_root = NULL; + PL_xpvnv_arenaroot = NULL; PL_xpvnv_root = NULL; + PL_xpvcv_arenaroot = NULL; PL_xpvcv_root = NULL; + PL_xpvav_arenaroot = NULL; PL_xpvav_root = NULL; + PL_xpvhv_arenaroot = NULL; PL_xpvhv_root = NULL; + PL_xpvmg_arenaroot = NULL; PL_xpvmg_root = NULL; + PL_xpvlv_arenaroot = NULL; PL_xpvlv_root = NULL; + PL_xpvbm_arenaroot = NULL; PL_xpvbm_root = NULL; + PL_he_arenaroot = NULL; PL_he_root = NULL; PL_nice_chunk = NULL; PL_nice_chunk_size = 0; @@ -123,21 +123,26 @@ perform the upgrade if necessary. See C<svtype>. #ifdef USE_THREADS -# ifdef EMULATE_ATOMIC_REFCOUNTS -# define ATOMIC_INC(count) STMT_START { \ - MUTEX_LOCK(&PL_svref_mutex); \ - ++count; \ - MUTEX_UNLOCK(&PL_svref_mutex); \ - } STMT_END -# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \ - MUTEX_LOCK(&PL_svref_mutex); \ - res = (--count == 0); \ - MUTEX_UNLOCK(&PL_svref_mutex); \ - } STMT_END -# else -# define ATOMIC_INC(count) atomic_inc(&count) -# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count)) -# endif /* EMULATE_ATOMIC_REFCOUNTS */ +# if defined(VMS) +# define ATOMIC_INC(count) __ATOMIC_INCREMENT_LONG(&count) +# define ATOMIC_DEC_AND_TEST(res,count) res=(1==__ATOMIC_DECREMENT_LONG(&count)) + # else +# ifdef EMULATE_ATOMIC_REFCOUNTS + # define ATOMIC_INC(count) STMT_START { \ + MUTEX_LOCK(&PL_svref_mutex); \ + ++count; \ + MUTEX_UNLOCK(&PL_svref_mutex); \ + } STMT_END +# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \ + MUTEX_LOCK(&PL_svref_mutex); \ + res = (--count == 0); \ + MUTEX_UNLOCK(&PL_svref_mutex); \ + } STMT_END +# else +# define ATOMIC_INC(count) atomic_inc(&count) +# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count)) +# endif /* EMULATE_ATOMIC_REFCOUNTS */ +# endif /* VMS */ #else # define ATOMIC_INC(count) (++count) # define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0)) @@ -153,7 +158,12 @@ perform the upgrade if necessary. See C<svtype>. }) #else # if defined(CRIPPLED_CC) || defined(USE_THREADS) -# define SvREFCNT_inc(sv) sv_newref((SV*)sv) +# if defined(VMS) && defined(__ALPHA) +# define SvREFCNT_inc(sv) \ + (PL_Sv=(SV*)(sv), (PL_Sv && __ATOMIC_INCREMENT_LONG(&(SvREFCNT(PL_Sv)))), (SV *)PL_Sv) +# else +# define SvREFCNT_inc(sv) sv_newref((SV*)sv) +# endif # else # define SvREFCNT_inc(sv) \ ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv) @@ -353,7 +363,19 @@ struct xpvio { PerlIO * xio_ifp; /* ifp and ofp are normally the same */ PerlIO * xio_ofp; /* but sockets need separate streams */ - DIR * xio_dirp; /* for opendir, readdir, etc */ + /* Cray addresses everything by word boundaries (64 bits) and + * code and data pointers cannot be mixed (which is exactly what + * Perl_filter_add() tries to do with the dirp), hence the following + * union trick (as suggested by Gurusamy Sarathy). + * For further information see Geir Johansen's problem report titled + [ID 20000612.002] Perl problem on Cray system + * The any pointer (known as IoANY()) will also be a good place + * to hang any IO disciplines to. + */ + union { + DIR * xiou_dirp; /* for opendir, readdir, etc */ + void * xiou_any; /* for alignment */ + } xio_dirpu; long xio_lines; /* $. */ long xio_page; /* $% */ long xio_page_len; /* $= */ @@ -368,6 +390,8 @@ struct xpvio { char xio_type; char xio_flags; }; +#define xio_dirp xio_dirpu.xiou_dirp +#define xio_any xio_dirpu.xiou_any #define IOf_ARGV 1 /* this fp iterates over ARGV */ #define IOf_START 2 /* check for null ARGV and substitute '-' */ @@ -481,7 +505,8 @@ string. Returns the length of the string which is in the SV. See C<SvLEN>. =for apidoc Am|STRLEN|SvLEN|SV* sv -Returns the size of the string buffer in the SV. See C<SvCUR>. +Returns the size of the string buffer in the SV, not including any part +attributable to C<SvOOK>. See C<SvCUR>. =for apidoc Am|char*|SvEND|SV* sv Returns a pointer to the last character in the string which is in the SV. @@ -694,6 +719,7 @@ Set the length of the string which is in the SV. See C<SvCUR>. #define IoIFP(sv) ((XPVIO*) SvANY(sv))->xio_ifp #define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp #define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp +#define IoANY(sv) ((XPVIO*) SvANY(sv))->xio_any #define IoLINES(sv) ((XPVIO*) SvANY(sv))->xio_lines #define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page #define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len @@ -1045,3 +1071,4 @@ Returns a pointer to the character buffer. #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) #define Sv_Grow sv_grow + diff --git a/t/base/lex.t b/t/base/lex.t index d90d404cac..c7fb0e4cf3 100755 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -1,6 +1,6 @@ #!./perl -print "1..46\n"; +print "1..51\n"; $x = 'x'; @@ -206,3 +206,42 @@ EOT print "# $@\nnot ok $test\n" if $@; T '^main:plink:53$', $test++; } + +# tests 47--51 start here +# tests for new array interpolation semantics: +# arrays now *always* interpolate into "..." strings. +# 20000522 MJD (mjd@plover.com) +{ + my $test = 47; + eval(q(">@nosuch<" eq "><")) || print "# $@", "not "; + print "ok $test\n"; + ++$test; + + # Look at this! This is going to be a common error in the future: + eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not "; + print "ok $test\n"; + ++$test; + + # Let's make sure that normal array interpolation still works right + # For some reason, this appears not to be tested anywhere else. + my @a = (1,2,3); + print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n"; + ++$test; + + # Ditto. + eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"}) + || print "# $@", "not "; + print "ok $test\n"; + ++$test; + + # This isn't actually a lex test, but it's testing the same feature + sub makearray { + my @array = ('fish', 'dog', 'carrot'); + *R::crackers = \@array; + } + + eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"}) + || print "# $@", "not "; + print "ok $test\n"; + ++$test; +} diff --git a/t/comp/require.t b/t/comp/require.t index 1d92687355..bfd4a37fc9 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -7,7 +7,7 @@ BEGIN { # don't make this lexical $i = 1; -print "1..20\n"; +print "1..23\n"; sub do_require { %INC = (); @@ -19,6 +19,7 @@ sub do_require { sub write_file { my $f = shift; open(REQ,">$f") or die "Can't write '$f': $!"; + binmode REQ; print REQ @_; close REQ; } @@ -122,7 +123,19 @@ do "bleah.do"; dofile(); sub dofile { do "bleah.do"; }; print $x; -$i++; + +# UTF-encoded things +my $utf8 = chr(0xFEFF); + +$i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n)); + +sub bytes_to_utf16 { + my $utf16 = pack("$_[0]*", unpack("C*", $_[1])); + return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16; +} + +$i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE +$i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; } diff --git a/t/io/argv.t b/t/io/argv.t index d6093f90ef..2595fa681c 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -5,7 +5,7 @@ BEGIN { unshift @INC, '../lib'; } -print "1..20\n"; +print "1..21\n"; use File::Spec; @@ -107,18 +107,20 @@ print "ok 15\n"; local $/; open F, 'Io_argv1.tmp' or die; <F>; # set $. = 1 + print "not " if defined(<F>); # should hit eof + print "ok 16\n"; open F, $devnull or die; print "not " unless defined(<F>); - print "ok 16\n"; - print "not " if defined(<F>); print "ok 17\n"; print "not " if defined(<F>); print "ok 18\n"; + print "not " if defined(<F>); + print "ok 19\n"; open F, $devnull or die; # restart cycle again print "not " unless defined(<F>); - print "ok 19\n"; - print "not " if defined(<F>); print "ok 20\n"; + print "not " if defined(<F>); + print "ok 21\n"; close F; } diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index a7fca17811..e304766fc1 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -5,6 +5,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){ + print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n"; + exit 0; + } } require AnyDBM_File; use Fcntl; @@ -31,7 +31,15 @@ print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne $deparse->coderef2text(sub {++$test and $test/=2;}); ok; -my $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`; +my $a; +my $Is_VMS = $^O eq 'VMS'; +if ($Is_VMS) { + $^X = "MCR $^X"; + $a = `$^X "-I../lib" "-MO=Deparse" -anle "1"`; +} +else { + $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`; +} $a =~ s/-e syntax OK\n//g; $b = <<'EOF'; @@ -49,18 +57,33 @@ print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b; ok; #6 -$a = `$^X -I../lib -MO=Debug -e 1 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Debug" -e "1"`; +} +else { + $a = `$^X -I../lib -MO=Debug -e 1 2>&1`; +} print "not " unless $a =~ /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s; ok; #7 -$a = `$^X -I../lib -MO=Terse -e 1 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Terse" -e "1"`; +} +else { + $a = `$^X -I../lib -MO=Terse -e 1 2>&1`; +} print "not " unless $a =~ /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s; ok; -$a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/"`; +} +else { + $a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`; +} $a =~ s/\(0x[^)]+\)//g; $a =~ s/\[[^\]]+\]//g; $a =~ s/-e syntax OK//; @@ -80,14 +103,29 @@ $b =~ s/\s+$//; print "# [$a] vs [$b]\nnot " if $a ne $b; ok; -chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`); +if ($Is_VMS) { + chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e "1"`); +} +else { + chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`); +} $a = join ',', sort split /,/, $a; -$a =~ s/-uWin32,//; -$b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,' - . '-umain,-uwarnings'; -print "# [$a] vs [$b]\nnot " if $a ne $b; -ok; +$a =~ s/-uWin32,// if $^O eq 'MSWin32'; +$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2'; +if ($Config{static_ext} eq ' ') { + $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,' + . '-umain,-uwarnings'; + print "# [$a] vs [$b]\nnot " if $a ne $b; + ok; +} else { + print "ok $test # skipped: one or more static extensions\n"; $test++; +} -$a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one"`; +} +else { + $a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`; +} print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s; ok; diff --git a/t/lib/charnames.t b/t/lib/charnames.t index 566baf35b0..2e6a818677 100644 --- a/t/lib/charnames.t +++ b/t/lib/charnames.t @@ -8,7 +8,7 @@ BEGIN { } $| = 1; -print "1..12\n"; +print "1..13\n"; use charnames ':full'; @@ -78,3 +78,15 @@ sub to_bytes { print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a"; print "ok 12\n"; } + +{ + use charnames qw(:full); + use utf8; + + my $x = "\x{221b}"; + my $named = "\N{CUBE ROOT}"; + + print "not " unless ord($x) == ord($named); + print "ok 13\n"; +} + diff --git a/t/lib/complex.t b/t/lib/complex.t index d4beb8bded..b659142af9 100755 --- a/t/lib/complex.t +++ b/t/lib/complex.t @@ -27,7 +27,7 @@ my @script = ( my $eps = 1e-13; if ($^O eq 'unicos') { # For some reason root() produces very inaccurate - $eps = 1e-11; # results in Cray UNICOS, and occasionally also + $eps = 1e-10; # results in Cray UNICOS, and occasionally also } # cos(), sin(), cosh(), sinh(). The division # of doubles is the current suspect. @@ -262,7 +262,7 @@ EOS $test++; push @script, <<EOS; print "# j = \$j\n"; - print "not " unless "\$j" =~ /^-0\\.5\\+0.86602540\\d+i\$/; + print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/; print "ok $test\n"; \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0); diff --git a/t/lib/dprof.t b/t/lib/dprof.t index 4d6f7823c3..fc5bd050cb 100755 --- a/t/lib/dprof.t +++ b/t/lib/dprof.t @@ -3,6 +3,11 @@ BEGIN { chdir( 't' ) if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){ + print "1..0 # Skip: Devel::DProf was not built\n"; + exit 0; + } } END { @@ -11,7 +16,6 @@ END { use Benchmark qw( timediff timestr ); use Getopt::Std 'getopts'; -use Config '%Config'; getopts('vI:p:'); # -v Verbose diff --git a/t/lib/dumper-ovl.t b/t/lib/dumper-ovl.t index 8c095e59be..b8c8719318 100755 --- a/t/lib/dumper-ovl.t +++ b/t/lib/dumper-ovl.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { + print "1..0 # Skip: Data::Dumper was not built\n"; + exit 0; + } } use Data::Dumper; diff --git a/t/lib/dumper.t b/t/lib/dumper.t index b9680bd5e6..7b5a611b7d 100755 --- a/t/lib/dumper.t +++ b/t/lib/dumper.t @@ -6,6 +6,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { + print "1..0 # Skip: Data::Dumper was not built\n"; + exit 0; + } } use Data::Dumper; diff --git a/t/lib/english.t b/t/lib/english.t index dba68dbf94..6438d13176 100755 --- a/t/lib/english.t +++ b/t/lib/english.t @@ -1,9 +1,9 @@ #!./perl -print "1..16\n"; +print "1..22\n"; BEGIN { unshift @INC, '../lib' } -use English; +use English qw( -no_match_vars ) ; use Config; my $threads = $Config{'use5005threads'} || 0; @@ -17,13 +17,11 @@ sub foo { } &foo(1); -if ($threads) { - $_ = "ok 4\nok 5\nok 6\n"; -} else { - $ARG = "ok 4\nok 5\nok 6\n"; -} -/ok 5\n/; -print $PREMATCH, $MATCH, $POSTMATCH; +"abc" =~ /b/; + +print ! $PREMATCH ? "" : "not ", "ok 4\n" ; +print ! $MATCH ? "" : "not ", "ok 5\n" ; +print ! $POSTMATCH ? "" : "not ", "ok 6\n" ; $OFS = " "; $ORS = "\n"; @@ -43,5 +41,25 @@ print $GID == $( ? "ok 12\n" : "not ok 12\n"; print $EUID == $> ? "ok 13\n" : "not ok 13\n"; print $EGID == $) ? "ok 14\n" : "not ok 14\n"; -print $PROGRAM_NAME == $0 ? "ok 15\n" : "not ok 15\n"; +print $PROGRAM_NAME eq $0 ? "ok 15\n" : "not ok 15\n"; print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n"; + +package B ; + +use English ; + +"abc" =~ /b/; + +print $PREMATCH ? "" : "not ", "ok 17\n" ; +print $MATCH ? "" : "not ", "ok 18\n" ; +print $POSTMATCH ? "" : "not ", "ok 19\n" ; + +package C ; + +use English qw( -no_match_vars ) ; + +"abc" =~ /b/; + +print ! $PREMATCH ? "" : "not ", "ok 20\n" ; +print ! $MATCH ? "" : "not ", "ok 21\n" ; +print ! $POSTMATCH ? "" : "not ", "ok 22\n" ; diff --git a/t/lib/filefind.t b/t/lib/filefind.t index e9a2916738..ca12e742ce 100755 --- a/t/lib/filefind.t +++ b/t/lib/filefind.t @@ -19,6 +19,7 @@ finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, "."); my $case = 2; +my $FastFileTests_OK = 0; END { unlink 'fa/fa_ord','fa/fsl','fa/faa/faa_ord', @@ -57,8 +58,15 @@ sub wanted { print "# '$_' => 1\n"; s#\.$## if ($^O eq 'VMS' && $_ ne '.'); Check( $Expect{$_} ); - delete $Expect{$_}; + if ( $FastFileTests_OK ) { + delete $Expect{$_} + unless ( $Expect_Dir{$_} && ! -d _ ); + } else { + delete $Expect{$_} + unless ( $Expect_Dir{$_} && ! -d $_ ); + } $File::Find::prune=1 if $_ eq 'faba'; + } sub dn_wanted { @@ -106,6 +114,9 @@ touch('fa/fab/faba/faba_ord'); %Expect = ('.' => 1, 'fsl' => 1, 'fa_ord' => 1, 'fab' => 1, 'fab_ord' => 1, 'faba' => 1, 'faa' => 1, 'faa_ord' => 1); delete $Expect{'fsl'} unless $symlink_exists; +%Expect_Dir = ('fa' => 1, 'faa' => 1, 'fab' => 1, 'faba' => 1, + 'fb' => 1, 'fba' => 1); +delete @Expect_Dir{'fb','fba'} unless $symlink_exists; File::Find::find( {wanted => \&wanted, },'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -113,6 +124,9 @@ Check( scalar(keys %Expect) == 0 ); 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); delete $Expect{'fa/fsl'} unless $symlink_exists; +%Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); +delete @Expect_Dir{'fb','fb/fba'} unless $symlink_exists; File::Find::find( {wanted => \&wanted, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -122,6 +136,9 @@ Check( scalar(keys %Expect) == 0 ); './fa/fab/faba/faba_ord' => 1, './fa/faa' => 1, './fa/faa/faa_ord' => 1, './fb' => 1, './fb/fba' => 1, './fb/fba/fba_ord' => 1, './fb/fb_ord' => 1); delete $Expect{'./fa/fsl'} unless $symlink_exists; +%Expect_Dir = ('./fa' => 1, './fa/faa' => 1, '/fa/fab' => 1, './fa/fab/faba' => 1, + './fb' => 1, './fb/fba' => 1); +delete @Expect_Dir{'./fb','./fb/fba'} unless $symlink_exists; File::Find::finddepth( {wanted => \&dn_wanted },'.' ); Check( scalar(keys %Expect) == 0 ); @@ -130,13 +147,19 @@ Check( scalar(keys %Expect) == 0 ); './fa/fab/faba/faba_ord' => 1, './fa/faa' => 1, './fa/faa/faa_ord' => 1, './fb' => 1, './fb/fba' => 1, './fb/fba/fba_ord' => 1, './fb/fb_ord' => 1); delete $Expect{'./fa/fsl'} unless $symlink_exists; +%Expect_Dir = ('./fa' => 1, './fa/faa' => 1, '/fa/fab' => 1, './fa/fab/faba' => 1, + './fb' => 1, './fb/fba' => 1); +delete @Expect_Dir{'./fb','./fb/fba'} unless $symlink_exists; File::Find::finddepth( {wanted => \&d_wanted, no_chdir => 1 },'.' ); Check( scalar(keys %Expect) == 0 ); if ( $symlink_exists ) { + $FastFileTests_OK= 1; %Expect=('.' => 1, 'fa_ord' => 1, 'fsl' => 1, 'fb_ord' => 1, 'fba' => 1, 'fba_ord' => 1, 'fab' => 1, 'fab_ord' => 1, 'faba' => 1, 'faa' => 1, 'faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::find( {wanted => \&wanted, follow_fast => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -145,6 +168,8 @@ if ( $symlink_exists ) { 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -152,6 +177,8 @@ if ( $symlink_exists ) { 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::finddepth( {wanted => \&dn_wanted, follow_fast => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -160,6 +187,8 @@ if ( $symlink_exists ) { 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::finddepth( {wanted => \&d_wanted, follow_fast => 1, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); diff --git a/t/lib/ftmp-mktemp.t b/t/lib/ftmp-mktemp.t index c660475709..35ab59cbb3 100755 --- a/t/lib/ftmp-mktemp.t +++ b/t/lib/ftmp-mktemp.t @@ -1,16 +1,16 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} +#!/usr/bin/perl -w # Test for mktemp family of commands in File::Temp # Use STANDARD safe level for these tests +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 9); +} + use strict; -use Test; -BEGIN { plan tests => 9 } use File::Spec; use File::Path; @@ -50,6 +50,7 @@ ok($string, $line); # stat(filehandle) does not always equal the size of the stat(filename) # This must be due to caching. In particular this test writes 7 bytes # to the file which are not recognised by stat(filename) +# Simply waiting 3 seconds seems to be enough for the system to update if ($^O eq 'MSWin32') { sleep 3; @@ -69,8 +70,15 @@ print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n"; # Check if the file exists ok( (-e $fname) ); -ok( unlink0($fh, $fname) ); +# This fails if you are running on NFS +# If this test fails simply skip it rather than doing a hard failure +my $status = unlink0($fh, $fname); +if ($status) { + ok($status); +} else { + skip("Skip test failed probably due to NFS",1) +} # MKDTEMP # Temp directory diff --git a/t/lib/ftmp-posix.t b/t/lib/ftmp-posix.t index f28785e87a..6802374b10 100755 --- a/t/lib/ftmp-posix.t +++ b/t/lib/ftmp-posix.t @@ -1,15 +1,14 @@ -#!./perl +#!/usr/bin/perl -w +# Test for File::Temp - POSIX functions BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 7); } -# Test for File::Temp - POSIX functions - use strict; -use Test; -BEGIN { plan tests => 7} use File::Temp qw/ :POSIX unlink0 /; ok(1); diff --git a/t/lib/ftmp-security.t b/t/lib/ftmp-security.t index 50e177958a..5f30f9651f 100755 --- a/t/lib/ftmp-security.t +++ b/t/lib/ftmp-security.t @@ -1,26 +1,31 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} - +#!/usr/bin/perl -w # Test for File::Temp - Security levels # Some of the security checking will not work on all platforms # Test a simple open in the cwd and tmpdir foreach of the # security levels -use strict; -use Test; -BEGIN { plan tests => 13} +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 13); +} +use strict; use File::Spec; + +# Set up END block - this needs to happen before we load +# File::Temp since this END block must be evaluated after the +# END block configured by File::Temp +my @files; # list of files to remove +END { foreach (@files) { ok( !(-e $_) )} } + use File::Temp qw/ tempfile unlink0 /; ok(1); # The high security tests must currently be skipped on Windows -my $skipplat = ( $^O eq 'MSWin32' ? 1 : 0 ); +my $skipplat = ( ($^O eq 'MSWin32' || $^O eq 'os2') ? 1 : 0 ); # Can not run high security tests in perls before 5.6.0 my $skipperl = ($] < 5.006 ? 1 : 0 ); @@ -77,27 +82,17 @@ sub test_security { # of tests -- we dont use skip since the tempfile() commands will # fail with MEDIUM/HIGH security before the skip() command would be run if ($skip) { - + skip($skip,1); skip($skip,1); - + # plus we need an end block so the tests come out in the right order eval q{ END { skip($skip,1); skip($skip,1) } 1; } || die; - + return; } - - # End blocks are evaluated in reverse order - # If I want to check that the file was unlinked by the autmoatic - # feature of the module I have to set up the end block before - # creating the file. - # Use quoted end block to retain access to lexicals - my @files; - - eval q{ END { foreach (@files) { ok( !(-e $_) )} } 1; } || die; - - + # Create the tempfile my $template = "temptestXXXXXXXX"; my ($fh1, $fname1) = tempfile ( $template, DIR => File::Spec->curdir, diff --git a/t/lib/ftmp-tempfile.t b/t/lib/ftmp-tempfile.t index 9c0de8b955..3cb73c20e0 100755 --- a/t/lib/ftmp-tempfile.t +++ b/t/lib/ftmp-tempfile.t @@ -1,30 +1,35 @@ -#!./perl +#!/usr/bin/perl -w +# Test for File::Temp - tempfile function BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 11); } -# Test for File::Temp - tempfile function - use strict; -use Test; -BEGIN { plan tests => 10} use File::Spec; -use File::Temp qw/ tempfile tempdir/; # Will need to check that all files were unlinked correctly -# Set up an END block here to do it (since the END blocks -# set up by File::Temp will be evaluated in reverse order we -# set ours up first.... +# Set up an END block here to do it + +my (@files, @dirs); # Array containing list of dirs/files to test # Loop over an array hoping that the files dont exist -my @files; -eval q{ END { foreach (@files) { ok( !(-e $_) )} } 1; } || die; +END { foreach (@files) { ok( !(-e $_) )} } # And a test for directories -my @dirs; -eval q{ END { foreach (@dirs) { ok( !(-d $_) )} } 1; } || die; +END { foreach (@dirs) { ok( !(-d $_) )} } + +# Need to make sure that the END blocks are setup before +# the ones that File::Temp configures since END blocks are evaluated +# in revers order and we need to check the files *after* File::Temp +# removes them +use File::Temp qw/ tempfile tempdir/; + +# Now we start the tests properly +ok(1); # Tempfile @@ -88,5 +93,5 @@ print "# TEMPFILE: Created $tempfile\n"; ok( (-f $tempfile) ); push(@files, $tempfile); -# no tests yet to make sure that the END{} blocks correctly remove -# the files +# Now END block will execute to test the removal of directories + diff --git a/t/lib/hostname.t b/t/lib/hostname.t index 6f61fb9dad..8a34e9c4e7 100755 --- a/t/lib/hostname.t +++ b/t/lib/hostname.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bSys\/Hostname\b/) { + print "1..0 # Skip: Sys::Hostname was not built\n"; + exit 0; + } } use Sys::Hostname; diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t index a4f3e3f367..d2991e3eac 100755 --- a/t/lib/ipc_sysv.t +++ b/t/lib/ipc_sysv.t @@ -9,7 +9,9 @@ BEGIN { my $reason; - if ($Config{'d_sem'} ne 'define') { + if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) { + $reason = 'IPC::SysV was not built'; + } elsif ($Config{'d_sem'} ne 'define') { $reason = '$Config{d_sem} undefined'; } elsif ($Config{'d_msg'} ne 'define') { $reason = '$Config{d_msg} undefined'; diff --git a/t/lib/peek.t b/t/lib/peek.t index 255512fac5..86fd74a3df 100644 --- a/t/lib/peek.t +++ b/t/lib/peek.t @@ -285,8 +285,6 @@ do_test(17, MG_VIRTUAL = &PL_vtbl_glob MG_TYPE = \'\\*\' MG_OBJ = $ADDR - MG_LEN = 1 - MG_PTR = $ADDR "a" NAME = "a" NAMELEN = 1 GvSTASH = $ADDR\\t"main" diff --git a/t/lib/selfloader.t b/t/lib/selfloader.t new file mode 100755 index 0000000000..75d6561f9b --- /dev/null +++ b/t/lib/selfloader.t @@ -0,0 +1,200 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + $dir = "self-$$"; + unshift @INC, ("./$dir", "../lib"); + + print "1..19\n"; + + # First we must set up some selfloader files + mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; + + open(FOO, ">$dir/Foo.pm") or die; + print FOO <<'EOT'; +package Foo; +use SelfLoader; + +sub new { bless {}, shift } +sub foo; +sub bar; +sub bazmarkhianish; +sub a; +sub never; # declared but definition should never be read +1; +__DATA__ + +sub foo { shift; shift || "foo" }; + +sub bar { shift; shift || "bar" } + +sub bazmarkhianish { shift; shift || "baz" } + +package sheep; +sub bleat { shift; shift || "baa" } + +__END__ +sub never { die "D'oh" } +EOT + + close(FOO); + + open(BAR, ">$dir/Bar.pm") or die; + print BAR <<'EOT'; +package Bar; +use SelfLoader; + +@ISA = 'Baz'; + +sub new { bless {}, shift } +sub a; + +1; +__DATA__ + +sub a { 'a Bar'; } +sub b { 'b Bar' } + +__END__ DATA +sub never { die "D'oh" } +EOT + + close(BAR); +}; + + +package Baz; + +sub a { 'a Baz' } +sub b { 'b Baz' } +sub c { 'c Baz' } + + +package main; +use Foo; +use Bar; + +$foo = new Foo; + +print "not " unless $foo->foo eq 'foo'; # selfloaded first time +print "ok 1\n"; + +print "not " unless $foo->foo eq 'foo'; # regular call +print "ok 2\n"; + +# Try an undefined method +eval { + $foo->will_fail; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 3\n"; +} else { + print "not ok 3 $@\n"; +} + +# Used to be trouble with this +eval { + my $foo = new Foo; + die "oops"; +}; +if ($@ =~ /oops/) { + print "ok 4\n"; +} else { + print "not ok 4 $@\n"; +} + +# Pass regular expression variable to autoloaded function. This used +# to go wrong in AutoLoader because it used regular expressions to generate +# autoloaded filename. +"foo" =~ /(\w+)/; +print "not " unless $1 eq 'foo'; +print "ok 5\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 6\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 7\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 8\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 9\n"; + +# Check nested packages inside __DATA__ +print "not " unless sheep::bleat() eq 'baa'; +print "ok 10\n"; + +# Now check inheritance: + +$bar = new Bar; + +# Before anything is SelfLoaded there is no declaration of Foo::b so we should +# get Baz::b +print "not " unless $bar->b() eq 'b Baz'; +print "ok 11\n"; + +# There is no Bar::c so we should get Baz::c +print "not " unless $bar->c() eq 'c Baz'; +print "ok 12\n"; + +# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side +# effect +print "not " unless $bar->a() eq 'a Bar'; +print "ok 13\n"; + +print "not " unless $bar->b() eq 'b Bar'; +print "ok 14\n"; + +print "not " unless $bar->c() eq 'c Baz'; +print "ok 15\n"; + + + +# Check that __END__ is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $foo->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 16\n"; +} else { + print "not ok 16 $@\n"; +} + +# Try to read from the data file handle +my $foodata = <Foo::DATA>; +close Foo::DATA; +if (defined $foodata) { + print "not ok 17 # $foodata\n"; +} else { + print "ok 17\n"; +} + +# Check that __END__ DATA is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $bar->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 18\n"; +} else { + print "not ok 18 $@\n"; +} + +# Try to read from the data file handle +my $bardata = <Bar::DATA>; +close Bar::DATA; +if ($bardata ne "sub never { die \"D'oh\" }\n") { + print "not ok 19 # $bardata\n"; +} else { + print "ok 19\n"; +} + +# cleanup +END { +return unless $dir && -d $dir; +unlink "$dir/Foo.pm", "$dir/Bar.pm"; +rmdir "$dir"; +} diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index 2857120942..3cfe3022da 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -8,7 +8,7 @@ BEGIN { require Config; import Config; # Don't bother if there are no quad offsets. if ($Config{lseeksize} < 8) { - print "1..0\n# no 64-bit file offsets\n"; + print "1..0 # Skip: no 64-bit file offsets\n"; exit(0); } require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/); @@ -47,14 +47,14 @@ print "# checking whether we have sparse files...\n"; # Known have-nots. if ($^O eq 'win32' || $^O eq 'vms') { - print "1..0\n# no sparse files (because this is $^O) \n"; + print "1..0 # Skip: no sparse files (because this is $^O) \n"; bye(); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0\n# large files known to work but unable to test them here ($^O)\n"; + print "1..0 # Skip: large files known to work but unable to test them here ($^O)\n"; bye(); } @@ -95,7 +95,7 @@ zap(); unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && $s1[11] == $s2[11] && $s1[12] == $s2[12]) { - print "1..0\n#no sparse files?\n"; + print "1..0 # Skip: no sparse files?\n"; bye; } @@ -103,15 +103,25 @@ print "# we seem to have sparse files...\n"; # By now we better be sure that we do have sparse files: # if we are not, the following will hog 5 gigabytes of disk. Ooops. +# This may fail by producing some signal; run in a subprocess first for safety $ENV{LC_ALL} = "C"; +my $r = system '../perl', '-I../lib', '-e', <<'EOF'; +use Fcntl qw(/^O_/ /^SEEK_/); +sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!; +my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); +my $syswrite = syswrite(BIG, "big"); +exit 0; +EOF + sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or do { warn "sysopen 'big' failed: $!\n"; bye }; my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); -unless (defined $sysseek && $sysseek == 5_000_000_000) { - print "1..0\n# seeking past 2GB failed: $! (sysseek returned ", - defined $sysseek ? $sysseek : 'undef', ")\n"; +unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) { + $sysseek = 'undef' unless defined $sysseek; + print "1..0 # Skip: seeking past 2GB failed: ", + $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)", "\n"; explain(); bye(); } @@ -125,9 +135,9 @@ my $close = close BIG; print "# close failed: $!\n" unless $close; unless($syswrite && $close) { if ($! =~/too large/i) { - print "1..0\n# writing past 2GB failed: process limits?\n"; + print "1..0 # Skip: writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { - print "1..0\n# filesystem quota limits?\n"; + print "1..0 # Skip: filesystem quota limits?\n"; } explain(); bye(); @@ -138,7 +148,7 @@ unless($syswrite && $close) { print "# @s\n"; unless ($s[7] == 5_000_000_003) { - print "1..0\n# not configured to use large files?\n"; + print "1..0 # Skip: not configured to use large files?\n"; explain(); bye(); } diff --git a/t/op/64bitint.t b/t/op/64bitint.t index f59c953825..691d44e240 100644 --- a/t/op/64bitint.t +++ b/t/op/64bitint.t @@ -123,85 +123,106 @@ $x = $q - $r; print "not " unless $x == -11111110111 && -$x > $f; print "ok 22\n"; -$x = $q * 1234567; -print "not " unless $x == 15241567763770867 && $x > $f; -print "ok 23\n"; - -$x /= 1234567; -print "not " unless $x == $q && $x > $f; -print "ok 24\n"; - -$x = 98765432109 % 12345678901; -print "not " unless $x == 901; -print "ok 25\n"; - -# The following 12 tests adapted from op/inc. - -$a = 9223372036854775807; -$c = $a++; -print "not " unless $a == 9223372036854775808; -print "ok 26\n"; - -$a = 9223372036854775807; -$c = ++$a; -print "not " unless $a == 9223372036854775808 && $c == $a; -print "ok 27\n"; - -$a = 9223372036854775807; -$c = $a + 1; -print "not " unless $a == 9223372036854775807 && $c == 9223372036854775808; -print "ok 28\n"; - -$a = -9223372036854775808; -$c = $a--; -print "not " unless $a == -9223372036854775809 && $c == -9223372036854775808; -print "ok 29\n"; - -$a = -9223372036854775808; -$c = --$a; -print "not " unless $a == -9223372036854775809 && $c == $a; -print "ok 30\n"; - -$a = -9223372036854775808; -$c = $a - 1; -print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809; -print "ok 31\n"; - -$a = 9223372036854775808; -$a = -$a; -$c = $a--; -print "not " unless $a == -9223372036854775809 && $c == -9223372036854775808; -print "ok 32\n"; - -$a = 9223372036854775808; -$a = -$a; -$c = --$a; -print "not " unless $a == -9223372036854775809 && $c == $a; -print "ok 33\n"; - -$a = 9223372036854775808; -$a = -$a; -$c = $a - 1; -print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809; -print "ok 34\n"; - -$a = 9223372036854775808; -$b = -$a; -$c = $b--; -print "not " unless $b == -$a-1 && $c == -$a; -print "ok 35\n"; - -$a = 9223372036854775808; -$b = -$a; -$c = --$b; -print "not " unless $b == -$a-1 && $c == $b; -print "ok 36\n"; - -$a = 9223372036854775808; -$b = -$a; -$b = $b - 1; -print "not " unless $b == -(++$a); -print "ok 37\n"; +if ($^O ne 'unicos') { + $x = $q * 1234567; + print "not " unless $x == 15241567763770867 && $x > $f; + print "ok 23\n"; + + $x /= 1234567; + print "not " unless $x == $q && $x > $f; + print "ok 24\n"; + + $x = 98765432109 % 12345678901; + print "not " unless $x == 901; + print "ok 25\n"; + + # The following 12 tests adapted from op/inc. + + $a = 9223372036854775807; + $c = $a++; + print "not " unless $a == 9223372036854775808; + print "ok 26\n"; + + $a = 9223372036854775807; + $c = ++$a; + print "not " + unless $a == 9223372036854775808 && $c == $a; + print "ok 27\n"; + + $a = 9223372036854775807; + $c = $a + 1; + print "not " + unless $a == 9223372036854775807 && $c == 9223372036854775808; + print "ok 28\n"; + + $a = -9223372036854775808; + $c = $a--; + print "not " + unless $a == -9223372036854775809 && $c == -9223372036854775808; + print "ok 29\n"; + + $a = -9223372036854775808; + $c = --$a; + print "not " + unless $a == -9223372036854775809 && $c == $a; + print "ok 30\n"; + + $a = -9223372036854775808; + $c = $a - 1; + print "not " + unless $a == -9223372036854775808 && $c == -9223372036854775809; + print "ok 31\n"; + + $a = 9223372036854775808; + $a = -$a; + $c = $a--; + print "not " + unless $a == -9223372036854775809 && $c == -9223372036854775808; + print "ok 32\n"; + + $a = 9223372036854775808; + $a = -$a; + $c = --$a; + print "not " + unless $a == -9223372036854775809 && $c == $a; + print "ok 33\n"; + + $a = 9223372036854775808; + $a = -$a; + $c = $a - 1; + print "not " + unless $a == -9223372036854775808 && $c == -9223372036854775809; + print "ok 34\n"; + + $a = 9223372036854775808; + $b = -$a; + $c = $b--; + print "not " + unless $b == -$a-1 && $c == -$a; + print "ok 35\n"; + + $a = 9223372036854775808; + $b = -$a; + $c = --$b; + print "not " + unless $b == -$a-1 && $c == $b; + print "ok 36\n"; + + $a = 9223372036854775808; + $b = -$a; + $b = $b - 1; + print "not " + unless $b == -(++$a); + print "ok 37\n"; + +} else { + # Unicos has imprecise doubles (14 decimal digits or so), + # especially if operating near the UV/IV limits the low-order bits + # become mangled even by simple arithmetic operations. + for (23..37) { + print "ok #_ # skipped: too imprecise numbers\n"; + } +} $x = ''; @@ -233,17 +254,23 @@ print "ok 45\n"; print "not " unless (0x8000000000000000 | 1) == 0x8000000000000001; print "ok 46\n"; -print "not " unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000; +print "not " + unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000; print "ok 47\n"; -print "not " unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0; +print "not " + unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0; print "ok 48\n"; -print "not " unless (sprintf "%b", ~0) eq '1111111111111111111111111111111111111111111111111111111111111111'; +print "not " + unless (sprintf "%b", ~0) eq + '1111111111111111111111111111111111111111111111111111111111111111'; print "ok 49\n"; -print "not " unless (sprintf "%64b", ~0) eq '1111111111111111111111111111111111111111111111111111111111111111'; +print "not " + unless (sprintf "%64b", ~0) eq + '1111111111111111111111111111111111111111111111111111111111111111'; print "ok 50\n"; print "not " unless (sprintf "%d", ~0>>1) eq '9223372036854775807'; diff --git a/t/op/args.t b/t/op/args.t index 48bf5afec0..ce2c398865 100755 --- a/t/op/args.t +++ b/t/op/args.t @@ -1,6 +1,6 @@ #!./perl -print "1..8\n"; +print "1..9\n"; # test various operations on @_ @@ -52,3 +52,24 @@ sub new4 { goto &new2 } print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y"; print "ok $ord\n"; } + +# see if POPSUB gets to see the right pad across a dounwind() with +# a reified @_ + +sub methimpl { + my $refarg = \@_; + die( "got: @_\n" ); +} + +sub method { + &methimpl; +} + +sub try { + eval { method('foo', 'bar'); }; + print "# $@" if $@; +} + +for (1..5) { try() } +++$ord; +print "ok $ord\n"; diff --git a/t/op/arith.t b/t/op/arith.t index fe2f0f458b..5b04f9365f 100755 --- a/t/op/arith.t +++ b/t/op/arith.t @@ -1,6 +1,6 @@ #!./perl -print "1..8\n"; +print "1..12\n"; sub try ($$) { print +($_[1] ? "ok" : "not ok"), " $_[0]\n"; @@ -21,3 +21,10 @@ try 5, abs( 13e21 % 4e21 - 1e21) < $limit; try 6, abs(-13e21 % 4e21 - 3e21) < $limit; try 7, abs( 13e21 % -4e21 - -3e21) < $limit; try 8, abs(-13e21 % -4e21 - -1e21) < $limit; + +# UVs should behave properly + +try 9, 4063328477 % 65535 == 27407; +try 10, 4063328477 % 4063328476 == 1; +try 11, 4063328477 % 2031664238 == 1; +try 12, 2031664238 % 4063328477 == 2031664238; @@ -21,18 +21,18 @@ print "1..15\n"; $_[0] = "not ok 1\n"; $result = do foo1("ok 1\n"); print "#2\t:$result: eq :value:\n"; -if ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; } -if ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; } +if ($result eq 'value') { print "ok 2\n"; } else { print "not ok 2\n"; } +if ($_[0] eq "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; } $_[0] = "not ok 4\n"; $result = do foo2("not ok 4\n","ok 4\n","not ok 4\n"); print "#5\t:$result: eq :value:\n"; -if ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; } -if ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; } +if ($result eq 'value') { print "ok 5\n"; } else { print "not ok 5\n"; } +if ($_[0] eq "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; } $result = do{print "ok 7\n"; 'value';}; print "#8\t:$result: eq :value:\n"; -if ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; } +if ($result eq 'value') { print "ok 8\n"; } else { print "not ok 8\n"; } sub blather { print @_; @@ -11,7 +11,7 @@ BEGIN { use warnings; -print "1..30\n"; +print "1..41\n"; # type coersion on assignment $foo = 'foo'; @@ -97,15 +97,19 @@ $x = "ok 17\n"; %x = ("ok 19" => "\n"); sub x { "ok 20\n" } print ${*x{SCALAR}}, @{*x{ARRAY}}, %{*x{HASH}}, &{*x{CODE}}; +format x = +ok 21 +. +print ref *x{FORMAT} eq "FORMAT" ? "ok 21\n" : "not ok 21\n"; *x = *STDOUT; -print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 21\n" : "not ok 21\n"; -print {*x{IO}} "ok 22\n"; -print {*x{FILEHANDLE}} "ok 23\n"; +print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 22\n" : "not ok 22\n"; +print {*x{IO}} "ok 23\n"; +print {*x{FILEHANDLE}} "ok 24\n"; # test if defined() doesn't create any new symbols { - my $test = 23; + my $test = 24; my $a = "SYM000"; print "not " if defined *{$a}; @@ -128,6 +132,42 @@ print {*x{FILEHANDLE}} "ok 23\n"; ++$test; &{$a}; } +# although it *should* if you're talking about magicals + +{ + my $test = 30; + + my $a = "]"; + print "not " unless defined ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; + + $a = "1"; + "o" =~ /(o)/; + print "not " unless ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; + $a = "2"; + print "not " if ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; + $a = "1x"; + print "not " if defined ${$a}; + ++$test; print "ok $test\n"; + print "not " if defined *{$a}; + ++$test; print "ok $test\n"; + $a = "11"; + "o" =~ /(((((((((((o)))))))))))/; + print "not " unless ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; +} + + # does pp_readline() handle glob-ness correctly? { @@ -137,4 +177,4 @@ print {*x{FILEHANDLE}} "ok 23\n"; } __END__ -ok 30 +ok 41 diff --git a/t/op/lfs.t b/t/op/lfs.t index e704f6f57b..97c920c2cf 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -8,7 +8,7 @@ BEGIN { # Don't bother if there are no quad offsets. require Config; import Config; if ($Config{lseeksize} < 8) { - print "1..0\n# no 64-bit file offsets\n"; + print "1..0 # Skip: no 64-bit file offsets\n"; exit(0); } } @@ -46,14 +46,14 @@ print "# checking whether we have sparse files...\n"; # Known have-nots. if ($^O eq 'win32' || $^O eq 'vms') { - print "1..0\n# no sparse files (because this is $^O) \n"; + print "1..0 # Skip: no sparse files (because this is $^O) \n"; bye(); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0\n# large files known to work but unable to test them here ($^O)\n"; + print "1..0 # Skip: large files known to work but unable to test them here ($^O)\n"; bye(); } @@ -102,7 +102,7 @@ zap(); unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && $s1[11] == $s2[11] && $s1[12] == $s2[12]) { - print "1..0\n#no sparse files?\n"; + print "1..0 # Skip: no sparse files?\n"; bye; } @@ -110,13 +110,22 @@ print "# we seem to have sparse files...\n"; # By now we better be sure that we do have sparse files: # if we are not, the following will hog 5 gigabytes of disk. Ooops. +# This may fail by producing some signal; run in a subprocess first for safety $ENV{LC_ALL} = "C"; +my $r = system '../perl', '-e', <<'EOF'; +open(BIG, ">big"); +seek(BIG, 5_000_000_000, 0); +print BIG "big"; +exit 0; +EOF + open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; binmode BIG; -unless (seek(BIG, 5_000_000_000, $SEEK_SET)) { - print "1..0\n# seeking past 2GB failed: $!\n"; +if ($r or not seek(BIG, 5_000_000_000, $SEEK_SET)) { + my $err = $r ? 'signal '.($r & 0x7f) : $!; + print "1..0 # Skip: seeking past 2GB failed: $err\n"; explain(); bye(); } @@ -129,9 +138,9 @@ my $close = close BIG; print "# close failed: $!\n" unless $close; unless ($print && $close) { if ($! =~/too large/i) { - print "1..0\n# writing past 2GB failed: process limits?\n"; + print "1..0 # Skip: writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { - print "1..0\n# filesystem quota limits?\n"; + print "1..0 # Skip: filesystem quota limits?\n"; } explain(); bye(); @@ -142,7 +151,7 @@ unless ($print && $close) { print "# @s\n"; unless ($s[7] == 5_000_000_003) { - print "1..0\n# not configured to use large files?\n"; + print "1..0 # Skip: not configured to use large files?\n"; explain(); bye(); } diff --git a/t/op/method.t b/t/op/method.t index 1c6f3c5d9d..6e25310734 100755 --- a/t/op/method.t +++ b/t/op/method.t @@ -4,7 +4,12 @@ # test method calls and autoloading. # -print "1..49\n"; +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib' if -d '../lib'; +} + +print "1..53\n"; @A::ISA = 'B'; @B::ISA = 'C'; @@ -167,3 +172,16 @@ test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1); test(A2->foo(), "foo"); } + +{ + test(do { use Config; eval 'Config->foo()'; + $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); + test(do { use Config; eval '$d = bless {}, "Config"; $d->foo()'; + $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); +} + +test(do { eval 'E->foo()'; + $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1); +test(do { eval '$e = bless {}, "E"; $e->foo()'; + $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1); + diff --git a/t/op/misc.t b/t/op/misc.t index 55f459d49b..00abc99b45 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -558,3 +558,7 @@ eval "C"; M(C); EXPECT Modification of a read-only value attempted at - line 2. +######## +print qw(ab a\b a\\b); +EXPECT +aba\ba\b diff --git a/t/op/my_stash.t b/t/op/my_stash.t new file mode 100644 index 0000000000..79f3f28a08 --- /dev/null +++ b/t/op/my_stash.t @@ -0,0 +1,31 @@ +#!./perl + +package Foo; + +BEGIN { + unshift @INC, "../lib"; +} + +use Test; + +plan tests => 7; + +use constant MyClass => 'Foo::Bar::Biz::Baz'; + +{ + package Foo::Bar::Biz::Baz; +} + +for (qw(Foo Foo:: MyClass __PACKAGE__)) { + eval "sub { my $_ \$obj = shift; }"; + ok ! $@; +# print $@ if $@; +} + +use constant NoClass => 'Nope::Foo::Bar::Biz::Baz'; + +for (qw(Nope Nope:: NoClass)) { + eval "sub { my $_ \$obj = shift; }"; + ok $@; +# print $@ if $@; +} diff --git a/t/op/numconvert.t b/t/op/numconvert.t index 8eb9b6e341..f3c9867a91 100755 --- a/t/op/numconvert.t +++ b/t/op/numconvert.t @@ -51,7 +51,13 @@ my $big_iv = do {use integer; $max_uv1 * 16}; # 16 is an arbitrary number here print "# max_uv1 = $max_uv1, max_uv2 = $max_uv2, big_iv = $big_iv\n"; if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) { - print "1..0\n# Unsigned arithmetic is not sane\n"; + print "1..0 # skipped: unsigned perl arithmetic is not sane"; + eval { require Config; import Config }; + use vars qw(%Config); + if ($Config{d_quad} eq 'define') { + print " (common in 64-bit platforms)"; + } + print "\n"; exit 0; } diff --git a/t/op/pack.t b/t/op/pack.t index dda1cc76d7..5c215c6f0f 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..156\n"; +print "1..159\n"; $format = "c2 x5 C C x s d i l a6"; # Need the expression in here to force ary[5] to be numeric. This avoids @@ -406,3 +406,13 @@ $z = pack <<EOP,'string','etc'; w/A* # Count a BER integer EOP print 'not ' unless $z eq "\000\006string\003etc"; print "ok $test\n"; $test++; + +print 'not ' unless "1.20.300.4000" eq sprintf "%vd", pack("U*",1,20,300,4000); +print "ok $test\n"; $test++; +print 'not ' unless "1.20.300.4000" eq + sprintf "%vd", pack(" U*",1,20,300,4000); +print "ok $test\n"; $test++; +print 'not ' unless v1.20.300.4000 ne + sprintf "%vd", pack("C0U*",1,20,300,4000); +print "ok $test\n"; $test++; + diff --git a/t/op/pat.t b/t/op/pat.t index e00328c91f..81591fc71b 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -4,7 +4,7 @@ # the format supported by op/regexp.t. If you want to add a test # that does fit that format, add it to op/re_tests, not here. -print "1..213\n"; +print "1..215\n"; BEGIN { chdir 't' if -d 't'; @@ -1012,3 +1012,12 @@ EOE $a and $a =~ /^Object\sS/ or print "# '$a' \nnot "; print "ok $test\n"; $test++; + +# test result of match used as match (!) +'a1b' =~ ('xyz' =~ /y/) and $` eq 'a' or print "not "; +print "ok $test\n"; +$test++; + +'a1b' =~ ('xyz' =~ /t/) and $` eq 'a' or print "not "; +print "ok $test\n"; +$test++; diff --git a/t/op/re_tests b/t/op/re_tests index 189077c628..38483253d3 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -750,4 +750,28 @@ tt+$ xxxtt y - - ^([a-z]:) C:/ n - - '^\S\s+aa$'m \nx aa y - - (^|a)b ab y - - +^([ab]*?)(b)?(c)$ abac y -$2- -- +(\w)?(abc)\1b abcab n - - +^(?:.,){2}c a,b,c y - - +^(.,){2}c a,b,c y $1 b, +^(?:[^,]*,){2}c a,b,c y - - +^([^,]*,){2}c a,b,c y $1 b, +^([^,]*,){3}d aaa,b,c,d y $1 c, +^([^,]*,){3,}d aaa,b,c,d y $1 c, +^([^,]*,){0,3}d aaa,b,c,d y $1 c, +^([^,]{1,3},){3}d aaa,b,c,d y $1 c, +^([^,]{1,3},){3,}d aaa,b,c,d y $1 c, +^([^,]{1,3},){0,3}d aaa,b,c,d y $1 c, +^([^,]{1,},){3}d aaa,b,c,d y $1 c, +^([^,]{1,},){3,}d aaa,b,c,d y $1 c, +^([^,]{1,},){0,3}d aaa,b,c,d y $1 c, +^([^,]{0,3},){3}d aaa,b,c,d y $1 c, +^([^,]{0,3},){3,}d aaa,b,c,d y $1 c, +^([^,]{0,3},){0,3}d aaa,b,c,d y $1 c, (?i) y - - +'(?!\A)x'm a\nxb\n y - - +^(a(b)?)+$ aba y -$1-$2- -a-- +^(aa(bb)?)+$ aabbaa y -$1-$2- -aa-- +'^.{9}abc.*\n'm 123\nabcabcabcabc\n y - - +^(a)?a$ a y -$1- -- +^(a)?(?(1)a|b)+$ a n - - diff --git a/t/op/runlevel.t b/t/op/runlevel.t index e988ad9362..3865e52070 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -349,3 +349,18 @@ A 1 bar B 2 bar +######## +sub n { 0 } +sub f { my $x = shift; d(); } +f(n()); +f(); + +sub d { + my $i = 0; my @a; + while (do { { package DB; @a = caller($i++) } } ) { + @a = @DB::args; + for (@a) { print "$_\n"; $_ = '' } + } +} +EXPECT +0 diff --git a/t/op/split.t b/t/op/split.t index 8b9f4ad2f9..78f51f5954 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -2,7 +2,7 @@ # $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $ -print "1..25\n"; +print "1..27\n"; $FS = ':'; @@ -109,3 +109,12 @@ print $_ eq "aa b |\naa d |" ? "ok 24\n" : "not ok 24\n# `$_'\n"; $_ = "a : b :c: d"; @ary = split(/\s*:\s*/); if (($res = join(".",@ary)) eq "a.b.c.d") {print "ok 25\n";} else {print "not ok 25\n# res=`$res' != `a.b.c.d'\n";} + +# use of match result as pattern (!) +'p:q:r:s' eq join ':', split('abc' =~ /b/, 'p1q1r1s') or print "not "; +print "ok 26\n"; + +# /^/ treated as /^/m +$_ = join ':', split /^/, "ab\ncd\nef\n"; +print "not " if $_ ne "ab\n:cd\n:ef\n"; +print "ok 27\n"; diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 4d54d2c317..c48435592d 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -1,6 +1,10 @@ #!./perl -# $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $ +# Tests sprintf, excluding handling of 64-bit integers or long +# doubles (if supported), of machine-specific short and long +# integers, machine-specific floating point exceptions (infinity, +# not-a-number ...), of the effects of locale, and of features +# specific to multi-byte characters (under use utf8 and such). BEGIN { chdir 't' if -d 't'; @@ -8,31 +12,273 @@ BEGIN { } use warnings; -print "1..4\n"; +while (<DATA>) { + s/^\s*>//; s/<\s*$//; + push @tests, [split(/<\s*>/, $_, 4)]; +} + +print '1..', scalar @tests, "\n"; $SIG{__WARN__} = sub { if ($_[0] =~ /^Invalid conversion/) { - $w++; + $w = ' INVALID' } else { warn @_; } }; -$w = 0; -$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f %b %x %X %#b %#x %#X","hi",123,0,456,0,ord('A'),3.0999,11,171,171,11,171,171); -if ($x eq ' hi 123 %foo 456 0A3.1 1011 ab AB 0b1011 0xab 0XAB' && $w == 0) { - print "ok 1\n"; -} else { - print "not ok 1 '$x'\n"; -} +for ($i = 1; @tests; $i++) { + ($template, $data, $result, $comment) = @{shift @tests}; + $evalData = eval $data; + $w = undef; + $x = sprintf(">$template<", + defined @$evalData ? @$evalData : $evalData); + substr($x, -1, 0) = $w if $w; + # $x may have 3 exponent digits, not 2 + my $y = $x; + if ($y =~ s/([Ee][-+])0(\d)/$1$2/) { + # if result is left-adjusted, append extra space + if ($template =~ /%\+?\-/ and $result =~ / $/) { + $y =~ s/<$/ </; + } + # if result is zero-filled, add extra zero + elsif ($template =~ /%\+?0/ and $result =~ /^0/) { + $y =~ s/^>0/>00/; + } + # if result is right-adjusted, prepend extra space + elsif ($result =~ /^ /) { + $y =~ s/^>/> /; + } + } -for $i (2 .. 4) { - $f = ('%6 .6s', '%6. 6s', '%6.6 s')[$i - 2]; - $w = 0; - $x = sprintf($f, ''); - if ($x eq $f && $w == 1) { - print "ok $i\n"; - } else { - print "not ok $i '$x' '$f' '$w'\n"; + if ($x eq ">$result<") { + print "ok $i\n"; + } + elsif ($y eq ">$result<") # Some C libraries always give + { # three-digit exponent + print("ok $i >$result< $x # three-digit exponent accepted\n"); + } + else { + $y = ($x eq $y ? "" : " => $y"); + print("not ok $i >$template< >$data< >$result< $x$y", + $comment ? " # $comment\n" : "\n"); } } + +# In each of the the following lines, there are three required fields: +# printf template, data to be formatted (as a Perl expression), and +# expected result of formatting. An optional fourth field can contain +# a comment. Each field is delimited by a starting '>' and a +# finishing '<'; any whitespace outside these start and end marks is +# not part of the field. If formatting requires more than one data +# item (for example, if variable field widths are used), the Perl data +# expression should return a reference to an array having the requisite +# number of elements. Even so, subterfuge is sometimes required: see +# tests for %n and %p. +# +# template data result +__END__ +>%6. 6s< >''< >%6. 6s INVALID< >(See use of $w in code above)< +>%6 .6s< >''< >%6 .6s INVALID< +>%6.6 s< >''< >%6.6 s INVALID< +>%A< >''< >%A INVALID< +>%B< >''< >%B INVALID< +>%C< >''< >%C INVALID< +>%D< >0x7fffffff< >2147483647< >Synonym for %ld< +>%E< >123456.789< >1.234568E+05< >Like %e, but using upper-case "E"< +>%F< >123456.789< >123456.789000< >Synonym for %f< +>%G< >1234567.89< >1.23457E+06< >Like %g, but using upper-case "E"< +>%G< >1234567e96< >1.23457E+102< +>%G< >.1234567e-101< >1.23457E-102< +>%G< >12345.6789< >12345.7< +>%H< >''< >%H INVALID< +>%I< >''< >%I INVALID< +>%J< >''< >%J INVALID< +>%K< >''< >%K INVALID< +>%L< >''< >%L INVALID< +>%M< >''< >%M INVALID< +>%N< >''< >%N INVALID< +>%O< >2**32-1< >37777777777< >Synonum for %lo< +>%P< >''< >%P INVALID< +>%Q< >''< >%Q INVALID< +>%R< >''< >%R INVALID< +>%S< >''< >%S INVALID< +>%T< >''< >%T INVALID< +>%U< >2**32-1< >4294967295< >Synonum for %lu< +>%V< >''< >%V INVALID< +>%W< >''< >%W INVALID< +>%X< >2**32-1< >FFFFFFFF< >Like %x, but with u/c letters< +>%#X< >2**32-1< >0XFFFFFFFF< +>%Y< >''< >%Y INVALID< +>%Z< >''< >%Z INVALID< +>%a< >''< >%a INVALID< +>%b< >2**32-1< >11111111111111111111111111111111< +>%+b< >2**32-1< >11111111111111111111111111111111< +>%#b< >2**32-1< >0b11111111111111111111111111111111< +>%34b< >2**32-1< > 11111111111111111111111111111111< +>%034b< >2**32-1< >0011111111111111111111111111111111< +>%-34b< >2**32-1< >11111111111111111111111111111111 < +>%-034b< >2**32-1< >11111111111111111111111111111111 < +>%c< >ord('A')< >A< +>%10c< >ord('A')< > A< +>%#10c< >ord('A')< > A< ># modifier: no effect< +>%010c< >ord('A')< >000000000A< +>%10lc< >ord('A')< > A< >l modifier: no effect< +>%10hc< >ord('A')< > A< >h modifier: no effect< +>%10.5c< >ord('A')< > A< >precision: no effect< +>%-10c< >ord('A')< >A < +>%d< >123456.789< >123456< +>%d< >-123456.789< >-123456< +>%d< >0< >0< +>%+d< >0< >+0< +>%0d< >0< >0< +>%.0d< >0< >< +>%+.0d< >0< >+< +>%.0d< >1< >1< +>%d< >1< >1< +>%+d< >1< >+1< +>%#3.2d< >1< > 01< ># modifier: no effect< +>%3.2d< >1< > 01< +>%03.2d< >1< >001< +>%-3.2d< >1< >01 < +>%-03.2d< >1< >01 < >zero pad + left just.: no effect< +>%d< >-1< >-1< +>%+d< >-1< >-1< +>%hd< >1< >1< >More extensive testing of< +>%ld< >1< >1< >length modifiers would be< +>%Vd< >1< >1< >platform-specific< +>%vd< >chr(1)< >1< +>%+vd< >chr(1)< >+1< +>%#vd< >chr(1)< >1< +>%vd< >"\01\02\03"< >1.2.3< +>%v.3d< >"\01\02\03"< >001.002.003< +>%v03d< >"\01\02\03"< >001.002.003< +>%v-3d< >"\01\02\03"< >1 .2 .3 < +>%v+-3d< >"\01\02\03"< >+1 .2 .3 < +>%v4.3d< >"\01\02\03"< > 001. 002. 003< +>%v04.3d< >"\01\02\03"< >0001.0002.0003< +>%*v02d< >['-', "\0\7\14"]< >00-07-12< +>%v.*d< >[3, "\01\02\03"]< >001.002.003< +>%v0*d< >[3, "\01\02\03"]< >001.002.003< +>%v-*d< >[3, "\01\02\03"]< >1 .2 .3 < +>%v+-*d< >[3, "\01\02\03"]< >+1 .2 .3 < +>%v*.*d< >[4, 3, "\01\02\03"]< > 001. 002. 003< +>%v0*.*d< >[4, 3, "\01\02\03"]< >0001.0002.0003< +>%*v0*d< >['-', 2, "\0\7\13"]< >00-07-11< +>%e< >1234.875< >1.234875e+03< +>%e< >0.000012345< >1.234500e-05< +>%e< >1234567E96< >1.234567e+102< +>%e< >0< >0.000000e+00< +>%e< >.1234567E-101< >1.234567e-102< +>%+e< >1234.875< >+1.234875e+03< +>%#e< >1234.875< >1.234875e+03< +>%e< >-1234.875< >-1.234875e+03< +>%+e< >-1234.875< >-1.234875e+03< +>%#e< >-1234.875< >-1.234875e+03< +>%.0e< >1234.875< >1e+03< +>%.*e< >[0, 1234.875]< >1e+03< +>%.1e< >1234.875< >1.2e+03< +>%-12.4e< >1234.875< >1.2349e+03 < +>%12.4e< >1234.875< > 1.2349e+03< +>%+-12.4e< >1234.875< >+1.2349e+03 < +>%+12.4e< >1234.875< > +1.2349e+03< +>%+-12.4e< >-1234.875< >-1.2349e+03 < +>%+12.4e< >-1234.875< > -1.2349e+03< +>%f< >1234.875< >1234.875000< +>%+f< >1234.875< >+1234.875000< +>%#f< >1234.875< >1234.875000< +>%f< >-1234.875< >-1234.875000< +>%+f< >-1234.875< >-1234.875000< +>%#f< >-1234.875< >-1234.875000< +>%6f< >1234.875< >1234.875000< +>%*f< >[6, 1234.875]< >1234.875000< +>%.0f< >1234.875< >1235< +>%.1f< >1234.875< >1234.9< +>%-8.1f< >1234.875< >1234.9 < +>%8.1f< >1234.875< > 1234.9< +>%+-8.1f< >1234.875< >+1234.9 < +>%+8.1f< >1234.875< > +1234.9< +>%+-8.1f< >-1234.875< >-1234.9 < +>%+8.1f< >-1234.875< > -1234.9< +>%*.*f< >[5, 2, 12.3456]< >12.35< +>%f< >0< >0.000000< +>%.0f< >0< >0< +>%.0f< >2**38< >274877906944< >Should have exact int'l rep'n< +>%.0f< >0.1< >0< +>%.0f< >-0.1< >-0< +>%.0f< >0.6< >1< +>%.0f< >-0.6< >-1< +>%g< >12345.6789< >12345.7< +>%+g< >12345.6789< >+12345.7< +>%#g< >12345.6789< >12345.7< +>%.0g< >12345.6789< >1e+04< +>%.2g< >12345.6789< >1.2e+04< +>%.*g< >[2, 12345.6789]< >1.2e+04< +>%.9g< >12345.6789< >12345.6789< +>%12.9g< >12345.6789< > 12345.6789< +>%012.9g< >12345.6789< >0012345.6789< +>%-12.9g< >12345.6789< >12345.6789 < +>%*.*g< >[-12, 9, 12345.6789]< >12345.6789 < +>%-012.9g< >12345.6789< >12345.6789 < +>%g< >-12345.6789< >-12345.7< +>%+g< >-12345.6789< >-12345.7< +>%g< >1234567.89< >1.23457e+06< +>%+g< >1234567.89< >+1.23457e+06< +>%#g< >1234567.89< >1.23457e+06< +>%g< >-1234567.89< >-1.23457e+06< +>%+g< >-1234567.89< >-1.23457e+06< +>%#g< >-1234567.89< >-1.23457e+06< +>%g< >0.00012345< >0.00012345< +>%g< >0.000012345< >1.2345e-05< +>%g< >1234567E96< >1.23457e+102< +>%g< >.1234567E-101< >1.23457e-102< +>%g< >0< >0< +>%13g< >1234567.89< > 1.23457e+06< +>%+13g< >1234567.89< > +1.23457e+06< +>%013g< >1234567.89< >001.23457e+06< +>%-13g< >1234567.89< >1.23457e+06 < +>%h< >''< >%h INVALID< +>%i< >123456.789< >123456< >Synonym for %d< +>%j< >''< >%j INVALID< +>%k< >''< >%k INVALID< +>%l< >''< >%l INVALID< +>%m< >''< >%m INVALID< +>%s< >sprintf('%%n%n %d', $n, $n)< >%n 2< >Slight sneakiness to test %n< +>%o< >2**32-1< >37777777777< +>%+o< >2**32-1< >37777777777< +>%#o< >2**32-1< >037777777777< +>%d< >$p=sprintf('%p',$p);$p=~/^[0-9a-f]+$/< >1< >Coarse hack: hex from %p?< +>%#p< >''< >%#p INVALID< +>%q< >''< >%q INVALID< +>%r< >''< >%r INVALID< +>%s< >'string'< >string< +>%10s< >'string'< > string< +>%+10s< >'string'< > string< +>%#10s< >'string'< > string< +>%010s< >'string'< >0000string< +>%0*s< >[10, 'string']< >0000string< +>%-10s< >'string'< >string < +>%3s< >'string'< >string< +>%.3s< >'string'< >str< +>%.*s< >[3, 'string']< >str< +>%t< >''< >%t INVALID< +>%u< >2**32-1< >4294967295< +>%+u< >2**32-1< >4294967295< +>%#u< >2**32-1< >4294967295< +>%12u< >2**32-1< > 4294967295< +>%012u< >2**32-1< >004294967295< +>%-12u< >2**32-1< >4294967295 < +>%-012u< >2**32-1< >4294967295 < +>%v< >''< >%v INVALID< +>%w< >''< >%w INVALID< +>%x< >2**32-1< >ffffffff< +>%+x< >2**32-1< >ffffffff< +>%#x< >2**32-1< >0xffffffff< +>%10x< >2**32-1< > ffffffff< +>%010x< >2**32-1< >00ffffffff< +>%-10x< >2**32-1< >ffffffff < +>%-010x< >2**32-1< >ffffffff < +>%0-10x< >2**32-1< >ffffffff < +>%0*x< >[-10, ,2**32-1]< >ffffffff < +>%y< >''< >%y INVALID< +>%z< >''< >%z INVALID< diff --git a/t/op/stat.t b/t/op/stat.t index af4920cd43..353b3b3b2f 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -80,6 +80,7 @@ else { print "not ok 4\n"; print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n"; print "#4 of some sort. Building in /tmp sometimes has this problem.\n"; + print "#4 Also building on the ClearCase VOBS filesystem may cause this failure.\n"; } print "#4 :$mtime: should != :$ctime:\n"; diff --git a/t/op/taint.t b/t/op/taint.t index 6548b46f59..44f50aea18 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -24,7 +24,8 @@ BEGIN { $ENV{PATH} = $ENV{PATH}; $ENV{TERM} = $ENV{TERM} ne ''? $ENV{TERM} : 'dummy'; } - if ($Config{d_shm} || $Config{d_msg}) { + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ + && ($Config{d_shm} || $Config{d_msg})) { require IPC::SysV; IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU)); } @@ -612,13 +613,13 @@ else { # test shmread { - if ($Config{d_shm}) { + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ && $Config{d_shm}) { no strict 'subs'; my $sent = "foobar"; my $rcvd; my $size = 2000; - my $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || - warn "# shmget failed: $!\n"; + my $id = shmget(IPC_PRIVATE, $size, S_IRWXU); + if (defined $id) { if (shmwrite($id, $sent, 0, 60)) { if (shmread($id, $rcvd, 0, 60)) { @@ -629,7 +630,7 @@ else { } else { warn "# shmwrite failed: $!\n"; } - shmctl($id, IPC_RMID, 0) || warn "# shmctl failed: $!\n"; + shmctl($id, IPC_RMID, 0) or warn "# shmctl failed: $!\n"; } else { warn "# shmget failed: $!\n"; } @@ -646,7 +647,7 @@ else { # test msgrcv { - if ($Config{d_msg}) { + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ && $Config{d_msg}) { no strict 'subs'; my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU); @@ -665,7 +666,7 @@ else { } else { warn "# msgsnd failed\n"; } - msgctl($id, IPC_RMID, 0) || warn "# msgctl failed: $!\n"; + msgctl($id, IPC_RMID, 0) or warn "# msgctl failed: $!\n"; } else { warn "# msgget failed\n"; } @@ -5,7 +5,7 @@ BEGIN { unshift @INC, "../lib"; } -print "1..4\n"; +print "1..27\n"; $_ = "abcdefghijklmnopqrstuvwxyz"; @@ -37,3 +37,129 @@ print "ok 3\n"; print "ok 4\n"; } # + +# make sure that tr cancels IOK and NOK +($x = 12) =~ tr/1/3/; +(my $y = 12) =~ tr/1/3/; +($f = 1.5) =~ tr/1/3/; +(my $g = 1.5) =~ tr/1/3/; +print "not " unless $x + $y + $f + $g == 71; +print "ok 5\n"; + +# make sure tr is harmless if not updating - see [ID 20000511.005] +$_ = 'fred'; +/([a-z]{2})/; +$1 =~ tr/A-Z//; +s/^(\s*)f/$1F/; +print "not " if $_ ne 'Fred'; +print "ok 6\n"; + +# check tr handles UTF8 correctly +($x = 256.65.258) =~ tr/a/b/; +print "not " if $x ne 256.65.258 or length $x != 3; +print "ok 7\n"; +$x =~ tr/A/B/; +print "not " if $x ne 256.66.258 or length $x != 3; +print "ok 8\n"; + +{ +use utf8; + +# 9 - changing UTF8 characters in a UTF8 string, same length. +$l = chr(300); $r = chr(400); +$x = 200.300.400; +$x =~ tr/\x{12c}/\x{190}/; +printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3; +print "ok 9\n"; + +# 10 - changing UTF8 characters in UTF8 string, more bytes. +$x = 200.300.400; +$x =~ tr/\x{12c}/\x{be8}/; +printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3; +print "ok 10\n"; + +# 11 - introducing UTF8 characters to non-UTF8 string. +$x = 100.125.60; +$x =~ tr/\x{64}/\x{190}/; +printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3; +print "ok 11\n"; + +# 12 - removing UTF8 characters from UTF8 string +$x = 400.125.60; +$x =~ tr/\x{190}/\x{64}/; +printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3; +print "ok 12\n"; + +# 13 - counting UTF8 chars in UTF8 string +$x = 400.125.60.400; +$y = $x =~ tr/\x{190}/\x{190}/; +print "not " if $y != 2; +print "ok 13\n"; + +# 14 - counting non-UTF8 chars in UTF8 string +$x = 60.400.125.60.400; +$y = $x =~ tr/\x{3c}/\x{3c}/; +print "not " if $y != 2; +print "ok 14\n"; + +# 15 - counting UTF8 chars in non-UTF8 string +$x = 200.125.60; +$y = $x =~ tr/\x{190}/\x{190}/; +print "not " if $y != 0; +print "ok 15\n"; +} + +# 16: test brokenness with tr/a-z-9//; +$_ = "abcdefghijklmnopqrstuvwxyz"; +eval "tr/a-z-9/ /"; +print (($@ =~ /^Ambiguous range in transliteration operator/) + ? '' : 'not ', "ok 16\n"); + +# 17-19: Make sure leading and trailing hyphens still work +$_ = "car-rot9"; +tr/-a-m/./; +print (($_ eq '..r.rot9') ? '' : 'not ', "ok 17\n"); + +$_ = "car-rot9"; +tr/a-m-/./; +print (($_ eq '..r.rot9') ? '' : 'not ', "ok 18\n"); + +$_ = "car-rot9"; +tr/-a-m-/./; +print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n"); + +$_ = "abcdefghijklmnop"; +tr/ae-hn/./; +print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 20\n"); + +$_ = "abcdefghijklmnop"; +tr/a-cf-kn-p/./; +print (($_ eq '...de......lm...') ? '' : 'not ', "ok 21\n"); + +$_ = "abcdefghijklmnop"; +tr/a-ceg-ikm-o/./; +print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 22\n"); + +# 23: Test reversed range check +# 20000705 MJD +eval "tr/m-d/ /"; +print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/) + ? '' : 'not ', "ok 23\n"); + +# 24: test cannot update if read-only +eval '$1 =~ tr/x/y/'; +print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ', + "ok 24\n"); + +# 25: test can count read-only +'abcdef' =~ /(bcd)/; +print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 25\n"); + +# 26: test lhs OK if not updating +print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 26\n"); + +# 27: test lhs bad if updating +eval '"123" =~ tr/1/1/'; +print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|) + ? '' : 'not ', "ok 27\n"); + diff --git a/t/op/vec.t b/t/op/vec.t index bf60fc4a08..b8efb8011d 100755 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: vec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:36 $ - -print "1..15\n"; +print "1..18\n"; print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n"; print length($foo) == 0 ? "ok 2\n" : "not ok 2\n"; @@ -25,3 +23,11 @@ vec($Vec, 0, 32) = 0xbaddacab; print $Vec eq "\xba\xdd\xac\xab" ? "ok 14\n" : "not ok 14\n"; print vec($Vec, 0, 32) == 3135089835 ? "ok 15\n" : "not ok 15\n"; +# ensure vec() handles numericalness correctly +$foo = $bar = $baz = 0; +vec($foo = 0,0,1) = 1; +vec($bar = 0,1,1) = 1; +$baz = $foo | $bar; +print $foo eq "1" && $foo == 1 ? "ok 16\n" : "not ok 16\n"; +print $bar eq "2" && $bar == 2 ? "ok 17\n" : "not ok 17\n"; +print "$foo $bar $baz" eq "1 2 3" ? "ok 18\n" : "not ok 18\n"; diff --git a/t/op/wantarray.t b/t/op/wantarray.t index 0a47b6d3ba..4b6f37cf0f 100755 --- a/t/op/wantarray.t +++ b/t/op/wantarray.t @@ -1,6 +1,6 @@ #!./perl -print "1..3\n"; +print "1..7\n"; sub context { my ( $cona, $testnum ) = @_; my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V'; @@ -13,4 +13,8 @@ sub context { context('V',1); $a = context('S',2); @a = context('A',3); +scalar context('S',4); +$a = scalar context('S',5); +($a) = context('A',6); +($a) = scalar context('S',7); 1; diff --git a/t/op/write.t b/t/op/write.t index 87d50429f4..5b01eb78b7 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -1,6 +1,6 @@ #!./perl -print "1..8\n"; +print "1..9\n"; my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; @@ -200,4 +200,21 @@ $this,$that write LEX; $that = 8; write LEX; + close LEX; } +# LEX_INTERPNORMAL test +my %e = ( a => 1 ); +format OUT4 = +@<<<<<< +"$e{a}" +. +open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp"; +write (OUT4); +close OUT4; +if (`$CAT Op_write.tmp` eq "1\n") { + print "ok 9\n"; + unlink "Op_write.tmp"; + } +else { + print "not ok 9\n"; + } diff --git a/t/pragma/constant.t b/t/pragma/constant.t index 6438332cff..dde64ceebd 100755 --- a/t/pragma/constant.t +++ b/t/pragma/constant.t @@ -212,8 +212,9 @@ eval q{ use constant 'SIG' => 1 ; }; -test 59, @warnings == 14 ; +test 59, @warnings == 15 ; test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/; +shift @warnings; #Constant subroutine BEGIN redefined at test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/; test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/; test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/; diff --git a/t/pragma/overload.t b/t/pragma/overload.t index f9a9c59c87..78ca147bf3 100755 --- a/t/pragma/overload.t +++ b/t/pragma/overload.t @@ -417,7 +417,7 @@ EOF m'try it'; s'first part'second part'; s/yet another/tail here/; - tr/z-Z/z-Z/; + tr/A-Z/a-z/; } test($out, '_<foo>_'); # 117 @@ -425,7 +425,7 @@ test($out1, '_<f\'o\\o>_'); # 128 test($out2, "_<a\a>_foo_<,\,>_"); # 129 test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups qq oups1 - q second part q tail here s z-Z tr z-Z tr"); # 130 + q second part q tail here s A-Z tr a-z tr"); # 130 test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq"); # 131 test($res, 1); # 132 test($a, "_<oups diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars index 2ccfef7105..5ba579d969 100644 --- a/t/pragma/strict-vars +++ b/t/pragma/strict-vars @@ -387,6 +387,8 @@ EXPECT # multiple our declarations in same scope, same package, warning use strict 'vars'; use warnings; +{ our $x = 1 } +{ our $x = 0 } our $foo; { our $foo; @@ -394,6 +396,17 @@ our $foo; our $foo; } EXPECT -"our" variable $foo redeclared at - line 7. +"our" variable $foo redeclared at - line 9. (Did you mean "local" instead of "our"?) -Name "Foo::foo" used only once: possible typo at - line 9. +Name "Foo::foo" used only once: possible typo at - line 11. +######## + +# Make sure the strict vars failure still occurs +# now that the `@i should be written as \@i' failure does not occur +# 20000522 mjd@plover.com (MJD) +use strict 'vars'; +no warnings; +"@i_like_crackers"; +EXPECT +Global symbol "@i_like_crackers" requires explicit package name at - line 7. +Execution of - aborted due to compilation errors. diff --git a/t/pragma/strict.t b/t/pragma/strict.t index c4d64164e6..167b3604f5 100755 --- a/t/pragma/strict.t +++ b/t/pragma/strict.t @@ -19,7 +19,7 @@ my @prgs = () ; foreach (sort glob("pragma/strict-*")) { - next if /(~|\.orig)$/; + next if /(~|\.orig|,v)$/; open F, "<$_" or die "Cannot open $_: $!\n" ; while (<F>) { diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t index 8db3d1a305..d1546feeaf 100755 --- a/t/pragma/utf8.t +++ b/t/pragma/utf8.t @@ -10,7 +10,7 @@ BEGIN { } } -print "1..65\n"; +print "1..66\n"; my $test = 1; @@ -289,3 +289,9 @@ sub ok_bytes { ok "\x{ab}" =~ /^\x{ab}$/, 1; $test++; # 65 } + +{ + use utf8; + ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2); + $test++; # 66 +} diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use index b489d62e19..e25d43adbb 100644 --- a/t/pragma/warn/2use +++ b/t/pragma/warn/2use @@ -13,25 +13,25 @@ BEGIN failed--compilation aborted at - line 3. ######## # Check compile time scope of pragma -use warnings 'deprecated' ; +use warnings 'syntax' ; { no warnings ; - 1 if $a EQ $b ; + my $a =+ 1 ; } -1 if $a EQ $b ; +my $a =+ 1 ; EXPECT -Use of EQ is deprecated at - line 8. +Reversed += operator at - line 8. ######## # Check compile time scope of pragma no warnings; { - use warnings 'deprecated' ; - 1 if $a EQ $b ; + use warnings 'syntax' ; + my $a =+ 1 ; } -1 if $a EQ $b ; +my $a =+ 1 ; EXPECT -Use of EQ is deprecated at - line 6. +Reversed += operator at - line 6. ######## # Check runtime scope of pragma @@ -67,55 +67,55 @@ EXPECT Use of uninitialized value in scalar chop at - line 6. ######## -use warnings 'deprecated' ; -1 if $a EQ $b ; +use warnings 'syntax' ; +my $a =+ 1 ; EXPECT -Use of EQ is deprecated at - line 3. +Reversed += operator at - line 3. ######## --FILE-- abc -1 if $a EQ $b ; +my $a =+ 1 ; 1; --FILE-- -use warnings 'deprecated' ; +use warnings 'syntax' ; require "./abc"; EXPECT ######## --FILE-- abc -use warnings 'deprecated' ; +use warnings 'syntax' ; 1; --FILE-- require "./abc"; -1 if $a EQ $b ; +my $a =+ 1 ; EXPECT ######## --FILE-- abc -use warnings 'deprecated' ; -1 if $a EQ $b ; +use warnings 'syntax' ; +my $a =+ 1 ; 1; --FILE-- use warnings 'uninitialized' ; require "./abc"; my $a ; chop $a ; EXPECT -Use of EQ is deprecated at ./abc line 2. +Reversed += operator at ./abc line 2. Use of uninitialized value in scalar chop at - line 3. ######## --FILE-- abc.pm -use warnings 'deprecated' ; -1 if $a EQ $b ; +use warnings 'syntax' ; +my $a =+ 1 ; 1; --FILE-- use warnings 'uninitialized' ; use abc; my $a ; chop $a ; EXPECT -Use of EQ is deprecated at abc.pm line 2. +Reversed += operator at abc.pm line 2. Use of uninitialized value in scalar chop at - line 3. ######## @@ -179,9 +179,9 @@ use warnings; { no warnings ; eval { - 1 if $a EQ $b ; + my $a =+ 1 ; }; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT @@ -192,41 +192,41 @@ use warnings; { no warnings ; eval { - use warnings 'deprecated' ; - 1 if $a EQ $b ; + use warnings 'syntax' ; + my $a =+ 1 ; }; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 8. +Reversed += operator at - line 8. ######## # Check scope of pragma with eval no warnings; { - use warnings 'deprecated' ; + use warnings 'syntax' ; eval { - 1 if $a EQ $b ; + my $a =+ 1 ; }; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 7. -Use of EQ is deprecated at - line 9. +Reversed += operator at - line 7. +Reversed += operator at - line 9. ######## # Check scope of pragma with eval no warnings; { - use warnings 'deprecated' ; + use warnings 'syntax' ; eval { no warnings ; - 1 if $a EQ $b ; + my $a =+ 1 ; }; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 10. +Reversed += operator at - line 10. ######## # Check scope of pragma with eval @@ -289,9 +289,9 @@ use warnings; { no warnings ; eval ' - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT @@ -302,55 +302,53 @@ use warnings; { no warnings ; eval q[ - use warnings 'deprecated' ; - 1 if $a EQ $b ; + use warnings 'syntax' ; + my $a =+ 1 ; ]; print STDERR $@; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT -Use of EQ is deprecated at (eval 1) line 3. +Reversed += operator at (eval 1) line 3. ######## # Check scope of pragma with eval no warnings; { - use warnings 'deprecated' ; + use warnings 'syntax' ; eval ' - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 9. -Use of EQ is deprecated at (eval 1) line 2. +Reversed += operator at - line 9. +Reversed += operator at (eval 1) line 2. ######## # Check scope of pragma with eval no warnings; { - use warnings 'deprecated' ; + use warnings 'syntax' ; eval ' no warnings ; - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 10. +Reversed += operator at - line 10. ######## # Check the additive nature of the pragma -1 if $a EQ $b ; +my $a =+ 1 ; my $a ; chop $a ; -use warnings 'deprecated' ; -1 if $a EQ $b ; +use warnings 'syntax' ; +$a =+ 1 ; my $b ; chop $b ; use warnings 'uninitialized' ; my $c ; chop $c ; -no warnings 'deprecated' ; -1 if $a EQ $b ; +no warnings 'syntax' ; +$a =+ 1 ; EXPECT -Use of EQ is deprecated at - line 6. +Reversed += operator at - line 6. Use of uninitialized value in scalar chop at - line 9. -Use of uninitialized value in string eq at - line 11. -Use of uninitialized value in string eq at - line 11. diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both index 335e1b26b7..a4d9ba806d 100644 --- a/t/pragma/warn/3both +++ b/t/pragma/warn/3both @@ -258,9 +258,9 @@ BEGIN { $^W = 1 } { no warnings ; eval ' - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint index 56e3fabe2c..848822dd30 100644 --- a/t/pragma/warn/4lint +++ b/t/pragma/warn/4lint @@ -4,19 +4,19 @@ __END__ -W # lint: check compile time $^W is zapped BEGIN { $^W = 0 ;} -$a = $b = 1 ; -$a = 1 if $a EQ $b ; +$a = 1 ; +$a =+ 1 ; close STDIN ; print STDIN "abc" ; EXPECT -Use of EQ is deprecated at - line 5. -print() on closed filehandle main::STDIN at - line 6. +Reversed += operator at - line 5. +print() on closed filehandle STDIN at - line 6. ######## -W # lint: check runtime $^W is zapped $^W = 0 ; close STDIN ; print STDIN "abc" ; EXPECT -print() on closed filehandle main::STDIN at - line 4. +print() on closed filehandle STDIN at - line 4. ######## -W # lint: check runtime $^W is zapped @@ -25,17 +25,17 @@ print() on closed filehandle main::STDIN at - line 4. close STDIN ; print STDIN "abc" ; } EXPECT -print() on closed filehandle main::STDIN at - line 5. +print() on closed filehandle STDIN at - line 5. ######## -W # lint: check "no warnings" is zapped no warnings ; -$a = $b = 1 ; -$a = 1 if $a EQ $b ; +$a = 1 ; +$a =+ 1 ; close STDIN ; print STDIN "abc" ; EXPECT -Use of EQ is deprecated at - line 5. -print() on closed filehandle main::STDIN at - line 6. +Reversed += operator at - line 5. +print() on closed filehandle STDIN at - line 6. ######## -W # lint: check "no warnings" is zapped @@ -44,7 +44,7 @@ print() on closed filehandle main::STDIN at - line 6. close STDIN ; print STDIN "abc" ; } EXPECT -print() on closed filehandle main::STDIN at - line 5. +print() on closed filehandle STDIN at - line 5. ######## -Ww # lint: check combination of -w and -W @@ -53,62 +53,62 @@ print() on closed filehandle main::STDIN at - line 5. close STDIN ; print STDIN "abc" ; } EXPECT -print() on closed filehandle main::STDIN at - line 5. +print() on closed filehandle STDIN at - line 5. ######## -W --FILE-- abc.pm -no warnings 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; +no warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; 1; --FILE-- no warnings 'uninitialized' ; use abc; my $a ; chop $a ; EXPECT -Use of EQ is deprecated at abc.pm line 3. +Reversed += operator at abc.pm line 3. Use of uninitialized value in scalar chop at - line 3. ######## -W --FILE-- abc -no warnings 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; +no warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; 1; --FILE-- no warnings 'uninitialized' ; require "./abc"; my $a ; chop $a ; EXPECT -Use of EQ is deprecated at ./abc line 3. +Reversed += operator at ./abc line 3. Use of uninitialized value in scalar chop at - line 3. ######## -W --FILE-- abc.pm BEGIN {$^W = 0} -my ($a, $b) = (0,0); -1 if $a EQ $b ; +my $a = 0 ; +$a =+ 1 ; 1; --FILE-- $^W = 0 ; use abc; my $a ; chop $a ; EXPECT -Use of EQ is deprecated at abc.pm line 3. +Reversed += operator at abc.pm line 3. Use of uninitialized value in scalar chop at - line 3. ######## -W --FILE-- abc BEGIN {$^W = 0} -my ($a, $b) = (0,0); -1 if $a EQ $b ; +my $a = 0 ; +$a =+ 1 ; 1; --FILE-- $^W = 0 ; require "./abc"; my $a ; chop $a ; EXPECT -Use of EQ is deprecated at ./abc line 3. +Reversed += operator at ./abc line 3. Use of uninitialized value in scalar chop at - line 3. ######## -W @@ -175,42 +175,42 @@ use warnings; my $a = "1"; my $b = "2"; no warnings ; eval q[ - use warnings 'deprecated' ; - 1 if $a EQ $b ; + use warnings 'syntax' ; + $a =+ 1 ; ]; print STDERR $@; - 1 if $a EQ $b ; + $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 11. -Use of EQ is deprecated at (eval 1) line 3. +Reversed += operator at - line 11. +Reversed += operator at (eval 1) line 3. ######## -W # Check scope of pragma with eval no warnings; { my $a = "1"; my $b = "2"; - use warnings 'deprecated' ; + use warnings 'syntax' ; eval ' - 1 if $a EQ $b ; + $a =+ 1 ; '; print STDERR $@; - 1 if $a EQ $b ; + $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 10. -Use of EQ is deprecated at (eval 1) line 2. +Reversed += operator at - line 10. +Reversed += operator at (eval 1) line 2. ######## -W # Check scope of pragma with eval no warnings; { my $a = "1"; my $b = "2"; - use warnings 'deprecated' ; + use warnings 'syntax' ; eval ' no warnings ; - 1 if $a EQ $b ; + $a =+ 1 ; '; print STDERR $@; - 1 if $a EQ $b ; + $a =+ 1 ; } EXPECT -Use of EQ is deprecated at - line 11. -Use of EQ is deprecated at (eval 1) line 3. +Reversed += operator at - line 11. +Reversed += operator at (eval 1) line 3. diff --git a/t/pragma/warn/5nolint b/t/pragma/warn/5nolint index 2459968003..56158a20be 100644 --- a/t/pragma/warn/5nolint +++ b/t/pragma/warn/5nolint @@ -1,11 +1,11 @@ -Check anti-lint +syntax anti-lint __END__ -X # nolint: check compile time $^W is zapped BEGIN { $^W = 1 ;} $a = $b = 1 ; -$a = 1 if $a EQ $b ; +$a =+ 1 ; close STDIN ; print STDIN "abc" ; EXPECT ######## @@ -27,7 +27,7 @@ EXPECT # nolint: check "no warnings" is zapped use warnings ; $a = $b = 1 ; -$a = 1 if $a EQ $b ; +$a =+ 1 ; close STDIN ; print STDIN "abc" ; EXPECT ######## @@ -49,9 +49,9 @@ EXPECT ######## -X --FILE-- abc.pm -use warnings 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; +use warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; 1; --FILE-- use warnings 'uninitialized' ; @@ -61,9 +61,9 @@ EXPECT ######## -X --FILE-- abc -use warnings 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; +use warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; 1; --FILE-- use warnings 'uninitialized' ; @@ -75,7 +75,7 @@ EXPECT --FILE-- abc.pm BEGIN {$^W = 1} my ($a, $b) = (0,0); -1 if $a EQ $b ; +$a =+ 1 ; 1; --FILE-- $^W = 1 ; @@ -87,7 +87,7 @@ EXPECT --FILE-- abc BEGIN {$^W = 1} my ($a, $b) = (0,0); -1 if $a EQ $b ; +$a =+ 1 ; 1; --FILE-- $^W = 1 ; @@ -155,9 +155,9 @@ use warnings; { no warnings ; eval ' - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@ ; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT @@ -168,10 +168,10 @@ use warnings; { no warnings ; eval q[ - use warnings 'deprecated' ; - 1 if $a EQ $b ; + use warnings 'syntax' ; + my $a =+ 1 ; ]; print STDERR $@; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT @@ -180,11 +180,11 @@ EXPECT # Check scope of pragma with eval no warnings; { - use warnings 'deprecated' ; + use warnings 'syntax' ; eval ' - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT @@ -193,12 +193,12 @@ EXPECT # Check scope of pragma with eval no warnings; { - use warnings 'deprecated' ; + use warnings 'syntax' ; eval ' no warnings ; - 1 if $a EQ $b ; + my $a =+ 1 ; '; print STDERR $@; - 1 if $a EQ $b ; + my $a =+ 1 ; } EXPECT diff --git a/t/pragma/warn/7fatal b/t/pragma/warn/7fatal index 2d29ddbd82..382a8458e5 100644 --- a/t/pragma/warn/7fatal +++ b/t/pragma/warn/7fatal @@ -3,27 +3,27 @@ Check FATAL functionality __END__ # Check compile time warning -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; { no warnings ; - 1 if $a EQ $b ; + $a =+ 1 ; } -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at - line 8. +Reversed += operator at - line 8. ######## # Check compile time warning use warnings FATAL => 'all' ; { no warnings ; - 1 if $a EQ $b ; + my $a =+ 1 ; } -1 if $a EQ $b ; +my $a =+ 1 ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at - line 8. +Reversed += operator at - line 8. ######## # Check runtime scope of pragma @@ -75,28 +75,28 @@ Use of uninitialized value in scalar chop at - line 6. ######## --FILE-- abc -1 if $a EQ $b ; +$a =+ 1 ; 1; --FILE-- -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; require "./abc"; EXPECT ######## --FILE-- abc -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; 1; --FILE-- require "./abc"; -1 if $a EQ $b ; +$a =+ 1 ; EXPECT ######## --FILE-- abc -use warnings 'deprecated' ; -1 if $a EQ $b ; +use warnings 'syntax' ; +$a =+ 1 ; 1; --FILE-- use warnings FATAL => 'uninitialized' ; @@ -104,13 +104,13 @@ require "./abc"; my $a ; chop $a ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at ./abc line 2. +Reversed += operator at ./abc line 2. Use of uninitialized value in scalar chop at - line 3. ######## --FILE-- abc.pm -use warnings 'deprecated' ; -1 if $a EQ $b ; +use warnings 'syntax' ; +$a =+ 1 ; 1; --FILE-- use warnings FATAL => 'uninitialized' ; @@ -118,7 +118,7 @@ use abc; my $a ; chop $a ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at abc.pm line 2. +Reversed += operator at abc.pm line 2. Use of uninitialized value in scalar chop at - line 3. ######## @@ -162,44 +162,44 @@ Use of uninitialized value in scalar chop at - line 8. # Check scope of pragma with eval no warnings ; eval { - use warnings FATAL => 'deprecated' ; - 1 if $a EQ $b ; + use warnings FATAL => 'syntax' ; + $a =+ 1 ; }; print STDERR "-- $@" ; -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at - line 6. +Reversed += operator at - line 6. ######## # Check scope of pragma with eval -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; eval { - 1 if $a EQ $b ; + $a =+ 1 ; }; print STDERR "-- $@" ; -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at - line 5. +Reversed += operator at - line 5. ######## # Check scope of pragma with eval -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; eval { no warnings ; - 1 if $a EQ $b ; + $a =+ 1 ; }; print STDERR $@ ; -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at - line 8. +Reversed += operator at - line 8. ######## # Check scope of pragma with eval no warnings ; eval { - use warnings FATAL => 'deprecated' ; + use warnings FATAL => 'syntax' ; }; print STDERR $@ ; -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT The End. @@ -245,34 +245,34 @@ Use of uninitialized value in scalar chop at - line 8. # Check scope of pragma with eval no warnings ; eval q[ - use warnings FATAL => 'deprecated' ; - 1 if $a EQ $b ; + use warnings FATAL => 'syntax' ; + $a =+ 1 ; ]; print STDERR "-- $@"; -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT --- Use of EQ is deprecated at (eval 1) line 3. +-- Reversed += operator at (eval 1) line 3. The End. ######## # Check scope of pragma with eval -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; eval ' - 1 if $a EQ $b ; + $a =+ 1 ; '; print STDERR "-- $@"; print STDERR "The End.\n" ; EXPECT --- Use of EQ is deprecated at (eval 1) line 2. +-- Reversed += operator at (eval 1) line 2. The End. ######## # Check scope of pragma with eval -use warnings FATAL => 'deprecated' ; +use warnings FATAL => 'syntax' ; eval ' no warnings ; - 1 if $a EQ $b ; + $a =+ 1 ; '; print STDERR "-- $@"; -1 if $a EQ $b ; +$a =+ 1 ; print STDERR "The End.\n" ; EXPECT -Use of EQ is deprecated at - line 8. +Reversed += operator at - line 8. diff --git a/t/pragma/warn/8signal b/t/pragma/warn/8signal index d480f1902a..cc1b9d926d 100644 --- a/t/pragma/warn/8signal +++ b/t/pragma/warn/8signal @@ -6,13 +6,13 @@ __END__ # 8signal BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } } BEGIN { $SIG{__DIE__} = sub { print "DIE -- @_" } } -1 if 1 EQ 2 ; -use warnings qw(deprecated) ; -1 if 1 EQ 2 ; -use warnings FATAL => qw(deprecated) ; -1 if 1 EQ 2 ; +$a =+ 1 ; +use warnings qw(syntax) ; +$a =+ 1 ; +use warnings FATAL => qw(syntax) ; +$a =+ 1 ; print "The End.\n" ; EXPECT -WARN -- Use of EQ is deprecated at - line 6. -DIE -- Use of EQ is deprecated at - line 8. -Use of EQ is deprecated at - line 8. +WARN -- Reversed += operator at - line 6. +DIE -- Reversed += operator at - line 8. +Reversed += operator at - line 8. diff --git a/t/pragma/warn/9enabled b/t/pragma/warn/9enabled index 55642ffadf..96f319e55d 100755 --- a/t/pragma/warn/9enabled +++ b/t/pragma/warn/9enabled @@ -817,3 +817,87 @@ abc all not enabled def self enabled def abc not enabled def all not enabled +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if warnings::enabled("io") ; + print "ok3\n" if warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +BEGIN { $^W = 1 ; } +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +$^W = 1 ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index bd409721d2..813f149fb5 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -12,7 +12,7 @@ warn(warn_nl, "open"); [Perl_do_open9] open(F, "true\ncd") - Close on unopened file <%s> [Perl_do_close] <<TODO + Close on unopened file %s [Perl_do_close] <<TODO $a = "fred";close("$a") tell() on unopened file [Perl_do_tell] @@ -96,7 +96,7 @@ close "fred" ; no warnings 'unopened' ; close "joe" ; EXPECT -Close on unopened file <fred> at - line 3. +Close on unopened file fred at - line 3. ######## # doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat] use warnings 'io' ; @@ -115,7 +115,7 @@ EXPECT tell() on unopened file at - line 4. seek() on unopened file at - line 5. sysseek() on unopened file at - line 6. -Stat on unopened file <STDIN> at - line 7. +Stat on unopened file STDIN at - line 7. ######## # doio.c [Perl_do_print] use warnings 'uninitialized' ; @@ -188,4 +188,4 @@ my $a = eof STDOUT ; no warnings 'io' ; $a = eof STDOUT ; EXPECT -Filehandle main::STDOUT opened only for output at - line 3. +Filehandle STDOUT opened only for output at - line 3. diff --git a/t/pragma/warn/op b/t/pragma/warn/op index 2c9e0fdbed..de326f8b0c 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -278,7 +278,7 @@ Useless use of hash element in void context at - line 29. Useless use of hash slice in void context at - line 30. Useless use of unpack in void context at - line 31. Useless use of pack in void context at - line 32. -Useless use of join in void context at - line 33. +Useless use of join or string in void context at - line 33. Useless use of list slice in void context at - line 34. Useless use of sort in void context at - line 37. Useless use of reverse in void context at - line 38. @@ -716,6 +716,20 @@ EXPECT Constant subroutine fred redefined at - line 4. ######## # op.c +no warnings 'redefine' ; +sub fred () { 1 } +sub fred () { 2 } +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c +no warnings 'redefine' ; +sub fred () { 1 } +*fred = sub () { 2 }; +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c use warnings 'redefine' ; format FRED = . diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 275905749e..fe874ef7ef 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -52,7 +52,7 @@ print $f $a; no warnings 'unopened' ; print $f $a; EXPECT -Filehandle main::abc never opened at - line 4. +Filehandle abc never opened at - line 4. ######## # pp_hot.c [pp_print] use warnings 'io' ; @@ -71,12 +71,12 @@ print getc(FOO); no warnings 'io' ; print STDIN "anc"; EXPECT -Filehandle main::STDIN opened only for input at - line 3. -Filehandle main::STDOUT opened only for output at - line 4. -Filehandle main::STDERR opened only for output at - line 5. -Filehandle main::FOO opened only for output at - line 6. -Filehandle main::STDERR opened only for output at - line 7. -Filehandle main::FOO opened only for output at - line 8. +Filehandle STDIN opened only for input at - line 3. +Filehandle STDOUT opened only for output at - line 4. +Filehandle STDERR opened only for output at - line 5. +Filehandle FOO opened only for output at - line 6. +Filehandle STDERR opened only for output at - line 7. +Filehandle FOO opened only for output at - line 8. ######## # pp_hot.c [pp_print] use warnings 'closed' ; @@ -90,9 +90,9 @@ print STDIN "anc"; opendir STDIN, "."; print STDIN "anc"; EXPECT -print() on closed filehandle main::STDIN at - line 4. -print() on closed filehandle main::STDIN at - line 6. - (Are you trying to call print() on dirhandle main::STDIN?) +print() on closed filehandle STDIN at - line 4. +print() on closed filehandle STDIN at - line 6. + (Are you trying to call print() on dirhandle STDIN?) ######## # pp_hot.c [pp_rv2av] use warnings 'uninitialized' ; @@ -137,9 +137,9 @@ no warnings 'closed' ; opendir STDIN, "." ; $a = <STDIN> ; $a = <STDIN> ; EXPECT -readline() on closed filehandle main::STDIN at - line 3. -readline() on closed filehandle main::STDIN at - line 4. - (Are you trying to call readline() on dirhandle main::STDIN?) +readline() on closed filehandle STDIN at - line 3. +readline() on closed filehandle STDIN at - line 4. + (Are you trying to call readline() on dirhandle STDIN?) ######## # pp_hot.c [Perl_do_readline] use warnings 'io' ; @@ -150,7 +150,7 @@ no warnings 'io' ; $a = <FH> ; unlink $file ; EXPECT -Filehandle main::FH opened only for output at - line 5. +Filehandle FH opened only for output at - line 5. ######## # pp_hot.c [Perl_sub_crush_depth] use warnings 'recursion' ; diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index 7c38727e28..ad5982ab81 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -107,7 +107,7 @@ write STDIN; no warnings 'io' ; write STDIN; EXPECT -Filehandle main::STDIN opened only for input at - line 5. +Filehandle STDIN opened only for input at - line 5. ######## # pp_sys.c [pp_leavewrite] use warnings 'closed' ; @@ -123,9 +123,9 @@ write STDIN; opendir STDIN, "."; write STDIN; EXPECT -write() on closed filehandle main::STDIN at - line 6. -write() on closed filehandle main::STDIN at - line 8. - (Are you trying to call write() on dirhandle main::STDIN?) +write() on closed filehandle STDIN at - line 6. +write() on closed filehandle STDIN at - line 8. + (Are you trying to call write() on dirhandle STDIN?) ######## # pp_sys.c [pp_leavewrite] use warnings 'io' ; @@ -152,7 +152,7 @@ printf $a "fred"; no warnings 'unopened' ; printf $a "fred"; EXPECT -Filehandle main::abc never opened at - line 4. +Filehandle abc never opened at - line 4. ######## # pp_sys.c [pp_prtf] use warnings 'closed' ; @@ -166,9 +166,9 @@ printf STDIN "fred"; opendir STDIN, "."; printf STDIN "fred"; EXPECT -printf() on closed filehandle main::STDIN at - line 4. -printf() on closed filehandle main::STDIN at - line 6. - (Are you trying to call printf() on dirhandle main::STDIN?) +printf() on closed filehandle STDIN at - line 4. +printf() on closed filehandle STDIN at - line 6. + (Are you trying to call printf() on dirhandle STDIN?) ######## # pp_sys.c [pp_prtf] use warnings 'io' ; @@ -176,7 +176,7 @@ printf STDIN "fred"; no warnings 'io' ; printf STDIN "fred"; EXPECT -Filehandle main::STDIN opened only for input at - line 3. +Filehandle STDIN opened only for input at - line 3. ######## # pp_sys.c [pp_send] use warnings 'closed' ; @@ -190,9 +190,9 @@ syswrite STDIN, "fred", 1; opendir STDIN, "."; syswrite STDIN, "fred", 1; EXPECT -syswrite() on closed filehandle main::STDIN at - line 4. -syswrite() on closed filehandle main::STDIN at - line 6. - (Are you trying to call syswrite() on dirhandle main::STDIN?) +syswrite() on closed filehandle STDIN at - line 4. +syswrite() on closed filehandle STDIN at - line 6. + (Are you trying to call syswrite() on dirhandle STDIN?) ######## # pp_sys.c [pp_flock] use Config; @@ -215,9 +215,9 @@ flock STDIN, 8; opendir STDIN, "."; flock STDIN, 8; EXPECT -flock() on closed filehandle main::STDIN at - line 14. -flock() on closed filehandle main::STDIN at - line 16. - (Are you trying to call flock() on dirhandle main::STDIN?) +flock() on closed filehandle STDIN at - line 14. +flock() on closed filehandle STDIN at - line 16. + (Are you trying to call flock() on dirhandle STDIN?) ######## # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername] use warnings 'io' ; @@ -285,36 +285,36 @@ getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; EXPECT -send() on closed socket main::STDIN at - line 22. -bind() on closed socket main::STDIN at - line 23. -connect() on closed socket main::STDIN at - line 24. -listen() on closed socket main::STDIN at - line 25. -accept() on closed socket main::STDIN at - line 26. -shutdown() on closed socket main::STDIN at - line 27. -setsockopt() on closed socket main::STDIN at - line 28. -getsockopt() on closed socket main::STDIN at - line 29. -getsockname() on closed socket main::STDIN at - line 30. -getpeername() on closed socket main::STDIN at - line 31. -send() on closed socket main::STDIN at - line 33. - (Are you trying to call send() on dirhandle main::STDIN?) -bind() on closed socket main::STDIN at - line 34. - (Are you trying to call bind() on dirhandle main::STDIN?) -connect() on closed socket main::STDIN at - line 35. - (Are you trying to call connect() on dirhandle main::STDIN?) -listen() on closed socket main::STDIN at - line 36. - (Are you trying to call listen() on dirhandle main::STDIN?) -accept() on closed socket main::STDIN at - line 37. - (Are you trying to call accept() on dirhandle main::STDIN?) -shutdown() on closed socket main::STDIN at - line 38. - (Are you trying to call shutdown() on dirhandle main::STDIN?) -setsockopt() on closed socket main::STDIN at - line 39. - (Are you trying to call setsockopt() on dirhandle main::STDIN?) -getsockopt() on closed socket main::STDIN at - line 40. - (Are you trying to call getsockopt() on dirhandle main::STDIN?) -getsockname() on closed socket main::STDIN at - line 41. - (Are you trying to call getsockname() on dirhandle main::STDIN?) -getpeername() on closed socket main::STDIN at - line 42. - (Are you trying to call getpeername() on dirhandle main::STDIN?) +send() on closed socket STDIN at - line 22. +bind() on closed socket STDIN at - line 23. +connect() on closed socket STDIN at - line 24. +listen() on closed socket STDIN at - line 25. +accept() on closed socket STDIN at - line 26. +shutdown() on closed socket STDIN at - line 27. +setsockopt() on closed socket STDIN at - line 28. +getsockopt() on closed socket STDIN at - line 29. +getsockname() on closed socket STDIN at - line 30. +getpeername() on closed socket STDIN at - line 31. +send() on closed socket STDIN at - line 33. + (Are you trying to call send() on dirhandle STDIN?) +bind() on closed socket STDIN at - line 34. + (Are you trying to call bind() on dirhandle STDIN?) +connect() on closed socket STDIN at - line 35. + (Are you trying to call connect() on dirhandle STDIN?) +listen() on closed socket STDIN at - line 36. + (Are you trying to call listen() on dirhandle STDIN?) +accept() on closed socket STDIN at - line 37. + (Are you trying to call accept() on dirhandle STDIN?) +shutdown() on closed socket STDIN at - line 38. + (Are you trying to call shutdown() on dirhandle STDIN?) +setsockopt() on closed socket STDIN at - line 39. + (Are you trying to call setsockopt() on dirhandle STDIN?) +getsockopt() on closed socket STDIN at - line 40. + (Are you trying to call getsockopt() on dirhandle STDIN?) +getsockname() on closed socket STDIN at - line 41. + (Are you trying to call getsockname() on dirhandle STDIN?) +getpeername() on closed socket STDIN at - line 42. + (Are you trying to call getpeername() on dirhandle STDIN?) ######## # pp_sys.c [pp_stat] use warnings 'newline' ; @@ -331,7 +331,7 @@ close STDIN ; no warnings 'unopened' ; -T STDIN ; EXPECT -Test on unopened file <STDIN> at - line 4. +Test on unopened file STDIN at - line 4. ######## # pp_sys.c [pp_fttext] use warnings 'newline' ; @@ -351,4 +351,4 @@ my $a = sysread(F, $a,10) ; close F ; unlink $file ; EXPECT -Filehandle main::F opened only for output at - line 5. +Filehandle F opened only for output at - line 5. diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp index 5d0c291ea0..ef87b7fbb4 100644 --- a/t/pragma/warn/regcomp +++ b/t/pragma/warn/regcomp @@ -11,10 +11,6 @@ Character class [:%.*s:] unknown [S_regpposixcc] - Character class syntax [. .] is reserved for future extensions [S_regpposixcc] - - Character class syntax [= =] is reserved for future extensions [S_checkposixcc] - Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass] @@ -58,32 +54,37 @@ BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 } use warnings 'regexp' ; $_ = "" ; /[:alpha:]/; -/[.bar.]/; -/[=zog=]/; -/[[:alpha:]]/; -/[[.foo.]]/; -/[[=bar=]]/; /[:zog:]/; /[[:zog:]]/; no warnings 'regexp' ; /[:alpha:]/; -/[.foo.]/; -/[=bar=]/; -/[[:alpha:]]/; -/[[.foo.]]/; -/[[=bar=]]/; -/[[:zog:]]/; /[:zog:]/; +/[[:zog:]]/; EXPECT Character class syntax [: :] belongs inside character classes at - line 5. -Character class syntax [. .] belongs inside character classes at - line 6. -Character class syntax [. .] is reserved for future extensions at - line 6. -Character class syntax [= =] belongs inside character classes at - line 7. -Character class syntax [= =] is reserved for future extensions at - line 7. -Character class syntax [. .] is reserved for future extensions at - line 9. -Character class syntax [= =] is reserved for future extensions at - line 10. -Character class syntax [: :] belongs inside character classes at - line 11. -Character class [:zog:] unknown at - line 12. +Character class syntax [: :] belongs inside character classes at - line 6. +Character class [:zog:] unknown at - line 7. +######## +# regcomp.c [S_checkposixcc] +BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 } +use warnings 'regexp' ; +$_ = "" ; +/[.zog.]/; +no warnings 'regexp' ; +/[.zog.]/; +EXPECT +Character class syntax [. .] belongs inside character classes at - line 5. +Character class syntax [. .] is reserved for future extensions at - line 5. +######## +# regcomp.c [S_checkposixcc] +BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 } +use warnings 'regexp' ; +$_ = "" ; +/[[.zog.]]/; +no warnings 'regexp' ; +/[[.zog.]]/; +EXPECT +Character class syntax [. .] is reserved for future extensions at - line 5. ######## # regcomp.c [S_regclass] $_ = ""; diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index 758137f2e8..2409589a8f 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -178,7 +178,7 @@ no warnings 'uninitialized' ; $C = "" ; $C .= $A ; EXPECT -Use of uninitialized value in concatenation (.) at - line 10. +Use of uninitialized value in concatenation (.) or string at - line 10. ######## # sv.c use warnings 'numeric' ; diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index 8db8027767..2c9433bd7d 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -3,12 +3,6 @@ toke.c AOK we seem to have lost a few ambiguous warnings!! - 1 if $a EQ $b ; - 1 if $a NE $b ; - 1 if $a LT $b ; - 1 if $a GT $b ; - 1 if $a GE $b ; - 1 if $a LE $b ; $a = <<; Use of comma-less variable list is deprecated (called 3 times via depcom) @@ -132,29 +126,6 @@ toke.c AOK __END__ # toke.c use warnings 'deprecated' ; -1 if $a EQ $b ; -1 if $a NE $b ; -1 if $a GT $b ; -1 if $a LT $b ; -1 if $a GE $b ; -1 if $a LE $b ; -no warnings 'deprecated' ; -1 if $a EQ $b ; -1 if $a NE $b ; -1 if $a GT $b ; -1 if $a LT $b ; -1 if $a GE $b ; -1 if $a LE $b ; -EXPECT -Use of EQ is deprecated at - line 3. -Use of NE is deprecated at - line 4. -Use of GT is deprecated at - line 5. -Use of LT is deprecated at - line 6. -Use of GE is deprecated at - line 7. -Use of LE is deprecated at - line 8. -######## -# toke.c -use warnings 'deprecated' ; format STDOUT = @<<< @||| @>>> @>>> $a $b "abc" 'def' @@ -585,3 +556,11 @@ EXPECT Integer overflow in binary number at - line 5. Integer overflow in hexadecimal number at - line 8. Integer overflow in octal number at - line 11. +######## +# toke.c +use warnings 'ambiguous'; +"@mjd_previously_unused_array"; +no warnings 'ambiguous'; +"@mjd_previously_unused_array"; +EXPECT +Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3. diff --git a/t/pragma/warnings.t b/t/pragma/warnings.t index 71fb0df972..a551740b17 100644 --- a/t/pragma/warnings.t +++ b/t/pragma/warnings.t @@ -26,9 +26,7 @@ else foreach (@w_files) { - next if /\.orig$/ ; - - next if /(~|\.orig)$/; + next if /(~|\.orig|,v)$/; open F, "<$_" or die "Cannot open $_: $!\n" ; while (<F>) { @@ -280,7 +280,10 @@ # define UNLOCK_STRTAB_MUTEX MUTEX_UNLOCK(&PL_strtab_mutex) # define LOCK_CRED_MUTEX MUTEX_LOCK(&PL_cred_mutex) # define UNLOCK_CRED_MUTEX MUTEX_UNLOCK(&PL_cred_mutex) - +# define LOCK_FDPID_MUTEX MUTEX_LOCK(&PL_fdpid_mutex) +# define UNLOCK_FDPID_MUTEX MUTEX_UNLOCK(&PL_fdpid_mutex) +# define LOCK_SV_LOCK_MUTEX MUTEX_LOCK(&PL_sv_lock_mutex) +# define UNLOCK_SV_LOCK_MUTEX MUTEX_UNLOCK(&PL_sv_lock_mutex) /* Values and macros for thr->flags */ #define THRf_STATE_MASK 7 @@ -376,6 +379,22 @@ typedef struct condpair { # define UNLOCK_CRED_MUTEX #endif +#ifndef LOCK_FDPID_MUTEX +# define LOCK_FDPID_MUTEX +#endif + +#ifndef UNLOCK_FDPID_MUTEX +# define UNLOCK_FDPID_MUTEX +#endif + +#ifndef LOCK_SV_LOCK_MUTEX +# define LOCK_SV_LOCK_MUTEX +#endif + +#ifndef UNLOCK_SV_LOCK_MUTEX +# define UNLOCK_SV_LOCK_MUTEX +#endif + /* THR, SET_THR, and dTHR are there for compatibility with old versions */ #ifndef THR # define THR PERL_GET_THX @@ -28,6 +28,10 @@ static char ident_too_long[] = "Identifier too long"; static void restore_rsfp(pTHXo_ void *f); +#ifndef PERL_NO_UTF16_FILTER +static I32 utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen); +static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen); +#endif #define XFAKEBRACK 128 #define XENUMMASK 127 @@ -39,6 +43,13 @@ static void restore_rsfp(pTHXo_ void *f); * 1999-02-27 mjd-perl-patch@plover.com */ #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x))) +/* On MacOS, respect nonbreaking spaces */ +#ifdef MACOS_TRADITIONAL +#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t') +#else +#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t') +#endif + /* LEX_* are values for PL_lex_state, the state of the lexer. * They are arranged oddly so that the guard on the switch statement * can get by with a single comparison (if the compiler is smart enough). @@ -319,36 +330,6 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) } #endif -#if 0 -STATIC I32 -S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) -{ - I32 count = FILTER_READ(idx+1, sv, maxlen); - if (count) { - U8* tmps; - U8* tend; - New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv)); - sv_usepvn(sv, (char*)tmps, tend - tmps); - } - return count; -} - -STATIC I32 -S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) -{ - I32 count = FILTER_READ(idx+1, sv, maxlen); - if (count) { - U8* tmps; - U8* tend; - New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv)); - sv_usepvn(sv, (char*)tmps, tend - tmps); - } - return count; -} -#endif - /* * Perl_lex_start * Initialize variables. Uses the Perl save_stack to save its state (for @@ -463,7 +444,7 @@ S_incline(pTHX_ char *s) CopLINE_inc(PL_curcop); if (*s++ != '#') return; - while (*s == ' ' || *s == '\t') s++; + while (SPACE_OR_TAB(*s)) s++; if (strnEQ(s, "line", 4)) s += 4; else @@ -472,13 +453,13 @@ S_incline(pTHX_ char *s) s++; else return; - while (*s == ' ' || *s == '\t') s++; + while (SPACE_OR_TAB(*s)) s++; if (!isDIGIT(*s)) return; n = s; while (isDIGIT(*s)) s++; - while (*s == ' ' || *s == '\t') + while (SPACE_OR_TAB(*s)) s++; if (*s == '"' && (t = strchr(s+1, '"'))) { s++; @@ -488,15 +469,21 @@ S_incline(pTHX_ char *s) for (t = s; !isSPACE(*t); t++) ; e = t; } - while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f') + while (SPACE_OR_TAB(*e) || *e == '\r' || *e == '\f') e++; if (*e != '\n' && *e != '\0') return; /* false alarm */ ch = *t; *t = '\0'; - if (t - s > 0) + if (t - s > 0) { +#ifdef USE_ITHREADS + Safefree(CopFILE(PL_curcop)); +#else + SvREFCNT_dec(CopFILEGV(PL_curcop)); +#endif CopFILE_set(PL_curcop, s); + } *t = ch; CopLINE_set(PL_curcop, atoi(n)-1); } @@ -512,7 +499,7 @@ S_skipspace(pTHX_ register char *s) { dTHR; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { - while (s < PL_bufend && (*s == ' ' || *s == '\t')) + while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; return s; } @@ -974,6 +961,8 @@ S_sublex_start(pTHX) p = SvPV(sv, len); nsv = newSVpvn(p, len); + if (SvUTF8(sv)) + SvUTF8_on(nsv); SvREFCNT_dec(sv); sv = nsv; } @@ -1193,6 +1182,7 @@ S_scan_const(pTHX_ char *start) register char *s = start; /* start of the constant */ register char *d = SvPVX(sv); /* destination for copies */ bool dorange = FALSE; /* are we in a translit range? */ + bool didrange = FALSE; /* did we just finish a range? */ bool has_utf = FALSE; /* embedded \x{} */ I32 len; /* ? */ UV uv; @@ -1226,6 +1216,12 @@ S_scan_const(pTHX_ char *start) min = (U8)*d; /* first char in range */ max = (U8)d[1]; /* last char in range */ + if (min > max) { + Perl_croak(aTHX_ + "Invalid [] range \"%c-%c\" in transliteration operator", + min, max); + } + #ifndef ASCIIish if ((isLOWER(min) && isLOWER(max)) || (isUPPER(min) && isUPPER(max))) { @@ -1246,11 +1242,15 @@ S_scan_const(pTHX_ char *start) /* mark the range as done, and continue */ dorange = FALSE; + didrange = TRUE; continue; - } + } /* range begins (ignore - as first or last char) */ else if (*s == '-' && s+1 < send && s != start) { + if (didrange) { + Perl_croak(aTHX_ "Ambiguous range in transliteration operator"); + } if (utf) { *d++ = (char)0xff; /* use illegal utf8 byte--see pmtrans */ s++; @@ -1259,6 +1259,9 @@ S_scan_const(pTHX_ char *start) dorange = TRUE; s++; } + else { + didrange = FALSE; + } } /* if we get here, we're not doing a transliteration */ @@ -1860,7 +1863,7 @@ S_incl_perldb(pTHX) * store private buffers and state information. * * The supplied datasv parameter is upgraded to a PVIO type - * and the IoDIRP field is used to store the function pointer, + * and the IoDIRP/IoANY field is used to store the function pointer, * and IOf_FAKE_DIRP is enabled on datasv to mark this as such. * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for * private use must be set using malloc'd pointers. @@ -1878,7 +1881,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) datasv = NEWSV(255,0); if (!SvUPGRADE(datasv, SVt_PVIO)) Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO"); - IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */ + IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */ IoFLAGS(datasv) |= IOf_FAKE_DIRP; DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n", funcp, SvPV_nolen(datasv))); @@ -1898,9 +1901,9 @@ Perl_filter_del(pTHX_ filter_t funcp) return; /* if filter is on top of stack (usual case) just pop it off */ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters)); - if (IoDIRP(datasv) == (DIR*)funcp) { + if (IoANY(datasv) == (void *)funcp) { IoFLAGS(datasv) &= ~IOf_FAKE_DIRP; - IoDIRP(datasv) = (DIR*)NULL; + IoANY(datasv) = (void *)NULL; sv_free(av_pop(PL_rsfp_filters)); return; @@ -1960,7 +1963,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ - funcp = (filter_t)IoDIRP(datasv); + funcp = (filter_t)IoANY(datasv); DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", idx, funcp, SvPV_nolen(datasv))); @@ -1991,6 +1994,31 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) return (sv_gets(sv, fp, append)); } +STATIC HV * +S_find_in_my_stash(pTHX_ char *pkgname, I32 len) +{ + GV *gv; + + if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__")) + return PL_curstash; + + if (len > 2 && + (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') && + (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV))) + { + return GvHV(gv); /* Foo:: */ + } + + /* use constant CLASS => 'MyClass' */ + if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) { + SV *sv; + if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) { + pkgname = SvPV_nolen(sv); + } + } + + return gv_stashpv(pkgname, FALSE); +} #ifdef DEBUGGING static char* exp_name[] = @@ -2024,6 +2052,9 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) if we already built the token before, use it. */ +#ifdef __SC__ +#pragma segment Perl_yylex +#endif int #ifdef USE_PURE_BISON Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp) @@ -2149,9 +2180,14 @@ Perl_yylex(pTHX) */ if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) { GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV); - if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) - yyerror(Perl_form(aTHX_ "In string, %s now must be written as \\%s", - PL_tokenbuf, PL_tokenbuf)); + if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) + && ckWARN(WARN_AMBIGUOUS)) + { + /* Downgraded from fatal to warning 20000522 mjd */ + Perl_warner(aTHX_ WARN_AMBIGUOUS, + "Possible unintended interpolation of %s in string", + PL_tokenbuf); + } } /* build ops for a bareword */ @@ -2444,7 +2480,10 @@ Perl_yylex(pTHX) goto retry; } do { - if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) { + bool bof; + bof = PL_rsfp && (PerlIO_tell(PL_rsfp) == 0); /* *Before* read! */ + s = filter_gets(PL_linestr, PL_rsfp, 0); + if (s == Nullch) { fake_eof: if (PL_rsfp) { if (PL_preprocess && !PL_in_eval) @@ -2467,6 +2506,9 @@ Perl_yylex(pTHX) PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); sv_setpv(PL_linestr,""); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ + } else if (bof) { + PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + s = swallow_bom((U8*)s); } if (PL_doextract) { if (*s == '#' && s[1] == '!' && instr(s,"perl")) @@ -2479,7 +2521,7 @@ Perl_yylex(pTHX) PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_doextract = FALSE; } - } + } incline(s); } while (PL_doextract); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s; @@ -2579,6 +2621,7 @@ Perl_yylex(pTHX) *s = '#'; /* Don't try to parse shebang line */ } #endif /* ALTERNATE_SHEBANG */ +#ifndef MACOS_TRADITIONAL if (!d && *s == '#' && ipathend > ipath && @@ -2606,13 +2649,14 @@ Perl_yylex(pTHX) PerlProc_execv(ipath, newargv); Perl_croak(aTHX_ "Can't exec %s", ipath); } +#endif if (d) { U32 oldpdb = PL_perldb; bool oldn = PL_minus_n; bool oldp = PL_minus_p; while (*d && !isSPACE(*d)) d++; - while (*d == ' ' || *d == '\t') d++; + while (SPACE_OR_TAB(*d)) d++; if (*d++ == '-') { do { @@ -2654,6 +2698,9 @@ Perl_yylex(pTHX) "\t(Maybe you didn't strip carriage returns after a network transfer?)\n"); #endif case ' ': case '\t': case '\f': case 013: +#ifdef MACOS_TRADITIONAL + case '\312': +#endif s++; goto retry; case '#': @@ -2687,7 +2734,7 @@ Perl_yylex(pTHX) PL_bufptr = s; tmp = *s++; - while (s < PL_bufend && (*s == ' ' || *s == '\t')) + while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; if (strnEQ(s,"=>",2)) { @@ -2926,8 +2973,7 @@ Perl_yylex(pTHX) PL_expect = XTERM; TOKEN('('); case ';': - if (CopLINE(PL_curcop) < PL_copline) - PL_copline = CopLINE(PL_curcop); + CLINE; tmp = *s++; OPERATOR(tmp); case ')': @@ -2971,20 +3017,20 @@ Perl_yylex(pTHX) PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR; OPERATOR(HASHBRACK); case XOPERATOR: - while (s < PL_bufend && (*s == ' ' || *s == '\t')) + while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; d = s; PL_tokenbuf[0] = '\0'; if (d < PL_bufend && *d == '-') { PL_tokenbuf[0] = '-'; d++; - while (d < PL_bufend && (*d == ' ' || *d == '\t')) + while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; } if (d < PL_bufend && isIDFIRST_lazy_if(d,UTF)) { d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE, &len); - while (d < PL_bufend && (*d == ' ' || *d == '\t')) + while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; if (*d == '}') { char minus = (PL_tokenbuf[0] == '-'); @@ -3104,7 +3150,7 @@ Perl_yylex(pTHX) yyerror("Unmatched right curly bracket"); else PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets]; - if (PL_lex_brackets < PL_lex_formbrack) + if (PL_lex_brackets < PL_lex_formbrack && PL_lex_state != LEX_INTERPNORMAL) PL_lex_formbrack = 0; if (PL_lex_state == LEX_INTERPNORMAL) { if (PL_lex_brackets == 0) { @@ -3201,9 +3247,9 @@ Perl_yylex(pTHX) if (PL_lex_brackets < PL_lex_formbrack) { char *t; #ifdef PERL_STRICT_CR - for (t = s; *t == ' ' || *t == '\t'; t++) ; + for (t = s; SPACE_OR_TAB(*t); t++) ; #else - for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ; + for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ; #endif if (*t == '\n' || *t == '#') { s--; @@ -3797,7 +3843,7 @@ Perl_yylex(pTHX) if (*s == '(') { CLINE; if (gv && GvCVu(gv)) { - for (d = s + 1; *d == ' ' || *d == '\t'; d++) ; + for (d = s + 1; SPACE_OR_TAB(*d); d++) ; if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) { s = d + 1; goto its_constant; @@ -4383,7 +4429,7 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3)) goto really_sub; - PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE); + PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len); if (!PL_in_my_stash) { char tmpbuf[1024]; PL_bufptr = s; @@ -4991,6 +5037,9 @@ Perl_yylex(pTHX) } }} } +#ifdef __SC__ +#pragma segment Main +#endif I32 Perl_keyword(pTHX_ register char *d, I32 len) @@ -5093,7 +5142,6 @@ Perl_keyword(pTHX_ register char *d, I32 len) } break; case 'E': - if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;} if (strEQ(d,"END")) return KEY_END; break; case 'e': @@ -5159,12 +5207,6 @@ Perl_keyword(pTHX_ register char *d, I32 len) break; } break; - case 'G': - if (len == 2) { - if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;} - if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;} - } - break; case 'g': if (strnEQ(d,"get",3)) { d += 3; @@ -5264,12 +5306,6 @@ Perl_keyword(pTHX_ register char *d, I32 len) if (strEQ(d,"kill")) return -KEY_kill; } break; - case 'L': - if (len == 2) { - if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;} - if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;} - } - break; case 'l': switch (len) { case 2: @@ -5321,9 +5357,6 @@ Perl_keyword(pTHX_ register char *d, I32 len) break; } break; - case 'N': - if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;} - break; case 'n': if (strEQ(d,"next")) return KEY_next; if (strEQ(d,"ne")) return -KEY_ne; @@ -5864,7 +5897,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if (isSPACE(s[-1])) { while (s < send) { char ch = *s++; - if (ch != ' ' && ch != '\t') { + if (!SPACE_OR_TAB(ch)) { *d = ch; break; } @@ -5890,7 +5923,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des Perl_croak(aTHX_ ident_too_long); } *d = '\0'; - while (s < send && (*s == ' ' || *s == '\t')) s++; + while (s < send && SPACE_OR_TAB(*s)) s++; if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { dTHR; /* only for ckWARN */ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { @@ -6100,45 +6133,20 @@ S_scan_trans(pTHX_ char *start) Perl_croak(aTHX_ "Transliteration replacement not terminated"); } - if (UTF) { - o = newSVOP(OP_TRANS, 0, 0); - utf8 = OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF; - } - else { - New(803,tbl,256,short); - o = newPVOP(OP_TRANS, 0, (char*)tbl); - utf8 = 0; - } + New(803,tbl,256,short); + o = newPVOP(OP_TRANS, 0, (char*)tbl); complement = del = squash = 0; - while (strchr("cdsCU", *s)) { + while (strchr("cds", *s)) { if (*s == 'c') complement = OPpTRANS_COMPLEMENT; else if (*s == 'd') del = OPpTRANS_DELETE; else if (*s == 's') squash = OPpTRANS_SQUASH; - else { - switch (count++) { - case 0: - if (*s == 'C') - utf8 &= ~OPpTRANS_FROM_UTF; - else - utf8 |= OPpTRANS_FROM_UTF; - break; - case 1: - if (*s == 'C') - utf8 &= ~OPpTRANS_TO_UTF; - else - utf8 |= OPpTRANS_TO_UTF; - break; - default: - Perl_croak(aTHX_ "Too many /C and /U options"); - } - } s++; } - o->op_private = del|squash|complement|utf8; + o->op_private = del|squash|complement; PL_lex_op = o; yylval.ival = OP_TRANS; @@ -6164,7 +6172,7 @@ S_scan_heredoc(pTHX_ register char *s) e = PL_tokenbuf + sizeof PL_tokenbuf - 1; if (!outer) *d++ = '\n'; - for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ; + for (peek = s; SPACE_OR_TAB(*peek); peek++) ; if (*peek && strchr("`'\"",*peek)) { s = peek; term = *s++; @@ -7002,7 +7010,9 @@ Perl_scan_num(pTHX_ char *start) Strtol() and Strtoul() are used above. [1] XXX Configure test needed to check for atol() - (and atoll() overflow behaviour) XXX --jhi + (and atoll()) overflow behaviour XXX + + --jhi We need to do this the hard way. */ @@ -7016,14 +7026,16 @@ Perl_scan_num(pTHX_ char *start) don't need to do the conversion at all. [1] Note that this is lossy if our NVs cannot preserve our - UVs. There is a metaconfig define, NV_PRESERVES_UV, but we - really do hope all such platforms have strtou?ll? to do a - lossless IV/UV conversion. - XXX Configure test needed to check how many UV bits - do our NVs preserve, really (the current test checks - for the roundtrip of ~0) XXX --jhi - Maybe do some tricks with DBL_MANT_DIG and LDBL_MANT_DIG, - and DBL_DIG, LDBL_DIG (this is already available as NV_DIG)? + UVs. There are metaconfig defines NV_PRESERVES_UV (a boolean) + and NV_PRESERVES_UV_BITS (a number), but in general we really + do hope all such potentially lossy platforms have strtou?ll? + to do a lossless IV/UV conversion. + + Maybe could do some tricks with DBL_DIG, LDBL_DIG and + DBL_MANT_DIG and LDBL_MANT_DIG (these are already available + as NV_DIG and NV_MANT_DIG)? + + --jhi */ { UV uv = U_V(nv); @@ -7126,12 +7138,12 @@ S_scan_formline(pTHX_ register char *s) bool needargs = FALSE; while (!needargs) { - if (*s == '.' || *s == '}') { + if (*s == '.' || *s == /*{*/'}') { /*SUPPRESS 530*/ #ifdef PERL_STRICT_CR - for (t = s+1;*t == ' ' || *t == '\t'; t++) ; + for (t = s+1;SPACE_OR_TAB(*t); t++) ; #else - for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ; + for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ; #endif if (*t == '\n' || t == PL_bufend) break; @@ -7354,6 +7366,80 @@ Perl_yyerror(pTHX_ char *s) return 0; } +STATIC char* +S_swallow_bom(pTHX_ U8 *s) +{ + STRLEN slen; + slen = SvCUR(PL_linestr); + switch (*s) { + case 0xFF: + if (s[1] == 0xFE) { + /* UTF-16 little-endian */ + if (s[2] == 0 && s[3] == 0) /* UTF-32 little-endian */ + Perl_croak(aTHX_ "Unsupported script encoding"); +#ifndef PERL_NO_UTF16_FILTER + DEBUG_p(PerlIO_printf(Perl_debug_log, "UTF-LE script encoding\n")); + s += 2; + if (PL_bufend > (char*)s) { + U8 *news; + I32 newlen; + + filter_add(utf16rev_textfilter, NULL); + New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8); + PL_bufend = (char*)utf16_to_utf8_reversed(s, news, + PL_bufend - (char*)s - 1, + &newlen); + Copy(news, s, newlen, U8); + SvCUR_set(PL_linestr, newlen); + PL_bufend = SvPVX(PL_linestr) + newlen; + news[newlen++] = '\0'; + Safefree(news); + } +#else + Perl_croak(aTHX_ "Unsupported script encoding"); +#endif + } + break; + case 0xFE: + if (s[1] == 0xFF) { /* UTF-16 big-endian */ +#ifndef PERL_NO_UTF16_FILTER + DEBUG_p(PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding\n")); + s += 2; + if (PL_bufend > (char *)s) { + U8 *news; + I32 newlen; + + filter_add(utf16_textfilter, NULL); + New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8); + PL_bufend = (char*)utf16_to_utf8(s, news, + PL_bufend - (char*)s, + &newlen); + Copy(news, s, newlen, U8); + SvCUR_set(PL_linestr, newlen); + PL_bufend = SvPVX(PL_linestr) + newlen; + news[newlen++] = '\0'; + Safefree(news); + } +#else + Perl_croak(aTHX_ "Unsupported script encoding"); +#endif + } + break; + case 0xEF: + if (slen > 2 && s[1] == 0xBB && s[2] == 0xBF) { + DEBUG_p(PerlIO_printf(Perl_debug_log, "UTF-8 script encoding\n")); + s += 3; /* UTF-8 */ + } + break; + case 0: + if (slen > 3 && s[1] == 0 && /* UTF-32 big-endian */ + s[2] == 0xFE && s[3] == 0xFF) + { + Perl_croak(aTHX_ "Unsupported script encoding"); + } + } + return (char*)s; +} #ifdef PERL_OBJECT #include "XSUB.h" @@ -7375,3 +7461,43 @@ restore_rsfp(pTHXo_ void *f) PerlIO_close(PL_rsfp); PL_rsfp = fp; } + +#ifndef PERL_NO_UTF16_FILTER +static I32 +utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen) +{ + I32 count = FILTER_READ(idx+1, sv, maxlen); + if (count) { + U8* tmps; + U8* tend; + I32 newlen; + New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); + if (!*SvPV_nolen(sv)) + /* Game over, but don't feed an odd-length string to utf16_to_utf8 */ + return count; + + tend = utf16_to_utf8((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen); + sv_usepvn(sv, (char*)tmps, tend - tmps); + } + return count; +} + +static I32 +utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen) +{ + I32 count = FILTER_READ(idx+1, sv, maxlen); + if (count) { + U8* tmps; + U8* tend; + I32 newlen; + if (!*SvPV_nolen(sv)) + /* Game over, but don't feed an odd-length string to utf16_to_utf8 */ + return count; + + New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); + tend = utf16_to_utf8_reversed((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen); + sv_usepvn(sv, (char*)tmps, tend - tmps); + } + return count; +} +#endif diff --git a/uconfig.h b/uconfig.h new file mode 100644 index 0000000000..5cd5cd53ff --- /dev/null +++ b/uconfig.h @@ -0,0 +1,3129 @@ +/* + * This file was produced by running the config_h.SH script, which + * gets its values from uconfig.sh, which is generally produced by + * running Configure. + * + * Feel free to modify any of this as the need arises. Note, however, + * that running config_h.SH again will wipe out any changes you've made. + * For a more permanent change edit uconfig.sh and rerun config_h.SH. + * + * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ + */ + +/* + * Package name : + * Source directory : + * Configuration time: + * Configured by : + * Target system : unknown + */ + +#ifndef _config_h_ +#define _config_h_ + +/* LOC_SED: + * This symbol holds the complete pathname to the sed program. + */ +#define LOC_SED "" /**/ + +/* HAS_ALARM: + * This symbol, if defined, indicates that the alarm routine is + * available. + */ +/*#define HAS_ALARM / **/ + +/* HASATTRIBUTE: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. This is normally only supported by GNU cc. + */ +/*#define HASATTRIBUTE / **/ +#ifndef HASATTRIBUTE +#define __attribute__(_arg_) +#endif + +/* HAS_BCMP: + * This symbol is defined if the bcmp() routine is available to + * compare blocks of memory. + */ +/*#define HAS_BCMP / **/ + +/* HAS_BCOPY: + * This symbol is defined if the bcopy() routine is available to + * copy blocks of memory. + */ +/*#define HAS_BCOPY / **/ + +/* HAS_BZERO: + * This symbol is defined if the bzero() routine is available to + * set a memory block to 0. + */ +/*#define HAS_BZERO / **/ + +/* HAS_CHOWN: + * This symbol, if defined, indicates that the chown routine is + * available. + */ +/*#define HAS_CHOWN / **/ + +/* HAS_CHROOT: + * This symbol, if defined, indicates that the chroot routine is + * available. + */ +/*#define HAS_CHROOT / **/ + +/* HAS_CHSIZE: + * This symbol, if defined, indicates that the chsize routine is available + * to truncate files. You might need a -lx to get this routine. + */ +/*#define HAS_CHSIZE / **/ + +/* HASCONST: + * This symbol, if defined, indicates that this C compiler knows about + * the const type. There is no need to actually test for that symbol + * within your programs. The mere use of the "const" keyword will + * trigger the necessary tests. + */ +/*#define HASCONST / **/ +#ifndef HASCONST +#define const +#endif + +/* HAS_CRYPT: + * This symbol, if defined, indicates that the crypt routine is available + * to encrypt passwords and the like. + */ +/*#define HAS_CRYPT / **/ + +/* HAS_CUSERID: + * This symbol, if defined, indicates that the cuserid routine is + * available to get character login names. + */ +/*#define HAS_CUSERID / **/ + +/* HAS_DBL_DIG: + * This symbol, if defined, indicates that this system's <float.h> + * or <limits.h> defines the symbol DBL_DIG, which is the number + * of significant digits in a double precision number. If this + * symbol is not defined, a guess of 15 is usually pretty good. + */ +/*#define HAS_DBL_DIG / * */ + +/* HAS_DIFFTIME: + * This symbol, if defined, indicates that the difftime routine is + * available. + */ +/*#define HAS_DIFFTIME / **/ + +/* HAS_DLERROR: + * This symbol, if defined, indicates that the dlerror routine is + * available to return a string describing the last error that + * occurred from a call to dlopen(), dlclose() or dlsym(). + */ +/*#define HAS_DLERROR / **/ + +/* SETUID_SCRIPTS_ARE_SECURE_NOW: + * This symbol, if defined, indicates that the bug that prevents + * setuid scripts from being secure is not present in this kernel. + */ +/* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ +/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/ +/*#define DOSUID / **/ + +/* HAS_DUP2: + * This symbol, if defined, indicates that the dup2 routine is + * available to duplicate file descriptors. + */ +/*#define HAS_DUP2 / **/ + +/* HAS_FCHMOD: + * This symbol, if defined, indicates that the fchmod routine is available + * to change mode of opened files. If unavailable, use chmod(). + */ +/*#define HAS_FCHMOD / **/ + +/* HAS_FCHOWN: + * This symbol, if defined, indicates that the fchown routine is available + * to change ownership of opened files. If unavailable, use chown(). + */ +/*#define HAS_FCHOWN / **/ + +/* HAS_FCNTL: + * This symbol, if defined, indicates to the C program that + * the fcntl() function exists. + */ +/*#define HAS_FCNTL / **/ + +/* HAS_FGETPOS: + * This symbol, if defined, indicates that the fgetpos routine is + * available to get the file position indicator, similar to ftell(). + */ +/*#define HAS_FGETPOS / **/ + +/* HAS_FLOCK: + * This symbol, if defined, indicates that the flock routine is + * available to do file locking. + */ +/*#define HAS_FLOCK / **/ + +/* HAS_FORK: + * This symbol, if defined, indicates that the fork routine is + * available. + */ +#define HAS_FORK /**/ + +/* HAS_FSETPOS: + * This symbol, if defined, indicates that the fsetpos routine is + * available to set the file position indicator, similar to fseek(). + */ +/*#define HAS_FSETPOS / **/ + +/* HAS_GETTIMEOFDAY: + * This symbol, if defined, indicates that the gettimeofday() system + * call is available for a sub-second accuracy clock. Usually, the file + * <sys/resource.h> needs to be included (see I_SYS_RESOURCE). + * The type "Timeval" should be used to refer to "struct timeval". + */ +/*#define HAS_GETTIMEOFDAY / **/ +#ifdef HAS_GETTIMEOFDAY +#define Timeval struct timeval /* Structure used by gettimeofday() */ +#endif + +/* HAS_GETGROUPS: + * This symbol, if defined, indicates that the getgroups() routine is + * available to get the list of process groups. If unavailable, multiple + * groups are probably not supported. + */ +/*#define HAS_GETGROUPS / **/ + +/* HAS_GETLOGIN: + * This symbol, if defined, indicates that the getlogin routine is + * available to get the login name. + */ +/*#define HAS_GETLOGIN / **/ + +/* HAS_GETPGID: + * This symbol, if defined, indicates to the C program that + * the getpgid(pid) function is available to get the + * process group id. + */ +/*#define HAS_GETPGID / **/ + +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. + */ +/* USE_BSD_GETPGRP: + * This symbol, if defined, indicates that getpgrp needs one + * arguments whereas USG one needs none. + */ +/*#define HAS_GETPGRP / **/ +/*#define USE_BSD_GETPGRP / **/ + +/* HAS_GETPGRP2: + * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) + * routine is available to get the current process group. + */ +/*#define HAS_GETPGRP2 / **/ + +/* HAS_GETPPID: + * This symbol, if defined, indicates that the getppid routine is + * available to get the parent process ID. + */ +/*#define HAS_GETPPID / **/ + +/* HAS_GETPRIORITY: + * This symbol, if defined, indicates that the getpriority routine is + * available to get a process's priority. + */ +/*#define HAS_GETPRIORITY / **/ + +/* HAS_INET_ATON: + * This symbol, if defined, indicates to the C program that the + * inet_aton() function is available to parse IP address "dotted-quad" + * strings. + */ +/*#define HAS_INET_ATON / **/ + +/* HAS_KILLPG: + * This symbol, if defined, indicates that the killpg routine is available + * to kill process groups. If unavailable, you probably should use kill + * with a negative process number. + */ +/*#define HAS_KILLPG / **/ + +/* HAS_LINK: + * This symbol, if defined, indicates that the link routine is + * available to create hard links. + */ +/*#define HAS_LINK / **/ + +/* HAS_LOCALECONV: + * This symbol, if defined, indicates that the localeconv routine is + * available for numeric and monetary formatting conventions. + */ +/*#define HAS_LOCALECONV / **/ + +/* HAS_LOCKF: + * This symbol, if defined, indicates that the lockf routine is + * available to do file locking. + */ +/*#define HAS_LOCKF / **/ + +/* HAS_LSTAT: + * This symbol, if defined, indicates that the lstat routine is + * available to do file stats on symbolic links. + */ +/*#define HAS_LSTAT / **/ + +/* HAS_MBLEN: + * This symbol, if defined, indicates that the mblen routine is available + * to find the number of bytes in a multibye character. + */ +/*#define HAS_MBLEN / **/ + +/* HAS_MBSTOWCS: + * This symbol, if defined, indicates that the mbstowcs routine is + * available to covert a multibyte string into a wide character string. + */ +/*#define HAS_MBSTOWCS / **/ + +/* HAS_MBTOWC: + * This symbol, if defined, indicates that the mbtowc routine is available + * to covert a multibyte to a wide character. + */ +/*#define HAS_MBTOWC / **/ + +/* HAS_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * to compare blocks of memory. + */ +/*#define HAS_MEMCMP / **/ + +/* HAS_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy blocks of memory. + */ +/*#define HAS_MEMCPY / **/ + +/* HAS_MEMMOVE: + * This symbol, if defined, indicates that the memmove routine is available + * to copy potentially overlapping blocks of memory. This should be used + * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your + * own version. + */ +/*#define HAS_MEMMOVE / **/ + +/* HAS_MEMSET: + * This symbol, if defined, indicates that the memset routine is available + * to set blocks of memory. + */ +/*#define HAS_MEMSET / **/ + +/* HAS_MKDIR: + * This symbol, if defined, indicates that the mkdir routine is available + * to create directories. Otherwise you should fork off a new process to + * exec /bin/mkdir. + */ +/*#define HAS_MKDIR / **/ + +/* HAS_MKFIFO: + * This symbol, if defined, indicates that the mkfifo routine is + * available to create FIFOs. Otherwise, mknod should be able to + * do it for you. However, if mkfifo is there, mknod might require + * super-user privileges which mkfifo will not. + */ +/*#define HAS_MKFIFO / **/ + +/* HAS_MKTIME: + * This symbol, if defined, indicates that the mktime routine is + * available. + */ +/*#define HAS_MKTIME / **/ + +/* HAS_MSYNC: + * This symbol, if defined, indicates that the msync system call is + * available to synchronize a mapped file. + */ +/*#define HAS_MSYNC / **/ + +/* HAS_MUNMAP: + * This symbol, if defined, indicates that the munmap system call is + * available to unmap a region, usually mapped by mmap(). + */ +/*#define HAS_MUNMAP / **/ + +/* HAS_NICE: + * This symbol, if defined, indicates that the nice routine is + * available. + */ +/*#define HAS_NICE / **/ + +/* HAS_PATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given filename. + */ +/* HAS_FPATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given open file descriptor. + */ +/*#define HAS_PATHCONF / **/ +/*#define HAS_FPATHCONF / **/ + +/* HAS_PAUSE: + * This symbol, if defined, indicates that the pause routine is + * available to suspend a process until a signal is received. + */ +/*#define HAS_PAUSE / **/ + +/* HAS_PIPE: + * This symbol, if defined, indicates that the pipe routine is + * available to create an inter-process channel. + */ +/*#define HAS_PIPE / **/ + +/* HAS_POLL: + * This symbol, if defined, indicates that the poll routine is + * available to poll active file descriptors. You may safely + * include <poll.h> when this symbol is defined. + */ +/*#define HAS_POLL / **/ + +/* HAS_READDIR: + * This symbol, if defined, indicates that the readdir routine is + * available to read directory entries. You may have to include + * <dirent.h>. See I_DIRENT. + */ +/*#define HAS_READDIR / **/ + +/* HAS_SEEKDIR: + * This symbol, if defined, indicates that the seekdir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +/*#define HAS_SEEKDIR / **/ + +/* HAS_TELLDIR: + * This symbol, if defined, indicates that the telldir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +/*#define HAS_TELLDIR / **/ + +/* HAS_REWINDDIR: + * This symbol, if defined, indicates that the rewinddir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +/*#define HAS_REWINDDIR / **/ + +/* HAS_READLINK: + * This symbol, if defined, indicates that the readlink routine is + * available to read the value of a symbolic link. + */ +/*#define HAS_READLINK / **/ + +/* HAS_RENAME: + * This symbol, if defined, indicates that the rename routine is available + * to rename files. Otherwise you should do the unlink(), link(), unlink() + * trick. + */ +/*#define HAS_RENAME / **/ + +/* HAS_RMDIR: + * This symbol, if defined, indicates that the rmdir routine is + * available to remove directories. Otherwise you should fork off a + * new process to exec /bin/rmdir. + */ +/*#define HAS_RMDIR / **/ + +/* HAS_SELECT: + * This symbol, if defined, indicates that the select routine is + * available to select active file descriptors. If the timeout field + * is used, <sys/time.h> may need to be included. + */ +/*#define HAS_SELECT / **/ + +/* HAS_SETEGID: + * This symbol, if defined, indicates that the setegid routine is available + * to change the effective gid of the current program. + */ +/*#define HAS_SETEGID / **/ + +/* HAS_SETEUID: + * This symbol, if defined, indicates that the seteuid routine is available + * to change the effective uid of the current program. + */ +/*#define HAS_SETEUID / **/ + +/* HAS_SETLINEBUF: + * This symbol, if defined, indicates that the setlinebuf routine is + * available to change stderr or stdout from block-buffered or unbuffered + * to a line-buffered mode. + */ +/*#define HAS_SETLINEBUF / **/ + +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +/*#define HAS_SETLOCALE / **/ + +/* HAS_SETPGID: + * This symbol, if defined, indicates that the setpgid(pid, gpid) + * routine is available to set process group ID. + */ +/*#define HAS_SETPGID / **/ + +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. + */ +/* USE_BSD_SETPGRP: + * This symbol, if defined, indicates that setpgrp needs two + * arguments whereas USG one needs none. See also HAS_SETPGID + * for a POSIX interface. + */ +/*#define HAS_SETPGRP / **/ +/*#define USE_BSD_SETPGRP / **/ + +/* HAS_SETPGRP2: + * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) + * routine is available to set the current process group. + */ +/*#define HAS_SETPGRP2 / **/ + +/* HAS_SETPRIORITY: + * This symbol, if defined, indicates that the setpriority routine is + * available to set a process's priority. + */ +/*#define HAS_SETPRIORITY / **/ + +/* HAS_SETREGID: + * This symbol, if defined, indicates that the setregid routine is + * available to change the real and effective gid of the current + * process. + */ +/* HAS_SETRESGID: + * This symbol, if defined, indicates that the setresgid routine is + * available to change the real, effective and saved gid of the current + * process. + */ +/*#define HAS_SETREGID / **/ +/*#define HAS_SETRESGID / **/ + +/* HAS_SETREUID: + * This symbol, if defined, indicates that the setreuid routine is + * available to change the real and effective uid of the current + * process. + */ +/* HAS_SETRESUID: + * This symbol, if defined, indicates that the setresuid routine is + * available to change the real, effective and saved uid of the current + * process. + */ +/*#define HAS_SETREUID / **/ +/*#define HAS_SETRESUID / **/ + +/* HAS_SETRGID: + * This symbol, if defined, indicates that the setrgid routine is available + * to change the real gid of the current program. + */ +/*#define HAS_SETRGID / **/ + +/* HAS_SETRUID: + * This symbol, if defined, indicates that the setruid routine is available + * to change the real uid of the current program. + */ +/*#define HAS_SETRUID / **/ + +/* HAS_SETSID: + * This symbol, if defined, indicates that the setsid routine is + * available to set the process group ID. + */ +/*#define HAS_SETSID / **/ + +/* Shmat_t: + * This symbol holds the return type of the shmat() system call. + * Usually set to 'void *' or 'char *'. + */ +/* HAS_SHMAT_PROTOTYPE: + * This symbol, if defined, indicates that the sys/shm.h includes + * a prototype for shmat(). Otherwise, it is up to the program to + * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess, + * but not always right so it should be emitted by the program only + * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. + */ +#define Shmat_t void * /**/ +/*#define HAS_SHMAT_PROTOTYPE / **/ + +/* HAS_STRCHR: + * This symbol is defined to indicate that the strchr()/strrchr() + * functions are available for string searching. If not, try the + * index()/rindex() pair. + */ +/* HAS_INDEX: + * This symbol is defined to indicate that the index()/rindex() + * functions are available for string searching. + */ +/*#define HAS_STRCHR / **/ +/*#define HAS_INDEX / **/ + +/* HAS_STRCOLL: + * This symbol, if defined, indicates that the strcoll routine is + * available to compare strings using collating information. + */ +/*#define HAS_STRCOLL / **/ + +/* USE_STRUCT_COPY: + * This symbol, if defined, indicates that this C compiler knows how + * to copy structures. If undefined, you'll need to use a block copy + * routine of some sort instead. + */ +/*#define USE_STRUCT_COPY / **/ + +/* HAS_STRTOD: + * This symbol, if defined, indicates that the strtod routine is + * available to provide better numeric string conversion than atof(). + */ +/*#define HAS_STRTOD / **/ + +/* HAS_STRTOL: + * This symbol, if defined, indicates that the strtol routine is available + * to provide better numeric string conversion than atoi() and friends. + */ +/*#define HAS_STRTOL / **/ + +/* HAS_STRTOUL: + * This symbol, if defined, indicates that the strtoul routine is + * available to provide conversion of strings to unsigned long. + */ +/*#define HAS_STRTOUL / **/ + +/* HAS_STRXFRM: + * This symbol, if defined, indicates that the strxfrm() routine is + * available to transform strings. + */ +/*#define HAS_STRXFRM / **/ + +/* HAS_SYMLINK: + * This symbol, if defined, indicates that the symlink routine is available + * to create symbolic links. + */ +/*#define HAS_SYMLINK / **/ + +/* HAS_SYSCALL: + * This symbol, if defined, indicates that the syscall routine is + * available to call arbitrary system calls. If undefined, that's tough. + */ +/*#define HAS_SYSCALL / **/ + +/* HAS_SYSCONF: + * This symbol, if defined, indicates that sysconf() is available + * to determine system related limits and options. + */ +/*#define HAS_SYSCONF / **/ + +/* HAS_SYSTEM: + * This symbol, if defined, indicates that the system routine is + * available to issue a shell command. + */ +/*#define HAS_SYSTEM / **/ + +/* HAS_TCGETPGRP: + * This symbol, if defined, indicates that the tcgetpgrp routine is + * available to get foreground process group ID. + */ +/*#define HAS_TCGETPGRP / **/ + +/* HAS_TCSETPGRP: + * This symbol, if defined, indicates that the tcsetpgrp routine is + * available to set foreground process group ID. + */ +/*#define HAS_TCSETPGRP / **/ + +/* HAS_TRUNCATE: + * This symbol, if defined, indicates that the truncate routine is + * available to truncate files. + */ +/*#define HAS_TRUNCATE / **/ + +/* HAS_TZNAME: + * This symbol, if defined, indicates that the tzname[] array is + * available to access timezone names. + */ +/*#define HAS_TZNAME / **/ + +/* HAS_UMASK: + * This symbol, if defined, indicates that the umask routine is + * available to set and get the value of the file creation mask. + */ +/*#define HAS_UMASK / **/ + +/* HASVOLATILE: + * This symbol, if defined, indicates that this C compiler knows about + * the volatile declaration. + */ +/*#define HASVOLATILE / **/ +#ifndef HASVOLATILE +#define volatile +#endif + +/* HAS_WAIT4: + * This symbol, if defined, indicates that wait4() exists. + */ +/*#define HAS_WAIT4 / **/ + +/* HAS_WAITPID: + * This symbol, if defined, indicates that the waitpid routine is + * available to wait for child process. + */ +/*#define HAS_WAITPID / **/ + +/* HAS_WCSTOMBS: + * This symbol, if defined, indicates that the wcstombs routine is + * available to convert wide character strings to multibyte strings. + */ +/*#define HAS_WCSTOMBS / **/ + +/* HAS_WCTOMB: + * This symbol, if defined, indicates that the wctomb routine is available + * to covert a wide character to a multibyte. + */ +/*#define HAS_WCTOMB / **/ + +/* I_ARPA_INET: + * This symbol, if defined, indicates to the C program that it should + * include <arpa/inet.h> to get inet_addr and friends declarations. + */ +/*#define I_ARPA_INET / **/ + +/* I_DBM: + * This symbol, if defined, indicates that <dbm.h> exists and should + * be included. + */ +/* I_RPCSVC_DBM: + * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and + * should be included. + */ +/*#define I_DBM / **/ +/*#define I_RPCSVC_DBM / **/ + +/* I_DIRENT: + * This symbol, if defined, indicates to the C program that it should + * include <dirent.h>. Using this symbol also triggers the definition + * of the Direntry_t define which ends up being 'struct dirent' or + * 'struct direct' depending on the availability of <dirent.h>. + */ +/* DIRNAMLEN: + * This symbol, if defined, indicates to the C program that the length + * of directory entry names is provided by a d_namlen field. Otherwise + * you need to do strlen() on the d_name field. + */ +/* Direntry_t: + * This symbol is set to 'struct direct' or 'struct dirent' depending on + * whether dirent is available or not. You should use this pseudo type to + * portably declare your directory entries. + */ +/*#define I_DIRENT / **/ +/*#define DIRNAMLEN / **/ +#define Direntry_t struct dirent + +/* I_DLFCN: + * This symbol, if defined, indicates that <dlfcn.h> exists and should + * be included. + */ +/*#define I_DLFCN / **/ + +/* I_FCNTL: + * This manifest constant tells the C program to include <fcntl.h>. + */ +/*#define I_FCNTL / **/ + +/* I_FLOAT: + * This symbol, if defined, indicates to the C program that it should + * include <float.h> to get definition of symbols like DBL_MAX or + * DBL_MIN, i.e. machine dependent floating point values. + */ +/*#define I_FLOAT / **/ + +/* I_LIMITS: + * This symbol, if defined, indicates to the C program that it should + * include <limits.h> to get definition of symbols like WORD_BIT or + * LONG_MAX, i.e. machine dependant limitations. + */ +/*#define I_LIMITS / **/ + +/* I_LOCALE: + * This symbol, if defined, indicates to the C program that it should + * include <locale.h>. + */ +/*#define I_LOCALE / **/ + +/* I_MATH: + * This symbol, if defined, indicates to the C program that it should + * include <math.h>. + */ +/*#define I_MATH / **/ + +/* I_MEMORY: + * This symbol, if defined, indicates to the C program that it should + * include <memory.h>. + */ +/*#define I_MEMORY / **/ + +/* I_NDBM: + * This symbol, if defined, indicates that <ndbm.h> exists and should + * be included. + */ +/*#define I_NDBM / **/ + +/* I_NET_ERRNO: + * This symbol, if defined, indicates that <net/errno.h> exists and + * should be included. + */ +/*#define I_NET_ERRNO / **/ + +/* I_NETINET_IN: + * This symbol, if defined, indicates to the C program that it should + * include <netinet/in.h>. Otherwise, you may try <sys/in.h>. + */ +/*#define I_NETINET_IN / **/ + +/* I_SFIO: + * This symbol, if defined, indicates to the C program that it should + * include <sfio.h>. + */ +/*#define I_SFIO / **/ + +/* I_STDDEF: + * This symbol, if defined, indicates that <stddef.h> exists and should + * be included. + */ +/*#define I_STDDEF / **/ + +/* I_STDLIB: + * This symbol, if defined, indicates that <stdlib.h> exists and should + * be included. + */ +/*#define I_STDLIB / **/ + +/* I_STRING: + * This symbol, if defined, indicates to the C program that it should + * include <string.h> (USG systems) instead of <strings.h> (BSD systems). + */ +#define I_STRING /**/ + +/* I_SYS_DIR: + * This symbol, if defined, indicates to the C program that it should + * include <sys/dir.h>. + */ +/*#define I_SYS_DIR / **/ + +/* I_SYS_FILE: + * This symbol, if defined, indicates to the C program that it should + * include <sys/file.h> to get definition of R_OK and friends. + */ +/*#define I_SYS_FILE / **/ + +/* I_SYS_IOCTL: + * This symbol, if defined, indicates that <sys/ioctl.h> exists and should + * be included. Otherwise, include <sgtty.h> or <termio.h>. + */ +/*#define I_SYS_IOCTL / **/ + +/* I_SYS_NDIR: + * This symbol, if defined, indicates to the C program that it should + * include <sys/ndir.h>. + */ +/*#define I_SYS_NDIR / **/ + +/* I_SYS_PARAM: + * This symbol, if defined, indicates to the C program that it should + * include <sys/param.h>. + */ +/*#define I_SYS_PARAM / **/ + +/* I_SYS_RESOURCE: + * This symbol, if defined, indicates to the C program that it should + * include <sys/resource.h>. + */ +/*#define I_SYS_RESOURCE / **/ + +/* I_SYS_SELECT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/select.h> in order to get definition of struct timeval. + */ +/*#define I_SYS_SELECT / **/ + +/* I_SYS_STAT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/stat.h>. + */ +#define I_SYS_STAT /**/ + +/* I_SYS_TIMES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/times.h>. + */ +/*#define I_SYS_TIMES / **/ + +/* I_SYS_TYPES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/types.h>. + */ +/*#define I_SYS_TYPES / **/ + +/* I_SYS_UN: + * This symbol, if defined, indicates to the C program that it should + * include <sys/un.h> to get UNIX domain socket definitions. + */ +/*#define I_SYS_UN / **/ + +/* I_SYS_WAIT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/wait.h>. + */ +/*#define I_SYS_WAIT / **/ + +/* I_TERMIO: + * This symbol, if defined, indicates that the program should include + * <termio.h> rather than <sgtty.h>. There are also differences in + * the ioctl() calls that depend on the value of this symbol. + */ +/* I_TERMIOS: + * This symbol, if defined, indicates that the program should include + * the POSIX termios.h rather than sgtty.h or termio.h. + * There are also differences in the ioctl() calls that depend on the + * value of this symbol. + */ +/* I_SGTTY: + * This symbol, if defined, indicates that the program should include + * <sgtty.h> rather than <termio.h>. There are also differences in + * the ioctl() calls that depend on the value of this symbol. + */ +/*#define I_TERMIO / **/ +/*#define I_TERMIOS / **/ +/*#define I_SGTTY / **/ + +/* I_UNISTD: + * This symbol, if defined, indicates to the C program that it should + * include <unistd.h>. + */ +/*#define I_UNISTD / **/ + +/* I_UTIME: + * This symbol, if defined, indicates to the C program that it should + * include <utime.h>. + */ +/*#define I_UTIME / **/ + +/* I_VALUES: + * This symbol, if defined, indicates to the C program that it should + * include <values.h> to get definition of symbols like MINFLOAT or + * MAXLONG, i.e. machine dependant limitations. Probably, you + * should use <limits.h> instead, if it is available. + */ +/*#define I_VALUES / **/ + +/* I_STDARG: + * This symbol, if defined, indicates that <stdarg.h> exists and should + * be included. + */ +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include <varargs.h>. + */ +#define I_STDARG /**/ +/*#define I_VARARGS / **/ + +/* I_VFORK: + * This symbol, if defined, indicates to the C program that it should + * include vfork.h. + */ +/*#define I_VFORK / **/ + +/* CAN_PROTOTYPE: + * If defined, this macro indicates that the C compiler can handle + * function prototypes. + */ +/* _: + * This macro is used to declare function parameters for folks who want + * to make declarations with prototypes using a different style than + * the above macros. Use double parentheses. For example: + * + * int main _((int argc, char *argv[])); + */ +/*#define CAN_PROTOTYPE / **/ +#ifdef CAN_PROTOTYPE +#define _(args) args +#else +#define _(args) () +#endif + +/* SH_PATH: + * This symbol contains the full pathname to the shell used on this + * on this system to execute Bourne shell scripts. Usually, this will be + * /bin/sh, though it's possible that some systems will have /bin/ksh, + * /bin/pdksh, /bin/ash, /bin/bash, or even something such as + * D:/bin/sh.exe. + */ +#define SH_PATH "" /**/ + +/* STDCHAR: + * This symbol is defined to be the type of char used in stdio.h. + * It has the values "unsigned char" or "char". + */ +#define STDCHAR char /**/ + +/* CROSSCOMPILE: + * This symbol, if defined, signifies that we our + * build process is a cross-compilation. + */ +/*#define CROSSCOMPILE / **/ + +/* INTSIZE: + * This symbol contains the value of sizeof(int) so that the C + * preprocessor can make decisions based on it. + */ +/* LONGSIZE: + * This symbol contains the value of sizeof(long) so that the C + * preprocessor can make decisions based on it. + */ +/* SHORTSIZE: + * This symbol contains the value of sizeof(short) so that the C + * preprocessor can make decisions based on it. + */ +#define INTSIZE 1 /**/ +#define LONGSIZE 1 /**/ +#define SHORTSIZE 1 /**/ + +/* MULTIARCH: + * This symbol, if defined, signifies that the build + * process will produce some binary files that are going to be + * used in a cross-platform environment. This is the case for + * example with the NeXT "fat" binaries that contain executables + * for several CPUs. + */ +/*#define MULTIARCH / **/ + +/* HAS_QUAD: + * This symbol, if defined, tells that there's a 64-bit integer type, + * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one + * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T. + */ +/*#define HAS_QUAD / **/ +#ifdef HAS_QUAD +# define Quad_t int64_t /**/ +# define Uquad_t uint64_t /**/ +# define QUADKIND 4 /**/ +# define QUAD_IS_INT 1 +# define QUAD_IS_LONG 2 +# define QUAD_IS_LONG_LONG 3 +# define QUAD_IS_INT64_T 4 +#endif + +/* HAS_ACCESSX: + * This symbol, if defined, indicates that the accessx routine is + * available to do extended access checks. + */ +/*#define HAS_ACCESSX / **/ + +/* HAS_EACCESS: + * This symbol, if defined, indicates that the eaccess routine is + * available to do extended access checks. + */ +/*#define HAS_EACCESS / **/ + +/* I_SYS_ACCESS: + * This symbol, if defined, indicates to the C program that it should + * include <sys/access.h>. + */ +/*#define I_SYS_ACCESS / **/ + +/* I_SYS_SECURITY: + * This symbol, if defined, indicates to the C program that it should + * include <sys/security.h>. + */ +/*#define I_SYS_SECURITY / **/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "unknown" /**/ + +/* MEM_ALIGNBYTES: + * This symbol contains the number of bytes required to align a + * double, or a long double when applicable. Usual values are 2, + * 4 and 8. The default is eight, for safety. + */ +#if defined(CROSSCOMPILE) || defined(MULTIARCH) +# define MEM_ALIGNBYTES 8 +#else +#define MEM_ALIGNBYTES 4 +#endif + +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for . It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define ARCHLIB "/usr/local/lib/perl5/5.6/unknown" / **/ +/*#define ARCHLIB_EXP "/usr/local/lib/perl5/5.6/unknown" / **/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "unknown" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF / **/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL / **/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "/usr/local/bin" /**/ +#define BIN_EXP "" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that this version of Perl should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always + * for those versions. + */ +/*#define PERL_BINCOMPAT_5005 / **/ + +/* BYTEORDER: + * This symbol holds the hexadecimal constant defined in byteorder, + * i.e. 0x1234 or 0x4321, etc... + * If the compiler supports cross-compiling or multiple-architecture + * binaries (eg. on NeXT systems), use compiler-defined macros to + * determine the byte order. + * On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture + * Binaries (MAB) on either big endian or little endian machines. + * The endian-ness is available at compile-time. This only matters + * for perl, where the config.h can be generated and installed on + * one system, and used by a different architecture to build an + * extension. Older versions of NeXT that might not have + * defined either *_ENDIAN__ were all on Motorola 680x0 series, + * so the default case (for NeXT) is big endian to catch them. + * This might matter for NeXT 3.0. + */ +#if defined(CROSSCOMPILE) || defined(MULTIARCH) +# ifdef __LITTLE_ENDIAN__ +# if LONGSIZE == 4 +# define BYTEORDER 0x1234 +# else +# if LONGSIZE == 8 +# define BYTEORDER 0x12345678 +# endif +# endif +# else +# ifdef __BIG_ENDIAN__ +# if LONGSIZE == 4 +# define BYTEORDER 0x4321 +# else +# if LONGSIZE == 8 +# define BYTEORDER 0x87654321 +# endif +# endif +# endif +# endif +# if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__)) +# define BYTEORDER 0x4321 +# endif +#else +#define BYTEORDER 0x12 /* large digits for MSB */ +#endif /* NeXT */ + +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if 42 == 1 +# define CAT2(a,b) a/**/b +# define STRINGIFY(a) "a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if 42 == 42 +# define PeRl_CaTiFy(a, b) a ## b +# define PeRl_StGiFy(a) #a +/* the additional level of indirection enables these macros to be + * used as arguments to other macros. See K&R 2nd ed., page 231. */ +# define CAT2(a,b) PeRl_CaTiFy(a,b) +# define StGiFy(a) PeRl_StGiFy(a) +# define STRINGIFY(a) PeRl_StGiFy(a) +#endif +#if 42 != 1 && 42 != 42 +# include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +/* CPPRUN: + * This symbol contains the string which will invoke a C preprocessor on + * the standard input and produce to standard output. It needs to end + * with CPPLAST, after all other preprocessor flags have been specified. + * The main difference with CPPSTDIN is that this program will never be a + * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is + * available directly to the user. Note that it may well be different from + * the preprocessor used to compile the C program. + */ +/* CPPLAST: + * This symbol is intended to be used along with CPPRUN in the same manner + * symbol CPPMINUS is used with CPPSTDIN. It contains either "-" or "". + */ +#define CPPSTDIN "" +#define CPPMINUS "" +#define CPPRUN "" +#define CPPLAST "" + +/* HAS_ACCESS: + * This manifest constant lets the C program know that the access() + * system call is available to check for accessibility using real UID/GID. + * (always present on UNIX.) + */ +/*#define HAS_ACCESS / **/ + +/* CASTI32: + * This symbol is defined if the C compiler can cast negative + * or large floating point numbers to 32-bit ints. + */ +/*#define CASTI32 / **/ + +/* CASTNEGFLOAT: + * This symbol is defined if the C compiler can cast negative + * numbers to unsigned longs, ints and shorts. + */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 0 = ok + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + * 4 = couldn't cast in argument expression list + */ +/*#define CASTNEGFLOAT / **/ +#define CASTFLAGS 0 /**/ + +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. + */ +/*#define VOID_CLOSEDIR / **/ + +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +/*#define HAS_CSH / **/ +#ifdef HAS_CSH +#define CSH "" /**/ +#endif + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE / **/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +/*#define HAS_DRAND48_PROTO / **/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +/*#define HAS_ENDGRENT / **/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +/*#define HAS_ENDHOSTENT / **/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +/*#define HAS_ENDNETENT / **/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +/*#define HAS_ENDPROTOENT / **/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +/*#define HAS_ENDPWENT / **/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +/*#define HAS_ENDSERVENT / **/ + +/* HAS_FD_SET: + * This symbol, when defined, indicates presence of the fd_set typedef + * in <sys/types.h> + */ +/*#define HAS_FD_SET / **/ + +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +/*#define FLEXFILENAMES / **/ + +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_FPOS64_T / **/ + +/* HAS_FREXPL: + * This symbol, if defined, indicates that the frexpl routine is + * available to break a long double floating-point number into + * a normalized fraction and an integral power of 2. + */ +/*#define HAS_FREXPL / **/ + +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_FS_DATA / **/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FSEEKO / **/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATFS / **/ + +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FTELLO / **/ + +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * Possible values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * d_Gconvert='sprintf((b),"%.*g",(n),(x))' + * The last two assume trailing zeros should not be kept. + */ +#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) + +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +/*#define HAS_GETCWD / **/ + +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM / **/ + +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the getfsstat routine is + * available to stat filesystems in bulk. + */ +/*#define HAS_GETFSSTAT / **/ + +/* HAS_GETGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for sequential access of the group database. + */ +/*#define HAS_GETGRENT / **/ + +/* HAS_GETHOSTBYADDR: + * This symbol, if defined, indicates that the gethostbyaddr() routine is + * available to look up hosts by their IP addresses. + */ +/*#define HAS_GETHOSTBYADDR / **/ + +/* HAS_GETHOSTBYNAME: + * This symbol, if defined, indicates that the gethostbyname() routine is + * available to look up host names in some data base or other. + */ +/*#define HAS_GETHOSTBYNAME / **/ + +/* HAS_GETHOSTENT: + * This symbol, if defined, indicates that the gethostent() routine is + * available to look up host names in some data base or another. + */ +/*#define HAS_GETHOSTENT / **/ + +/* HAS_GETHOSTNAME: + * This symbol, if defined, indicates that the C program may use the + * gethostname() routine to derive the host name. See also HAS_UNAME + * and PHOSTNAME. + */ +/* HAS_UNAME: + * This symbol, if defined, indicates that the C program may use the + * uname() routine to derive the host name. See also HAS_GETHOSTNAME + * and PHOSTNAME. + */ +/* PHOSTNAME: + * This symbol, if defined, indicates the command to feed to the + * popen() routine to derive the host name. See also HAS_GETHOSTNAME + * and HAS_UNAME. Note that the command uses a fully qualified path, + * so that it is safe even if used by a process with super-user + * privileges. + */ +/* HAS_PHOSTNAME: + * This symbol, if defined, indicates that the C program may use the + * contents of PHOSTNAME as a command to feed to the popen() routine + * to derive the host name. + */ +/*#define HAS_GETHOSTNAME / **/ +/*#define HAS_UNAME / **/ +/*#define HAS_PHOSTNAME / **/ +#ifdef HAS_PHOSTNAME +#define PHOSTNAME "" /* How to get the host name */ +#endif + +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETHOST_PROTOS / **/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +/*#define HAS_GETMNT / **/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +/*#define HAS_GETMNTENT / **/ + +/* HAS_GETNETBYADDR: + * This symbol, if defined, indicates that the getnetbyaddr() routine is + * available to look up networks by their IP addresses. + */ +/*#define HAS_GETNETBYADDR / **/ + +/* HAS_GETNETBYNAME: + * This symbol, if defined, indicates that the getnetbyname() routine is + * available to look up networks by their names. + */ +/*#define HAS_GETNETBYNAME / **/ + +/* HAS_GETNETENT: + * This symbol, if defined, indicates that the getnetent() routine is + * available to look up network names in some data base or another. + */ +/*#define HAS_GETNETENT / **/ + +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETNET_PROTOS / **/ + +/* HAS_GETPROTOENT: + * This symbol, if defined, indicates that the getprotoent() routine is + * available to look up protocols in some data base or another. + */ +/*#define HAS_GETPROTOENT / **/ + +/* HAS_GETPROTOBYNAME: + * This symbol, if defined, indicates that the getprotobyname() + * routine is available to look up protocols by their name. + */ +/* HAS_GETPROTOBYNUMBER: + * This symbol, if defined, indicates that the getprotobynumber() + * routine is available to look up protocols by their number. + */ +/*#define HAS_GETPROTOBYNAME / **/ +/*#define HAS_GETPROTOBYNUMBER / **/ + +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETPROTO_PROTOS / **/ + +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM / **/ + +/* HAS_GETPWENT: + * This symbol, if defined, indicates that the getpwent routine is + * available for sequential access of the passwd database. + * If this is not available, the older getpw() function may be available. + */ +/*#define HAS_GETPWENT / **/ + +/* HAS_GETSERVENT: + * This symbol, if defined, indicates that the getservent() routine is + * available to look up network services in some data base or another. + */ +/*#define HAS_GETSERVENT / **/ + +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETSERV_PROTOS / **/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +/*#define HAS_GETSPNAM / **/ + +/* HAS_GETSERVBYNAME: + * This symbol, if defined, indicates that the getservbyname() + * routine is available to look up services by their name. + */ +/* HAS_GETSERVBYPORT: + * This symbol, if defined, indicates that the getservbyport() + * routine is available to look up services by their port. + */ +/*#define HAS_GETSERVBYNAME / **/ +/*#define HAS_GETSERVBYPORT / **/ + +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +/*#define HAS_GNULIBC / **/ +#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) +# define _GNU_SOURCE +#endif +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +/*#define HAS_HASMNTOPT / **/ + +/* HAS_HTONL: + * This symbol, if defined, indicates that the htonl() routine (and + * friends htons() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_HTONS: + * This symbol, if defined, indicates that the htons() routine (and + * friends htonl() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHL: + * This symbol, if defined, indicates that the ntohl() routine (and + * friends htonl() htons() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHS: + * This symbol, if defined, indicates that the ntohs() routine (and + * friends htonl() htons() ntohl()) are available to do network + * order byte swapping. + */ +/*#define HAS_HTONL / **/ +/*#define HAS_HTONS / **/ +/*#define HAS_NTOHL / **/ +/*#define HAS_NTOHS / **/ + +/* HAS_ICONV: + * This symbol, if defined, indicates that the iconv routine is + * available to do character set conversions. + */ +/*#define HAS_ICONV / **/ + +/* HAS_INT64_T: + * This symbol will defined if the C compiler supports int64_t. + * Usually the <inttypes.h> needs to be included, but sometimes + * <sys/types.h> is enough. + */ +/*#define HAS_INT64_T / **/ + +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +/*#define HAS_ISASCII / **/ + +/* HAS_ISNAN: + * This symbol, if defined, indicates that the isnan routine is + * available to check whether a double is a NaN. + */ +/*#define HAS_ISNAN / **/ + +/* HAS_ISNANL: + * This symbol, if defined, indicates that the isnanl routine is + * available to check whether a long double is a NaN. + */ +/*#define HAS_ISNANL / **/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN / **/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's <float.h> + * or <limits.h> defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +/*#define HAS_LDBL_DIG / * */ + +/* HAS_LONG_DOUBLE: + * This symbol will be defined if the C compiler supports long + * doubles. + */ +/* LONG_DOUBLESIZE: + * This symbol contains the size of a long double, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long doubles. + */ +/*#define HAS_LONG_DOUBLE / **/ +#ifdef HAS_LONG_DOUBLE +#define LONG_DOUBLESIZE 1 /**/ +#endif + +/* HAS_LONG_LONG: + * This symbol will be defined if the C compiler supports long long. + */ +/* LONGLONGSIZE: + * This symbol contains the size of a long long, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long long. + */ +/*#define HAS_LONG_LONG / **/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE 1 /**/ +#endif + +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek(int, off_t, int); + */ +/*#define HAS_LSEEK_PROTO / **/ + +/* HAS_MADVISE: + * This symbol, if defined, indicates that the madvise system call is + * available to map a file into memory. + */ +/*#define HAS_MADVISE / **/ + +/* HAS_MEMCHR: + * This symbol, if defined, indicates that the memchr routine is available + * to locate characters within a C string. + */ +/*#define HAS_MEMCHR / **/ + +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +/*#define HAS_MKDTEMP / **/ + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +/*#define HAS_MKSTEMP / **/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to excluslvely create and open a uniquely named + * (with a suffix) temporary file. + */ +/*#define HAS_MKSTEMPS / **/ + +/* HAS_MMAP: + * This symbol, if defined, indicates that the mmap system call is + * available to map a file into memory. + */ +/* Mmap_t: + * This symbol holds the return type of the mmap() system call + * (and simultaneously the type of the first argument). + * Usually set to 'void *' or 'cadd_t'. + */ +/*#define HAS_MMAP / **/ +#define Mmap_t /**/ + +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +/*#define HAS_MODFL / **/ + +/* HAS_MPROTECT: + * This symbol, if defined, indicates that the mprotect system call is + * available to modify the access protection of a memory mapped file. + */ +/*#define HAS_MPROTECT / **/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG / **/ + +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/*#define HAS_OFF64_T / **/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +/*#define HAS_OPEN3 / **/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE / **/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/*#define HAS_PTHREAD_YIELD / **/ +#define SCHED_YIELD sched_yield() /**/ +/*#define HAS_SCHED_YIELD / **/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_BCOPY / **/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_MEMCPY / **/ + +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. + */ +/*#define HAS_SANE_MEMCMP / **/ + +/* HAS_SEM: + * This symbol, if defined, indicates that the entire sem*(2) library is + * supported. + */ +/*#define HAS_SEM / **/ + +/* HAS_SETGRENT: + * This symbol, if defined, indicates that the setgrent routine is + * available for initializing sequential access of the group database. + */ +/*#define HAS_SETGRENT / **/ + +/* HAS_SETGROUPS: + * This symbol, if defined, indicates that the setgroups() routine is + * available to set the list of process groups. If unavailable, multiple + * groups are probably not supported. + */ +/*#define HAS_SETGROUPS / **/ + +/* HAS_SETHOSTENT: + * This symbol, if defined, indicates that the sethostent() routine is + * available. + */ +/*#define HAS_SETHOSTENT / **/ + +/* HAS_SETNETENT: + * This symbol, if defined, indicates that the setnetent() routine is + * available. + */ +/*#define HAS_SETNETENT / **/ + +/* HAS_SETPROTOENT: + * This symbol, if defined, indicates that the setprotoent() routine is + * available. + */ +/*#define HAS_SETPROTOENT / **/ + +/* HAS_SETPWENT: + * This symbol, if defined, indicates that the setpwent routine is + * available for initializing sequential access of the passwd database. + */ +/*#define HAS_SETPWENT / **/ + +/* HAS_SETSERVENT: + * This symbol, if defined, indicates that the setservent() routine is + * available. + */ +/*#define HAS_SETSERVENT / **/ + +/* HAS_SETVBUF: + * This symbol, if defined, indicates that the setvbuf routine is + * available to change buffering on an open stdio stream. + * to a line-buffered mode. + */ +/*#define HAS_SETVBUF / **/ + +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO / **/ + +/* HAS_SHM: + * This symbol, if defined, indicates that the entire shm*(2) library is + * supported. + */ +/*#define HAS_SHM / **/ + +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION / **/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP / **/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + +/* HAS_SOCKET: + * This symbol, if defined, indicates that the BSD socket interface is + * supported. + */ +/* HAS_SOCKETPAIR: + * This symbol, if defined, indicates that the BSD socketpair() call is + * supported. + */ +/* HAS_MSG_CTRUNC: + * This symbol, if defined, indicates that the MSG_CTRUNC is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_DONTROUTE: + * This symbol, if defined, indicates that the MSG_DONTROUTE is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_OOB: + * This symbol, if defined, indicates that the MSG_OOB is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_PEEK: + * This symbol, if defined, indicates that the MSG_PEEK is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_PROXY: + * This symbol, if defined, indicates that the MSG_PROXY is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_SCM_RIGHTS: + * This symbol, if defined, indicates that the SCM_RIGHTS is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/*#define HAS_SOCKET / **/ +/*#define HAS_SOCKETPAIR / **/ +/*#define HAS_MSG_CTRUNC / **/ +/*#define HAS_MSG_DONTROUTE / **/ +/*#define HAS_MSG_OOB / **/ +/*#define HAS_MSG_PEEK / **/ +/*#define HAS_MSG_PROXY / **/ +/*#define HAS_SCM_RIGHTS / **/ + +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +/*#define HAS_SQRTL / **/ + +/* USE_STAT_BLOCKS: + * This symbol is defined if this system has a stat structure declaring + * st_blksize and st_blocks. + */ +#ifndef USE_STAT_BLOCKS +/*#define USE_STAT_BLOCKS / **/ +#endif + +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3), + * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +/*#define HAS_STRUCT_STATFS_F_FLAGS / **/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_STATFS / **/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATVFS / **/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +/*#define USE_STDIO_PTR / **/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->_IO_read_ptr) +/*#define STDIO_PTR_LVALUE / **/ +#define FILE_cnt(fp) ((fp)->_IO_read_end - (fp)->_IO_read_ptr) +/*#define STDIO_CNT_LVALUE / **/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +/*#define USE_STDIO_BASE / **/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->_IO_read_base) +#define FILE_bufsiz(fp) ((fp)->_IO_read_end - (fp)->_IO_read_base) +#endif + +/* HAS_STRERROR: + * This symbol, if defined, indicates that the strerror routine is + * available to translate error numbers to strings. See the writeup + * of Strerror() in this file before you try to define your own. + */ +/* HAS_SYS_ERRLIST: + * This symbol, if defined, indicates that the sys_errlist array is + * available to translate error numbers to strings. The extern int + * sys_nerr gives the size of that table. + */ +/* Strerror: + * This preprocessor symbol is defined as a macro if strerror() is + * not available to translate error numbers to strings but sys_errlist[] + * array is there. + */ +/*#define HAS_STRERROR / **/ +/*#define HAS_SYS_ERRLIST / **/ +#define Strerror(e) strerror(e) + +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD / **/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +/*#define HAS_STRTOLL / **/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +/*#define HAS_STRTOULL / **/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +/*#define HAS_STRTOUQ / **/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +/*#define HAS_TELLDIR_PROTO / **/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t int /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +/*#define HAS_TIMES / **/ + +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +/*#define HAS_UNION_SEMUN / **/ +/*#define USE_SEMCTL_SEMUN / **/ +/*#define USE_SEMCTL_SEMID_DS / **/ + +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +/*#define HAS_USTAT / **/ + +/* HAS_VFORK: + * This symbol, if defined, indicates that vfork() exists. + */ +/*#define HAS_VFORK / **/ + +/* Signal_t: + * This symbol's value is either "void" or "int", corresponding to the + * appropriate return type of a signal handler. Thus, you can declare + * a signal handler using "Signal_t (*handler)()", and define the + * handler using "Signal_t handler(sig)". + */ +#define Signal_t int /* Signal handler's return type */ + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF / **/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +/*#define USE_DYNAMIC_LOADING / **/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 1 /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC / **/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +/*#define FFLUSH_NULL / **/ +/*#define FFLUSH_ALL / **/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t int /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "lu" /**/ + +/* Gid_t_sign: + * This symbol holds the signedess of a Gid_t. + * 1 for unsigned, -1 for signed. + */ +#define Gid_t_sign 1 /* GID sign */ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * gid_t, etc... It may be necessary to include <sys/types.h> to get + * any typedef'ed information. + */ +#define Gid_t int /* Type for getgid(), etc... */ + +/* Groups_t: + * This symbol holds the type used for the second argument to + * getgroups() and setgroups(). Usually, this is the same as + * gidtype (gid_t) , but sometimes it isn't. + * It can be int, ushort, gid_t, etc... + * It may be necessary to include <sys/types.h> to get any + * typedef'ed information. This is only required if you have + * getgroups() or setgroups().. + */ +#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) +#define Groups_t int /* Type for 2nd arg to [sg]etgroups() */ +#endif + +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t u_int32_t /**/ +#define DB_Prefix_t size_t /**/ + +/* I_GRP: + * This symbol, if defined, indicates to the C program that it should + * include <grp.h>. + */ +/* GRPASSWD: + * This symbol, if defined, indicates to the C program that struct group + * in <grp.h> contains gr_passwd. + */ +/*#define I_GRP / **/ +/*#define GRPASSWD / **/ + +/* I_ICONV: + * This symbol, if defined, indicates that <iconv.h> exists and + * should be included. + */ +/*#define I_ICONV / **/ + +/* I_IEEEFP: + * This symbol, if defined, indicates that <ieeefp.h> exists and + * should be included. + */ +/*#define I_IEEEFP / **/ + +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include <inttypes.h>. + */ +/*#define I_INTTYPES / **/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include <mach/cthreads.h>. + */ +/*#define I_MACH_CTHREADS / **/ + +/* I_MNTENT: + * This symbol, if defined, indicates that <mntent.h> exists and + * should be included. + */ +/*#define I_MNTENT / **/ + +/* I_NETDB: + * This symbol, if defined, indicates that <netdb.h> exists and + * should be included. + */ +/*#define I_NETDB / **/ + +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include <netinet/tcp.h>. + */ +/*#define I_NETINET_TCP / **/ + +/* I_POLL: + * This symbol, if defined, indicates that <poll.h> exists and + * should be included. + */ +/*#define I_POLL / **/ + +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +/*#define I_PROT / **/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include <pthread.h>. + */ +/*#define I_PTHREAD / **/ + +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include <pwd.h>. + */ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +/* PWPASSWD: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_passwd. + */ +/*#define I_PWD / **/ +/*#define PWQUOTA / **/ +/*#define PWAGE / **/ +/*#define PWCHANGE / **/ +/*#define PWCLASS / **/ +/*#define PWEXPIRE / **/ +/*#define PWCOMMENT / **/ +/*#define PWGECOS / **/ +/*#define PWPASSWD / **/ + +/* I_SHADOW: + * This symbol, if defined, indicates that <shadow.h> exists and + * should be included. + */ +/*#define I_SHADOW / **/ + +/* I_SOCKS: + * This symbol, if defined, indicates that <socks.h> exists and + * should be included. + */ +/*#define I_SOCKS / **/ + +/* I_SUNMATH: + * This symbol, if defined, indicates that <sunmath.h> exists and + * should be included. + */ +/*#define I_SUNMATH / **/ + +/* I_SYSLOG: + * This symbol, if defined, indicates that <syslog.h> exists and + * should be included. + */ +/*#define I_SYSLOG / **/ + +/* I_SYSMODE: + * This symbol, if defined, indicates that <sys/mode.h> exists and + * should be included. + */ +/*#define I_SYSMODE / **/ + +/* I_SYS_MOUNT: + * This symbol, if defined, indicates that <sys/mount.h> exists and + * should be included. + */ +/*#define I_SYS_MOUNT / **/ + +/* I_SYS_STATFS: + * This symbol, if defined, indicates that <sys/statfs.h> exists. + */ +/*#define I_SYS_STATFS / **/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates that <sys/statvfs.h> exists and + * should be included. + */ +/*#define I_SYS_STATVFS / **/ + +/* I_SYSUIO: + * This symbol, if defined, indicates that <sys/uio.h> exists and + * should be included. + */ +/*#define I_SYSUIO / **/ + +/* I_SYSUTSNAME: + * This symbol, if defined, indicates that <sys/utsname.h> exists and + * should be included. + */ +/*#define I_SYSUTSNAME / **/ + +/* I_SYS_VFS: + * This symbol, if defined, indicates that <sys/vfs.h> exists and + * should be included. + */ +/*#define I_SYS_VFS / **/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <time.h>. + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h>. + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h> with KERNEL defined. + */ +#define I_TIME /**/ +/*#define I_SYS_TIME / **/ +/*#define I_SYS_TIME_KERNEL / **/ + +/* I_USTAT: + * This symbol, if defined, indicates that <ustat.h> exists and + * should be included. + */ +/*#define I_USTAT / **/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST NULL /**/ + +/* INSTALL_USR_BIN_PERL: + * This symbol, if defined, indicates that Perl is to be installed + * also as /usr/bin/perl. + */ +/*#define INSTALL_USR_BIN_PERL / **/ + +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +/*#define PERL_PRIfldbl "llf" / **/ +/*#define PERL_PRIgldbl "llg" / **/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t int /* <offset> type */ +#define LSEEKSIZE 1 /* <offset> size */ +#define Off_t_size 1 /* <offset> size */ + +/* Free_t: + * This variable contains the return type of free(). It is usually + * void, but occasionally int. + */ +/* Malloc_t: + * This symbol is the type of pointer returned by malloc and realloc. + */ +#define Malloc_t void * /**/ +#define Free_t int /**/ + +/* MYMALLOC: + * This symbol, if defined, indicates that we're using our own malloc. + */ +/*#define MYMALLOC / **/ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t int /* file mode parameter for system calls */ + +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#undef EOF_NONBLOCK + +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). + */ +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). + */ +#define Netdb_host_t const char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t const char * /**/ +#define Netdb_net_t unsigned long /**/ + +/* PERL_OTHERLIBDIRS: + * This variable contains a colon-separated set of paths for the perl + * binary to search for additional library files or modules. + * These directories will be tacked to the end of @INC. + * Perl will automatically search below each path for version- + * and architecture-specific directories. See PERL_INC_VERSION_LIST + * for more details. + */ +/*#define PERL_OTHERLIBDIRS "" / **/ + +/* IVTYPE: + * This symbol defines the C type used for Perl's IV. + */ +/* UVTYPE: + * This symbol defines the C type used for Perl's UV. + */ +/* I8TYPE: + * This symbol defines the C type used for Perl's I8. + */ +/* U8TYPE: + * This symbol defines the C type used for Perl's U8. + */ +/* I16TYPE: + * This symbol defines the C type used for Perl's I16. + */ +/* U16TYPE: + * This symbol defines the C type used for Perl's U16. + */ +/* I32TYPE: + * This symbol defines the C type used for Perl's I32. + */ +/* U32TYPE: + * This symbol defines the C type used for Perl's U32. + */ +/* I64TYPE: + * This symbol defines the C type used for Perl's I64. + */ +/* U64TYPE: + * This symbol defines the C type used for Perl's U64. + */ +/* NVTYPE: + * This symbol defines the C type used for Perl's NV. + */ +/* IVSIZE: + * This symbol contains the sizeof(IV). + */ +/* UVSIZE: + * This symbol contains the sizeof(UV). + */ +/* I8SIZE: + * This symbol contains the sizeof(I8). + */ +/* U8SIZE: + * This symbol contains the sizeof(U8). + */ +/* I16SIZE: + * This symbol contains the sizeof(I16). + */ +/* U16SIZE: + * This symbol contains the sizeof(U16). + */ +/* I32SIZE: + * This symbol contains the sizeof(I32). + */ +/* U32SIZE: + * This symbol contains the sizeof(U32). + */ +/* I64SIZE: + * This symbol contains the sizeof(I64). + */ +/* U64SIZE: + * This symbol contains the sizeof(U64). + */ +/* NVSIZE: + * This symbol contains the sizeof(NV). + */ +/* NV_PRESERVES_UV: + * This symbol, if defined, indicates that a variable of type NVTYPE + * can preserve all the bits of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. + */ +#define IVTYPE long /**/ +#define UVTYPE unsigned long /**/ +#define I8TYPE char /**/ +#define U8TYPE unsigned char /**/ +#define I16TYPE short /**/ +#define U16TYPE unsigned short /**/ +#define I32TYPE long /**/ +#define U32TYPE unsigned long /**/ +#ifdef HAS_QUAD +#define I64TYPE int64_t /**/ +#define U64TYPE uint64_t /**/ +#endif +#define NVTYPE double /**/ +#define IVSIZE 4 /**/ +#define UVSIZE 4 /**/ +#define I8SIZE 1 /**/ +#define U8SIZE 1 /**/ +#define I16SIZE 2 /**/ +#define U16SIZE 2 /**/ +#define I32SIZE 4 /**/ +#define U32SIZE 4 /**/ +#ifdef HAS_QUAD +#define I64SIZE 8 /**/ +#define U64SIZE 8 /**/ +#endif +#define NVSIZE 8 /**/ +#undef NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS + +/* IVdf: + * This symbol defines the format string used for printing a Perl IV + * as a signed decimal integer. + */ +/* UVuf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned decimal integer. + */ +/* UVof: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned octal integer. + */ +/* UVxf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned hexadecimal integer. + */ +#define IVdf "ld" /**/ +#define UVuf "lu" /**/ +#define UVof "lo" /**/ +#define UVxf "lx" /**/ + +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Pid_t int /* PID type */ + +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "/usr/local/lib/perl5/5.6" /**/ +#define PRIVLIB_EXP "/usr/local/lib/perl5/5.6" /**/ + +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). + */ +#define PTRSIZE 1 /**/ + +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. + */ +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. + */ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15)) /**/ +#define Rand_seed_t int /**/ +#define seedDrand01(x) srand((Rand_seed_t)x) /**/ +#define RANDBITS 48 /**/ + +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. + */ +#define SELECT_MIN_BITS 32 /**/ + +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. + */ +#define Select_fd_set_t int /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NAME 0 /**/ +#define SIG_NUM 0 /**/ + +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITEARCH "" /**/ +#define SITEARCH_EXP "" /**/ + +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ +#define SITELIB "" /**/ +#define SITELIB_EXP "" /**/ +#define SITELIB_STEM "" /**/ + +/* Size_t_size: + * This symbol holds the size of a Size_t in bytes. + */ +#define Size_t_size 1 /* */ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t int /* length paramater for string functions */ + +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t int /**/ + +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include <sys/types.h> or <unistd.h> + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). + */ +#define SSize_t int /* signed count of bytes */ + +/* STARTPERL: + * This variable contains the string to put in front of a perl + * script to make sure (one hopes) that it runs with perl and not + * some shell. + */ +#define STARTPERL "" /**/ + +/* HAS_STDIO_STREAM_ARRAY: + * This symbol, if defined, tells that there is an array + * holding the stdio streams. + */ +/* STDIO_STREAM_ARRAY: + * This symbol tells the name of the array holding the stdio streams. + * Usual values include _iob, __iob, and __sF. + */ +/*#define HAS_STDIO_STREAM_ARRAY / **/ +#define STDIO_STREAM_ARRAY + +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. + */ +#define Uid_t_f "lu" /**/ + +/* Uid_t_sign: + * This symbol holds the signedess of a Uid_t. + * 1 for unsigned, -1 for signed. + */ +#define Uid_t_sign 1 /* UID sign */ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Uid_t int /* UID type */ + +/* USE_64_BIT_INT: + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. + */ +/* USE_64_BIT_ALL: + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers + * will be used (be they 32 or 64 bits). The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_INT +/*#define USE_64_BIT_INT / **/ +#endif + +#ifndef USE_64_BIT_ALL +/*#define USE_64_BIT_ALL / **/ +#endif + +/* USE_LARGE_FILES: + * This symbol, if defined, indicates that large file support + * should be used when available. + */ +#ifndef USE_LARGE_FILES +/*#define USE_LARGE_FILES / **/ +#endif + +/* USE_LONG_DOUBLE: + * This symbol, if defined, indicates that long doubles should + * be used when available. + */ +#ifndef USE_LONG_DOUBLE +/*#define USE_LONG_DOUBLE / **/ +#endif + +/* USE_MORE_BITS: + * This symbol, if defined, indicates that 64-bit interfaces and + * long doubles should be used when available. + */ +#ifndef USE_MORE_BITS +/*#define USE_MORE_BITS / **/ +#endif + +/* MULTIPLICITY: + * This symbol, if defined, indicates that Perl should + * be built to use multiplicity. + */ +#ifndef MULTIPLICITY +/*#define MULTIPLICITY / **/ +#endif + +/* USE_PERLIO: + * This symbol, if defined, indicates that the PerlIO abstraction should + * be used throughout. If not defined, stdio should be + * used in a fully backward compatible manner. + */ +#ifndef USE_PERLIO +/*#define USE_PERLIO / **/ +#endif + +/* USE_SOCKS: + * This symbol, if defined, indicates that Perl should + * be built to use socks. + */ +#ifndef USE_SOCKS +/*#define USE_SOCKS / **/ +#endif + +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. + */ +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. + */ +/* OLD_PTHREADS_API: + * This symbol, if defined, indicates that Perl should + * be built to use the old draft POSIX threads API. + */ +/*#define USE_5005THREADS / **/ +/*#define USE_ITHREADS / **/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif +/*#define OLD_PTHREADS_API / **/ + +/* PERL_VENDORARCH: + * If defined, this symbol contains the name of a private library. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. + * It may have a ~ on the front. + * The standard distribution will put nothing in this directory. + * Vendors who distribute perl may wish to place their own + * architecture-dependent modules and extensions in this directory with + * MakeMaker Makefile.PL INSTALLDIRS=vendor + * or equivalent. See INSTALL for details. + */ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define PERL_VENDORARCH "" / **/ +/*#define PERL_VENDORARCH_EXP "" / **/ + +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ +/*#define PERL_VENDORLIB_EXP "" / **/ +/*#define PERL_VENDORLIB_STEM "" / **/ + +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED 1 +#endif +#define VOIDFLAGS 1 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + +/* PERL_XS_APIVERSION: + * This variable contains the version of the oldest perl binary + * compatible with the present perl. perl.c:incpush() and + * lib/lib.pm will automatically search in for older + * directories across major versions back to xs_apiversion. + * This is only useful if you have a perl library directory tree + * structured like the default one. + * See INSTALL for how this works. + * The versioned site_perl directory was introduced in 5.005, + * so that is the lowest possible value. + * Since this can depend on compile time options (such as + * bincompat) it is set by Configure. Other non-default sources + * of potential incompatibility, such as multiplicity, threads, + * debugging, 64bits, sfio, etc., are not checked for currently, + * though in principle we could go snooping around in old + * Config.pm files. + */ +/* PERL_PM_APIVERSION: + * This variable contains the version of the oldest perl + * compatible with the present perl. (That is, pure perl modules + * written for pm_apiversion will still work for the current + * version). perl.c:incpush() and lib/lib.pm will automatically + * search in for older directories across major versions + * back to pm_apiversion. This is only useful if you have a perl + * library directory tree structured like the default one. The + * versioned site_perl library was introduced in 5.005, so that's + * the default setting for this variable. It's hard to imagine + * it changing before Perl6. It is included here for symmetry + * with xs_apiveprsion -- the searching algorithms will + * (presumably) be similar. + * See the INSTALL file for how this works. + */ +#define PERL_XS_APIVERSION "5.005" +#define PERL_PM_APIVERSION "5.005" + +#endif diff --git a/uconfig.sh b/uconfig.sh new file mode 100755 index 0000000000..d986b0dc7d --- /dev/null +++ b/uconfig.sh @@ -0,0 +1,550 @@ +#!/bin/sh +_a='.a' +_o='.o' +afs='false' +alignbytes='4' +apiversion='5.005' +archlib='/usr/local/lib/perl5/5.6/unknown' +archlibexp='/usr/local/lib/perl5/5.6/unknown' +archname='unknown' +bin='/usr/local/bin' +bincompat5005='define' +byteorder='12' +castflags='0' +charsize='1' +clocktype='clock_t' +cpp_stuff='42' +crosscompile='undef' +d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_PRIEldbl='undef' +d_PRIFldbl='undef' +d_PRIGldbl='undef' +d_PRIX64='undef' +d_PRId64='undef' +d_PRIeldbl='undef' +d_PRIfldbl='undef' +d_PRIgldbl='undef' +d_PRIi64='undef' +d_PRIo64='undef' +d_PRIu64='undef' +d_PRIx64='undef' +d_access='undef' +d_accessx='undef' +d_alarm='undef' +d_archlib='undef' +d_atolf='undef' +d_atoll='undef' +d_attribut='undef' +d_bcmp='undef' +d_bcopy='undef' +d_bincompat5005='undef' +d_bsd='undef' +d_bsdgetpgrp='undef' +d_bsdsetpgrp='undef' +d_bzero='undef' +d_casti32='undef' +d_castneg='undef' +d_charvspr='undef' +d_chown='undef' +d_chroot='undef' +d_chsize='undef' +d_closedir='undef' +d_const='undef' +d_crypt='undef' +d_csh='undef' +d_cuserid='undef' +d_dbl_dig='undef' +d_difftime='undef' +d_dirnamlen='undef' +d_dlerror='undef' +d_dlopen='undef' +d_dlsymun='undef' +d_dosuid='undef' +d_drand48proto='undef' +d_dup2='undef' +d_eaccess='undef' +d_endgrent='undef' +d_endhent='undef' +d_endnent='undef' +d_endpent='undef' +d_endpwent='undef' +d_endsent='undef' +d_endspent='undef' +d_eofnblk='undef' +d_eunice='undef' +d_fchmod='undef' +d_fchown='undef' +d_fcntl='undef' +d_fd_macros='undef' +d_fd_set='undef' +d_fds_bits='undef' +d_fgetpos='undef' +d_flexfnam='undef' +d_flock='undef' +d_fork='define' +d_fpathconf='undef' +d_fpos64_t='undef' +d_fs_data_s='undef' +d_fseeko='undef' +d_fsetpos='undef' +d_fstatfs='undef' +d_fstatvfs='undef' +d_ftello='undef' +d_ftime='undef' +d_getcwd='undef' +d_getgrent='undef' +d_getgrps='undef' +d_gethbyaddr='undef' +d_gethbyname='undef' +d_gethent='undef' +d_gethname='undef' +d_gethostprotos='undef' +d_getlogin='undef' +d_getmnt='undef' +d_getmntent='undef' +d_getnbyaddr='undef' +d_getnbyname='undef' +d_getnent='undef' +d_getnetprotos='undef' +d_getpbyname='undef' +d_getpbynumber='undef' +d_getpent='undef' +d_getpgid='undef' +d_getpgrp2='undef' +d_getpgrp='undef' +d_getppid='undef' +d_getprior='undef' +d_getprotoprotos='undef' +d_getpwent='undef' +d_getsbyname='undef' +d_getsbyport='undef' +d_getsent='undef' +d_getservprotos='undef' +d_getspent='undef' +d_getspnam='undef' +d_gettimeod='undef' +d_gnulibc='undef' +d_grpasswd='undef' +d_hasmntopt='undef' +d_htonl='undef' +d_iconv='undef' +d_index='undef' +d_inetaton='undef' +d_int64t='undef' +d_isascii='undef' +d_killpg='undef' +d_lchown='undef' +d_ldbl_dig='undef' +d_link='undef' +d_locconv='undef' +d_lockf='undef' +d_longdbl='undef' +d_longlong='undef' +d_lstat='undef' +d_mblen='undef' +d_mbstowcs='undef' +d_mbtowc='undef' +d_memchr='undef' +d_memcmp='undef' +d_memcpy='undef' +d_memmove='undef' +d_memset='undef' +d_mkdir='undef' +d_mkdtemp='undef' +d_mkfifo='undef' +d_mkstemp='undef' +d_mkstemps='undef' +d_mktime='undef' +d_mprotect='undef' +d_msg='undef' +d_msg_ctrunc='undef' +d_msg_dontroute='undef' +d_msg_oob='undef' +d_msg_peek='undef' +d_msg_proxy='undef' +d_msgctl='undef' +d_msgget='undef' +d_msgrcv='undef' +d_msgsnd='undef' +d_msync='undef' +d_munmap='undef' +d_mymalloc='undef' +d_nice='undef' +d_nv_preserves_uv='undef' +d_off64_t='undef' +d_old_pthread_create_joinable='undef' +d_oldpthreads='undef' +d_oldsock='undef' +d_open3='undef' +d_pathconf='undef' +d_pause='undef' +d_phostname='undef' +d_pipe='undef' +d_poll='undef' +d_portable='undef' +d_pthread_yield='undef' +d_pwage='undef' +d_pwchange='undef' +d_pwclass='undef' +d_pwcomment='undef' +d_pwexpire='undef' +d_pwgecos='undef' +d_pwpasswd='undef' +d_pwquota='undef' +d_quad='undef' +d_readdir='undef' +d_readlink='undef' +d_rename='undef' +d_rewinddir='undef' +d_rmdir='undef' +d_safebcpy='undef' +d_safemcpy='undef' +d_sanemcmp='undef' +d_sched_yield='undef' +d_scm_rights='undef' +d_seekdir='undef' +d_select='undef' +d_sem='undef' +d_semctl='undef' +d_semctl_semid_ds='undef' +d_semctl_semun='undef' +d_semget='undef' +d_semop='undef' +d_setegid='undef' +d_seteuid='undef' +d_setgrent='undef' +d_setgrps='undef' +d_sethent='undef' +d_setlinebuf='undef' +d_setlocale='undef' +d_setnent='undef' +d_setpent='undef' +d_setpgid='undef' +d_setpgrp2='undef' +d_setpgrp='undef' +d_setprior='undef' +d_setpwent='undef' +d_setregid='undef' +d_setresgid='undef' +d_setresuid='undef' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' +d_setsent='undef' +d_setsid='undef' +d_setspent='undef' +d_setvbuf='undef' +d_sfio='undef' +d_shm='undef' +d_shmat='undef' +d_shmatprototype='undef' +d_shmctl='undef' +d_shmdt='undef' +d_shmget='undef' +d_sigaction='undef' +d_sigsetjmp='undef' +d_socket='undef' +d_sockpair='undef' +d_sqrtl='undef' +d_statblks='undef' +d_statfs_f_flags='undef' +d_statfs_s='undef' +d_statvfs='undef' +d_stdio_cnt_lval='undef' +d_stdio_ptr_lval='undef' +d_stdio_stream_array='undef' +d_stdiobase='undef' +d_stdstdio='undef' +d_strchr='undef' +d_strcoll='undef' +d_strctcpy='undef' +d_strerrm='strerror(e)' +d_strerror='undef' +d_strtod='undef' +d_strtol='undef' +d_strtold='undef' +d_strtoll='undef' +d_strtoul='undef' +d_strtoull='undef' +d_strtouq='undef' +d_strxfrm='undef' +d_suidsafe='undef' +d_symlink='undef' +d_syscall='undef' +d_sysconf='undef' +d_sysernlst='' +d_syserrlst='undef' +d_system='undef' +d_tcgetpgrp='undef' +d_tcsetpgrp='undef' +d_telldir='undef' +d_telldirproto='undef' +d_time='undef' +d_times='undef' +d_truncate='undef' +d_tzname='undef' +d_umask='undef' +d_uname='undef' +d_union_semun='undef' +d_ustat='undef' +d_vendorbin='undef' +d_vendorlib='undef' +d_vfork='undef' +d_void_closedir='undef' +d_voidsig='undef' +d_voidtty='' +d_volatile='undef' +d_vprintf='define' +d_wait4='undef' +d_waitpid='undef' +d_wcstombs='undef' +d_wctomb='undef' +d_xenix='undef' +db_hashtype='u_int32_t' +db_prefixtype='size_t' +defvoidused=1 +direntrytype='struct dirent' +doublesize=1 +drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))" +eagain='EAGAIN' +ebcdic='undef' +fflushNULL='undef' +fflushall='undef' +firstmakefile='makefile' +fpossize='4' +fpostype=int +freetype=int +gidformat='"lu"' +gidsign='1' +gidsize='4' +gidtype=int +groupstype=int +h_fcntl='false' +h_sysfile='true' +i16size='2' +i16type='short' +i32size='4' +i32type='long' +i64size='8' +i64type='int64_t' +i8size='1' +i8type='char' +i_arpainet='undef' +i_bsdioctl='' +i_db='undef' +i_dbm='undef' +i_dirent='undef' +i_dld='undef' +i_dlfcn='undef' +i_fcntl='undef' +i_float='undef' +i_gdbm='undef' +i_grp='undef' +i_iconv='undef' +i_inttypes='undef' +i_limits='undef' +i_locale='undef' +i_machcthr='undef' +i_malloc='undef' +i_math='undef' +i_memory='undef' +i_mntent='undef' +i_ndbm='undef' +i_netdb='undef' +i_neterrno='undef' +i_netinettcp='undef' +i_niin='undef' +i_poll='undef' +i_pthread='undef' +i_pwd='undef' +i_rpcsvcdbm='undef' +i_sfio='undef' +i_sgtty='undef' +i_shadow='undef' +i_socks='undef' +i_stdarg='define' +i_stddef='undef' +i_stdlib='undef' +i_string='define' +i_sysaccess='undef' +i_sysdir='undef' +i_sysfile='undef' +i_sysfilio='undef' +i_sysin='undef' +i_sysioctl='undef' +i_syslog='undef' +i_sysmount='undef' +i_sysndir='undef' +i_sysparam='undef' +i_sysresrc='undef' +i_syssecrt='undef' +i_sysselct='undef' +i_syssockio='' +i_sysstat='define' +i_sysstatfs='undef' +i_sysstatvfs='undef' +i_systime='undef' +i_systimek='undef' +i_systimes='undef' +i_systypes='undef' +i_sysuio='undef' +i_sysun='undef' +i_sysvfs='undef' +i_syswait='undef' +i_termio='undef' +i_termios='undef' +i_time='define' +i_unistd='undef' +i_ustat='undef' +i_utime='undef' +i_values='undef' +i_varargs='undef' +i_varhdr='stdarg.h' +i_vfork='undef' +ignore_versioned_solibs='y' +installstyle='lib/perl5' +installusrbinperl='undef' +intsize='4' +intsize=1 +ivdformat='"ld"' +ivsize='4' +ivtype='long' +lib_ext='.a' +longdblsize=1 +longlongsize=1 +longsize=1 +lseeksize=1 +lseektype=int +malloctype='int*' +malloctype='void *' +modetype='mode_t' +modetype=int +multiarch='undef' +myarchname='unknown' +myuname='unknown' +netdb_hlen_type='int' +netdb_host_type='const char *' +netdb_name_type='const char *' +netdb_net_type='unsigned long' +nroff='nroff' +nvsize='8' +nvtype='double' +o_nonblock='O_NONBLOCK' +obj_ext='.o' +optimize='-O2' +orderlib='false' +osname='unknown' +phostname='hostname' +pidtype=int +pm_apiversion='5.005' +privlib='/usr/local/lib/perl5/5.6' +privlibexp='/usr/local/lib/perl5/5.6' +prototype='undef' +ptrsize=1 +quadkind='4' +quadtype='int64_t' +randbits='48' +randfunc='drand48' +randseedtype='int' +rd_nodata='-1' +sPRIEldbl='"llE"' +sPRIFldbl='"llF"' +sPRIGldbl='"llG"' +sPRIX64='"LX"' +sPRId64='"Ld"' +sPRIeldbl='"lle"' +sPRIfldbl='"llf"' +sPRIgldbl='"llg"' +sPRIi64='"Li"' +sPRIo64='"Lo"' +sPRIu64='"Lu"' +sPRIx64='"Lx"' +sched_yield='sched_yield()' +scriptdir='/usr/local/bin' +scriptdirexp='/usr/local/bin' +seedfunc='srand' +selectminbits='32' +selecttype=int +shmattype='void *' +shortsize=1 +sig_count='64' +sig_name_init='0' +sig_num_init='0' +signal_t=int +sizetype=int +sizesize=1 +ssizetype=int +stdchar=char +stdio_base='((fp)->_IO_read_base)' +stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)' +stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)' +stdio_filbuf='' +stdio_ptr='((fp)->_IO_read_ptr)' +stdio_stream_array='' +timetype=int +touch='touch' +u16size='2' +u16type='unsigned short' +u32size='4' +u32type='unsigned long' +u64size='8' +u64type='uint64_t' +u8size='1' +u8type='unsigned char' +uidformat='"lu"' +uidsign='1' +uidsize='4' +uidtype=int +uquadtype='uint64_t' +use5005threads='undef' +use64bits='undef' +usedl='undef' +useithreads='undef' +uselargefiles='undef' +uselongdouble='undef' +uselonglong='undef' +usemorebits='undef' +usemultiplicity='undef' +usemymalloc='n' +usenm='false' +useopcode='true' +useperlio='undef' +useposix='true' +usesfio='false' +useshrplib='false' +usesocks='undef' +usethreads='undef' +usevendorprefix='undef' +usevfork='false' +uvoformat='"lo"' +uvsize='4' +uvtype='unsigned long' +uvuformat='"lu"' +uvxformat='"lx"' +voidflags=1 +xs_apiversion='5.005' +d_getfsstat='undef' +d_int64_t='undef' +d_lseekproto='undef' +d_madvise='undef' +d_mmap='undef' +use64bitint='undef' +use64bitall='undef' +d_vendorarch='undef' +d_vendorarch='undef' +i_ieeefp='undef' +i_sunmath='undef' +i_sysmode='undef' +i_sysutsname='undef' +d_frexpl='undef' +d_modfl='undef' +d_getespwnam='undef' +d_getprpwnam='undef' +d_isnan='undef' +d_isnanl='undef' +i_prot='undef' +d_perl_otherlibdirs='undef' +inc_version_list_init='NULL' +socksizetype='int' + + @@ -5,6 +5,8 @@ * here. */ +#ifndef PERL_MICRO + /* HAS_IOCTL: * This symbol, if defined, indicates that the ioctl() routine is * available to set I/O characteristics @@ -33,6 +35,8 @@ #define HAS_KILL #define HAS_WAIT + +#endif /* !PERL_MICRO */ /* USEMYBINMODE * This symbol, if defined, indicates that the program should @@ -134,6 +134,30 @@ Perl_is_utf8_char(pTHX_ U8 *s) return len; } +/* +=for apidoc Am|bool_utf8_string|U8 *s|STRLEN len + +Returns true if first C<len> bytes of the given string form valid a UTF8 +string, false otherwise. + +=cut +*/ + +bool +Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len) +{ + U8* x=s; + U8* send=s+len; + int c; + while (x < send) { + c = is_utf8_char(x); + x += c; + if (!c || x > send) + return 0; + } + return 1; +} + UV Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen) { @@ -222,19 +246,100 @@ Perl_utf8_hop(pTHX_ U8 *s, I32 off) return s; } -/* XXX NOTHING CALLS THE FOLLOWING TWO ROUTINES YET!!! */ /* - * Convert native or reversed UTF-16 to UTF-8. +=for apidoc Am|U8 *|utf8_to_bytes|U8 *s|STRLEN len + +Converts a string C<s> of length C<len> from UTF8 into ASCII encoding. +Unlike C<bytes_to_utf8>, this over-writes the original string. +Returns zero on failure after converting as much as possible. + +=cut +*/ + +U8 * +Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN len) +{ + dTHR; + U8 *send; + U8 *d; + U8 *save; + + send = s + len; + d = save = s; + while (s < send) { + if (*s < 0x80) + *d++ = *s++; + else { + I32 ulen; + UV uv = utf8_to_uv(s, &ulen); + if (uv > 255) { + *d = '\0'; + return 0; + } + s += ulen; + *d++ = (U8)uv; + } + } + *d = '\0'; + return save; +} + +/* +=for apidoc Am|U8 *|bytes_to_utf8|U8 *s|STRLEN *len + +Converts a string C<s> of length C<len> from ASCII into UTF8 encoding. +Returns a pointer to the newly-created string, and sets C<len> to +reflect the new length. + +=cut +*/ + +U8* +Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN *len) +{ + dTHR; + U8 *send; + U8 *d; + U8 *dst; + send = s + (*len); + + Newz(801, d, (*len) * 2 + 1, U8); + dst = d; + + while (s < send) { + if (*s < 0x80) + *d++ = *s++; + else { + UV uv = *s++; + *d++ = (( uv >> 6) | 0xc0); + *d++ = (( uv & 0x3f) | 0x80); + } + } + *d = '\0'; + *len = d-dst; + return dst; +} + +/* + * Convert native (big-endian) or reversed (little-endian) UTF-16 to UTF-8. * * Destination must be pre-extended to 3/2 source. Do not use in-place. * We optimize for native, for obvious reasons. */ U8* -Perl_utf16_to_utf8(pTHX_ U16* p, U8* d, I32 bytelen) +Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen) { - U16* pend = p + bytelen / 2; + U8* pend; + U8* dstart = d; + + if (bytelen & 1) + Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen"); + + pend = p + bytelen; + while (p < pend) { - UV uv = *p++; + UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */ + p += 2; if (uv < 0x80) { *d++ = uv; continue; @@ -246,13 +351,9 @@ Perl_utf16_to_utf8(pTHX_ U16* p, U8* d, I32 bytelen) } if (uv >= 0xd800 && uv < 0xdbff) { /* surrogates */ dTHR; - int low = *p++; - if (low < 0xdc00 || low >= 0xdfff) { - if (ckWARN_d(WARN_UTF8)) - Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-16 surrogate"); - p--; - uv = 0xfffd; - } + UV low = *p++; + if (low < 0xdc00 || low >= 0xdfff) + Perl_croak(aTHX_ "Malformed UTF-16 surrogate"); uv = ((uv - 0xd800) << 10) + (low - 0xdc00) + 0x10000; } if (uv < 0x10000) { @@ -269,13 +370,14 @@ Perl_utf16_to_utf8(pTHX_ U16* p, U8* d, I32 bytelen) continue; } } + *newlen = d - dstart; return d; } /* Note: this one is slightly destructive of the source. */ U8* -Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8* d, I32 bytelen) +Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen) { U8* s = (U8*)p; U8* send = s + bytelen; @@ -285,7 +387,7 @@ Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8* d, I32 bytelen) s[1] = tmp; s += 2; } - return utf16_to_utf8(p, d, bytelen); + return utf16_to_utf8(p, d, bytelen, newlen); } /* for now these are all defined (inefficiently) in terms of the utf8 versions */ @@ -791,7 +893,7 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr) if (hv == PL_last_swash_hv && klen == PL_last_swash_klen && - (!klen || memEQ(ptr,PL_last_swash_key,klen)) ) + (!klen || memEQ((char *)ptr,(char *)PL_last_swash_key,klen)) ) { tmps = PL_last_swash_tmps; slen = PL_last_swash_slen; @@ -16,6 +16,7 @@ #define PERL_IN_UTIL_C #include "perl.h" +#ifndef PERL_MICRO #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> #endif @@ -23,6 +24,7 @@ #ifndef SIG_ERR # define SIG_ERR ((Sighandler_t) -1) #endif +#endif /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD @@ -87,7 +89,7 @@ Perl_safesysmalloc(MEM_SIZE size) if ((long)size < 0) Perl_croak_nocontext("panic: malloc"); #endif - ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ + ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ PERL_ALLOC_CHECK(ptr); DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); if (ptr != Nullch) @@ -131,7 +133,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) if ((long)size < 0) Perl_croak_nocontext("panic: realloc"); #endif - ptr = PerlMem_realloc(where,size); + ptr = (Malloc_t)PerlMem_realloc(where,size); PERL_ALLOC_CHECK(ptr); DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++)); @@ -184,7 +186,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) Perl_croak_nocontext("panic: calloc"); #endif size *= count; - ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ + ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ PERL_ALLOC_CHECK(ptr); DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) calloc %ld x %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)count,(long)size)); if (ptr != Nullch) { @@ -1000,7 +1002,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit if ( SvTAIL(littlestr) && (bigend - big == littlelen - 1) && (littlelen == 1 - || (*big == *little && memEQ(big, little, littlelen - 1)))) + || (*big == *little && + memEQ((char *)big, (char *)little, littlelen - 1)))) return (char*)big; return Nullch; } @@ -1168,7 +1171,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit } check_end: if ( s == bigend && (table[-1] & FBMcf_TAIL) - && memEQ(bigend - littlelen, oldlittle - littlelen, littlelen) ) + && memEQ((char *)(bigend - littlelen), + (char *)(oldlittle - littlelen), littlelen) ) return (char*)bigend - littlelen; return Nullch; } @@ -1283,7 +1287,8 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift return (char*)big; big -= stop_pos; if (*big == first - && ((stop_pos == 1) || memEQ(big + 1, little, stop_pos - 1))) + && ((stop_pos == 1) || + memEQ((char *)(big + 1), (char *)little, stop_pos - 1))) return (char*)big; return Nullch; } @@ -1580,14 +1585,20 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) SV *msv; STRLEN msglen; - msv = vmess(pat, args); - if (PL_errors && SvCUR(PL_errors)) { - sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); - SvCUR_set(PL_errors, 0); + if (pat) { + msv = vmess(pat, args); + if (PL_errors && SvCUR(PL_errors)) { + sv_catsv(PL_errors, msv); + message = SvPV(PL_errors, msglen); + SvCUR_set(PL_errors, 0); + } + else + message = SvPV(msv,msglen); + } + else { + message = Nullch; + msglen = 0; } - else - message = SvPV(msv,msglen); DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message)); @@ -1606,9 +1617,14 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) ENTER; save_re_context(); - msg = newSVpvn(message, msglen); - SvREADONLY_on(msg); - SAVEFREESV(msg); + if (message) { + msg = newSVpvn(message, msglen); + SvREADONLY_on(msg); + SAVEFREESV(msg); + } + else { + msg = ERRSV; + } PUSHSTACKi(PERLSI_DIEHOOK); PUSHMARK(SP); @@ -1655,9 +1671,16 @@ Perl_croak_nocontext(const char *pat, ...) /* =for apidoc croak -This is the XSUB-writer's interface to Perl's C<die> function. Use this -function the same way you use the C C<printf> function. See -C<warn>. +This is the XSUB-writer's interface to Perl's C<die> function. +Normally use this function the same way you use the C C<printf> +function. See C<warn>. + +If you want to throw an exception object, assign the object to +C<$@> and then pass C<Nullch> to croak(): + + errsv = get_sv("@", TRUE); + sv_setsv(errsv, exception_object); + croak(Nullch); =cut */ @@ -2301,7 +2324,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) PERL_FLUSHALL_FOR_CHILD; #ifdef OS2 if (doexec) { - return my_syspopen(cmd,mode); + return my_syspopen(aTHX_ cmd,mode); } #endif This = (*mode == 'w'); @@ -2379,7 +2402,9 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) PerlLIO_close(p[This]); p[This] = p[that]; } + LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,p[This],TRUE); + UNLOCK_FDPID_MUTEX; (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = pid; PL_forkprocess = pid; @@ -2473,7 +2498,7 @@ dup2(int oldfd, int newfd) } #endif - +#ifndef PERL_MICRO #ifdef HAS_SIGACTION Sighandler_t @@ -2576,6 +2601,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) } #endif /* !HAS_SIGACTION */ +#endif /* !PERL_MICRO */ /* VMS' my_pclose() is in VMS.c; same with OS/2 */ #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) @@ -2596,7 +2622,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) int saved_win32_errno; #endif + LOCK_FDPID_MUTEX; svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE); + UNLOCK_FDPID_MUTEX; pid = SvIVX(*svp); SvREFCNT_dec(*svp); *svp = &PL_sv_undef; @@ -2617,15 +2645,19 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) #ifdef UTS if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ #endif +#ifndef PERL_MICRO rsignal_save(SIGHUP, SIG_IGN, &hstat); rsignal_save(SIGINT, SIG_IGN, &istat); rsignal_save(SIGQUIT, SIG_IGN, &qstat); +#endif do { pid2 = wait4pid(pid, &status, 0); } while (pid2 == -1 && errno == EINTR); +#ifndef PERL_MICRO rsignal_restore(SIGHUP, &hstat); rsignal_restore(SIGINT, &istat); rsignal_restore(SIGQUIT, &qstat); +#endif if (close_failed) { SETERRNO(saved_errno, saved_vaxc_errno); return -1; @@ -3464,6 +3496,35 @@ Perl_condpair_magic(pTHX_ SV *sv) return mg; } +SV * +Perl_sv_lock(pTHX_ SV *osv) +{ + MAGIC *mg; + SV *sv = osv; + + LOCK_SV_LOCK_MUTEX; + if (SvROK(sv)) { + sv = SvRV(sv); + } + + mg = condpair_magic(sv); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) == thr) + MUTEX_UNLOCK(MgMUTEXP(mg)); + else { + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + DEBUG_S(PerlIO_printf(Perl_debug_log, + "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(sv));) + MUTEX_UNLOCK(MgMUTEXP(mg)); + SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); + } + UNLOCK_SV_LOCK_MUTEX; + return sv; +} + /* * Make a new perl thread structure using t as a prototype. Some of the * fields for the new thread are copied from the prototype thread, t, @@ -3643,12 +3704,12 @@ Perl_get_opargs(pTHX) PPADDR_t* Perl_get_ppaddr(pTHX) { - return &PL_ppaddr; + return (PPADDR_t*)PL_ppaddr; } #ifndef HAS_GETENV_LEN char * -Perl_getenv_len(pTHX_ char *env_elem, unsigned long *len) +Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len) { char *env_trans = PerlEnv_getenv(env_elem); if (env_trans) @@ -3835,7 +3896,7 @@ Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj) assert(gv); sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); + gv_efullname4(sv, gv, Nullch, FALSE); name = SvPVX(sv); Perl_warner(aTHX_ WARN_CLOSED, "%s() on closed %s %s", func, obj, name); @@ -26,7 +26,11 @@ (*(f) == '/' \ || ((f)[0] && (f)[1] == ':')) /* drive name */ # else /* !DOSISH */ -# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') +# ifdef MACOS_TRADITIONAL +# define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':')) +# else /* !MACOS_TRADITIONAL */ +# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') +# endif /* MACOS_TRADITIONAL */ # endif /* DOSISH */ # endif /* WIN32 */ #endif /* VMS */ diff --git a/utils/h2xs.PL b/utils/h2xs.PL index ca0e7cbc32..2885c6f5ee 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -13,9 +13,9 @@ use Cwd; # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; +my $origdir = cwd; chdir dirname($0); -$file = basename($0, '.PL'); +my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; @@ -41,7 +41,7 @@ h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS -B<h2xs> [B<-ACOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]] +B<h2xs> [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [headerfile ... [extra_libraries]] B<h2xs> B<-h> @@ -78,7 +78,7 @@ S<C<use AutoLoader>> statement from the .pm file. Omits creation of the F<Changes> file, and adds a HISTORY section to the POD template. -=item B<-F> +=item B<-F> I<addflags> Additional flags to specify to C preprocessor when scanning header for function declarations. Should not be used without B<-x>. @@ -191,6 +191,18 @@ hand-editing. Such may be objects which cannot be converted from/to a pointer (like C<long long>), pointers to functions, or arrays. See also the section on L<LIMITATIONS of B<-x>>. +=item B<-b> I<version> + +Generates a .pm file which is backwards compatible with the specified +perl version. + +For versions < 5.6.0, the changes are. + - no use of 'our' (uses 'use vars' instead) + - no 'use warnings' + +Specifying a compatibility version higher than the version of perl you +are using to run h2xs will have no effect. + =back =head1 EXAMPLES @@ -332,12 +344,13 @@ use strict; my( $H2XS_VERSION ) = ' $Revision: 1.20 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; +my $compat_version = $]; use Getopt::Std; sub usage{ warn "@_\n" if @_; - die "h2xs [-ACOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]] + die "h2xs [-ACOPXacdfhkmx] [-F addflags] [-M fmask] [-n module_name] [-o tmask] [-p prefix] [-s subs] [-v version] [headerfile [extra_libraries]] version: $H2XS_VERSION -A Omit all autoloading facilities (implies -c). -C Omit creating the Changes file, add HISTORY heading to stub POD. @@ -359,6 +372,7 @@ version: $H2XS_VERSION -s Create subroutines for specified macros. -v Specify a version number for this extension. -x Autogenerate XSUBs using C::Scan. + -b Specify a perl version to be backwards compatibile with extra_libraries are any libraries that might be needed for loading the extension, e.g. -lm would try to link in the math library. @@ -366,12 +380,22 @@ extra_libraries } -getopts("ACF:M:OPXacdfhkmn:o:p:s:v:x") || usage; +getopts("ACF:M:OPXacdfhkmn:o:p:s:v:xb:") || usage; use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_a $opt_c $opt_d - $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x); + $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x + $opt_b); usage if $opt_h; +if( $opt_b ){ + usage "You cannot use -b and -m at the same time.\n" if ($opt_b && $opt_m); + $opt_b =~ /^\d+\.\d+\.\d+/ || + usage "You must provide the backwards compatibility version in X.Y.Z form. " . + "(i.e. 5.5.0)\n"; + my ($maj,$min,$sub) = split(/\./,$opt_b,3); + $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub); +} + if( $opt_v ){ $TEMPLATE_VERSION = $opt_v; } @@ -685,13 +709,23 @@ open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n" $" = "\n\t"; warn "Writing $ext$modpname/$modfname.pm\n"; +if ( $compat_version < 5.006 ) { print PM <<"END"; package $module; -require 5.005_62; +use $compat_version; +use strict; +END +} +else { +print PM <<"END"; +package $module; + +use 5.006; use strict; use warnings; END +} unless( $opt_X || $opt_c || $opt_A ){ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and @@ -721,15 +755,25 @@ unless ($opt_A) { # no autoloader whatsoever. } } +if ( $compat_version < 5.006 ) { + if ( $opt_X || $opt_c || $opt_A ) { + print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);'; + } else { + print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);'; + } +} + # Determine @ISA. my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this. $myISA .= ' DynaLoader' unless $opt_X; # no XS $myISA .= ');'; +$myISA =~ s/^our // if $compat_version < 5.006; + print PM "\n$myISA\n\n"; my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls); -print PM<<"END"; +my $tmp=<<"END"; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @@ -750,10 +794,15 @@ our \$VERSION = '$TEMPLATE_VERSION'; END +$tmp =~ s/^our //mg if $compat_version < 5.006; +print PM $tmp; + if (@vdecls) { printf PM "our(@{[ join ', ', map '$'.$_, @vdecls ]});\n\n"; } + +$tmp = ( $compat_version < 5.006 ? "" : "our \$AUTOLOAD;" ); print PM <<"END" unless $opt_c or $opt_X; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() @@ -761,7 +810,7 @@ sub AUTOLOAD { # to the AUTOLOAD in AutoLoader. my \$constname; - our \$AUTOLOAD; + $tmp (\$constname = \$AUTOLOAD) =~ s/.*:://; croak "&$module::constant not defined" if \$constname eq 'constant'; my \$val = constant(\$constname, \@_ ? \$_[0] : 0); @@ -834,48 +883,48 @@ my $email = 'a.u.thor@a.galaxy.far.far.away'; my $revhist = ''; $revhist = <<EOT if $opt_C; - -=head1 HISTORY - -=over 8 - -=item $TEMPLATE_VERSION - -Original version; created by h2xs $H2XS_VERSION with options - - @ARGS - -=back - +# +#=head1 HISTORY +# +#=over 8 +# +#=item $TEMPLATE_VERSION +# +#Original version; created by h2xs $H2XS_VERSION with options +# +# @ARGS +# +#=back +# EOT my $exp_doc = <<EOD; - -=head2 EXPORT - -None by default. - +# +#=head2 EXPORT +# +#None by default. +# EOD if (@const_names and not $opt_P) { $exp_doc .= <<EOD; -=head2 Exportable constants - - @{[join "\n ", @const_names]} - +#=head2 Exportable constants +# +# @{[join "\n ", @const_names]} +# EOD } if (defined $fdecls and @$fdecls and not $opt_P) { $exp_doc .= <<EOD; -=head2 Exportable functions - +#=head2 Exportable functions +# EOD - $exp_doc .= <<EOD if $opt_p; -When accessing these functions from Perl, prefix C<$opt_p> should be removed. - +# $exp_doc .= <<EOD if $opt_p; +#When accessing these functions from Perl, prefix C<$opt_p> should be removed. +# EOD $exp_doc .= <<EOD; - @{[join "\n ", @known_fnames{@fnames}]} - +# @{[join "\n ", @known_fnames{@fnames}]} +# EOD } @@ -898,14 +947,14 @@ my $pod = <<"END" unless $opt_P; #unedited. # #Blah blah blah. -#$exp_doc$revhist +$exp_doc$revhist #=head1 AUTHOR # #$author, $email # #=head1 SEE ALSO # -#perl(1). +#L<perl>. # #=cut END diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 9e7936dfcb..d9389ce7d1 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -45,7 +45,7 @@ while (<PATCH_LEVEL>) { my $patch_desc = "'" . join("',\n '", @patches) . "'"; my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches; -close PATCH_LEVEL; +close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!"; # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is # used, compare $Config::config_sh with the stored version. If they differ then @@ -91,7 +91,7 @@ BEGIN { $::HaveUtil = ($@ eq ""); }; -my $Version = "1.29"; +my $Version = "1.31"; # Changed in 1.06 to skip Mail::Send and Mail::Util if not available. # Changed in 1.07 to see more sendmail execs, and added pipe output. @@ -125,6 +125,8 @@ my $Version = "1.29"; # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27 # Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000 # Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000 +# Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000 +# Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000 # TODO: - Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is @@ -519,7 +521,7 @@ EOF } # Generate report - open(REP,">$filename"); + open(REP,">$filename") or die "Unable to create report file `$filename': $!\n"; my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success"; print REP <<EOF; @@ -536,7 +538,7 @@ EOF while (<F>) { print REP $_ } - close(F); + close(F) or die "Error closing `$file': $!"; } else { print REP <<EOF; @@ -550,17 +552,17 @@ EOF EOF } Dump(*REP); - close(REP); + close(REP) or die "Error closing report file: $!"; # read in the report template once so that # we can track whether the user does any editing. # yes, *all* whitespace is ignored. - open(REP, "<$filename"); + open(REP, "<$filename") or die "Unable to open report file `$filename': $!\n"; while (<REP>) { s/\s+//g; $REP{$_}++; } - close(REP); + close(REP) or die "Error closing report file `$filename': $!"; } # sub Query sub Dump { @@ -640,7 +642,8 @@ EOF } tryagain: - my $sts = system("$ed $filename") unless $Is_MacOS; + my $sts; + $sts = system("$ed $filename") unless $Is_MacOS; if ($Is_MacOS) { require ExtUtils::MakeMaker; ExtUtils::MM_MacOS::launch_file($filename); @@ -674,7 +677,7 @@ EOF # Check that we have a report that has some, eh, report in it. my $unseen = 0; - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open `$filename': $!\n"; # a strange way to check whether any significant editing # have been done: check whether any new non-empty lines # have been added. Yes, the below code ignores *any* space @@ -729,22 +732,22 @@ EOF print "\nError opening $file: $!\n\n"; goto retry; } - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n"; print FILE "To: $address\nSubject: $subject\n"; print FILE "Cc: $cc\n" if $cc; print FILE "Reply-To: $from\n" if $from; print FILE "\n"; while (<REP>) { print FILE } - close(REP); - close(FILE); + close(REP) or die "Error closing report file `$filename': $!"; + close(FILE) or die "Error closing $file: $!"; print "\nMessage saved in `$file'.\n"; exit; } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow # Display the message - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n"; while (<REP>) { print $_ } - close(REP); + close(REP) or die "Error closing report file `$filename': $!"; } elsif ($action =~ /^se/i) { # <S>end # Send the message print "Are you certain you want to send this message?\n" @@ -786,9 +789,9 @@ sub Send { $msg->add("Reply-To",$from) if $from; $fh = $msg->open; - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open `$filename': $!\n"; while (<REP>) { print $fh $_ } - close(REP); + close(REP) or die "Error closing $filename: $!"; $fh->close; print "\nMessage sent.\n"; @@ -840,9 +843,9 @@ sendout: print SENDMAIL "Cc: $cc\n" if $cc; print SENDMAIL "Reply-To: $from\n" if $from; print SENDMAIL "\n\n"; - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open `$filename': $!\n"; while (<REP>) { print SENDMAIL $_ } - close(REP); + close(REP) or die "Error closing $filename: $!"; if (close(SENDMAIL)) { printf "\nMessage %s.\n", $outfile ? "saved" : "sent"; diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c index 0e7894aeb9..0e4ad86682 100644 --- a/vmesa/vmesa.c +++ b/vmesa/vmesa.c @@ -182,11 +182,13 @@ do_aspawn(SV* really, SV **mark, SV **sp) /* be used by my_pclose */ /*---------------------------------------------*/ close(fd); + MUTEX_LOCK(&PL_fdpid_mutex); p_sv = av_fetch(PL_fdpid,fd,TRUE); fd = (int) SvIVX(*p_sv); SvREFCNT_dec(*p_sv); *p_sv = &PL_sv_undef; sv = *av_fetch(PL_fdpid,fd,TRUE); + MUTEX_UNLOCK(&PL_fdpid_mutex); (void) SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; status = 0; @@ -408,11 +410,13 @@ my_popen(char *cmd, char *mode) Perl_stdin_fd = pFd[that]; if (strNE(cmd,"-")) { - PERL_FLUSHALL_FOR_CHILD; + PERL_FLUSHALL_FOR_CHILD; pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd); if (pid >= 0) { + MUTEX_LOCK(&PL_fdpid_mutex); sv = *av_fetch(PL_fdpid,pFd[this],TRUE); + MUTEX_UNLOCK(&PL_fdpid_mutex); (void) SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; fd = PerlIO_fdopen(pFd[this], mode); @@ -423,7 +427,9 @@ my_popen(char *cmd, char *mode) } else { + MUTEX_LOCK(&PL_fdpid_mutex); sv = *av_fetch(PL_fdpid,pFd[that],TRUE); + MUTEX_UNLOCK(&PL_fdpid_mutex); (void) SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pFd[this]; fd = PerlIO_fdopen(pFd[this], mode); @@ -460,7 +466,9 @@ my_pclose(FILE *fp) SV **sv; FILE *other; + MUTEX_LOCK(&PL_fdpid_mutex); sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); + MUTEX_UNLOCK(&PL_fdpid_mutex); pid = (int) SvIVX(*sv); SvREFCNT_dec(*sv); *sv = &PL_sv_undef; diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 77772c95ef..2bf0114532 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -266,13 +266,13 @@ FULLLIBS2 = $(LIBS2)|$(THRLIBS1)|$(THRLIBS2) #### End of system configuration section. #### c0 = $(MALLOC_C) $(SOCKC) av.c deb.c doio.c doop.c dump.c globals.c gv.c -c1 = hv.c mg.c miniperlmain.c op.c perl.c perlio.c perly.c pp.c pp_ctl.c +c1 = hv.c mg.c miniperlmain.c op.c perl.c perlapi.c perlio.c perly.c pp.c pp_ctl.c c2 = pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c sv.c taint.c c3 = toke.c universal.c utf8.c util.c vms.c xsutils.c c = $(c0) $(c1) $(c2) $(c3) obj0 = $(MALLOC_O) $(SOCKO) av$(O) deb$(O) doio$(O) doop$(O) dump$(O) -obj1 = globals$(O) gv$(O) hv$(O) mg$(O) miniperlmain$(O) op$(O) perl$(O) +obj1 = globals$(O) gv$(O) hv$(O) mg$(O) miniperlmain$(O) op$(O) perl$(O) perlapi$(O) obj2 = perlio$(O) perly$(O) pp$(O) pp_ctl$(O) pp_hot$(O) pp_sys$(O) regcomp$(O) obj3 = regexec$(O) run$(O) scope$(O) sv$(O) taint$(O) toke$(O) universal$(O) obj4 = utf8$(O) util$(O) vms$(O) xsutils$(O) @@ -327,7 +327,7 @@ CRTLOPTS =,$(CRTL)/Options .endif # Modules which must be installed before we can build extensions -LIBPREREQ = $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib]XSLoader.pm [.lib]vmsish.pm [.lib.VMS]Filespec.pm [.lib.ExtUtils]XSSymSet.pm +LIBPREREQ = $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib]XSLoader.pm [.lib]lib.pm [.lib]vmsish.pm [.lib.VMS]Filespec.pm [.lib.ExtUtils]XSSymSet.pm utils1 = [.lib.pod]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com [.utils]h2xs.com [.lib]perlbug.com [.lib]perlcc.com [.utils]dprofpp.com utils2 = [.lib]splain.com [.utils]pl2pm.com @@ -479,6 +479,9 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) [.lib]vmsish.pm : [.vms.ext]vmsish.pm Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) +[.lib]lib.pm : [.lib]lib_pm.PL + $(MINIPERL) $(MMS$SOURCE) + [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm @ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) @@ -792,7 +795,7 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) [.lib.pod]perlxstut.pod : [.pod]perlxstut.pod @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] Copy/Log $(MMS$SOURCE) $(MMS$TARGET) -[.lib.pod]win32.pod : [.pod]win32.pod +[.lib.pod]win32.pod : [.lib]win32.pod @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] Copy/Log $(MMS$SOURCE) $(MMS$TARGET) [.lib.pod]perlvms.pod : [.vms]perlvms.pod @@ -1083,6 +1086,8 @@ gv$(O) : gv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsy $(CC) $(CORECFLAGS) $(MMS$SOURCE) hv$(O) : hv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h $(CC) $(CORECFLAGS) $(MMS$SOURCE) +malloc$(O) : malloc.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h + $(CC) $(CORECFLAGS) $(MMS$SOURCE) mg$(O) : mg.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h $(CC) $(CORECFLAGS) $(MMS$SOURCE) miniperlmain$(O) : miniperlmain.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h @@ -1091,6 +1096,8 @@ op$(O) : op.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsy $(CC) $(CORECFLAGS) $(MMS$SOURCE) perl$(O) : perl.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h patchlevel.h intrpvar.h thrdvar.h $(CC) $(CORECFLAGS) $(MMS$SOURCE) +perlapi$(O) : perlapi.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h patchlevel.h intrpvar.h thrdvar.h + $(CC) $(CORECFLAGS) $(MMS$SOURCE) perlio$(O) : perlio.c config.h extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h $(CC) $(CORECFLAGS) $(MMS$SOURCE) perlmain$(O) : perlmain.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h perl.h regexp.h sv.h util.h form.h gv.h cv.h opnames.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h diff --git a/vms/munchconfig.c b/vms/munchconfig.c index 158de3caf5..82768db12c 100644 --- a/vms/munchconfig.c +++ b/vms/munchconfig.c @@ -345,8 +345,7 @@ tilde_sub(char LineBuffer[], Translate TildeSub[], int TildeSubCount) } else { /* 'Kay, not a tilde. Is it a word character? */ - if (isalnum(LineBuffer[TildeLoop]) || (LineBuffer[TildeLoop] = - '-') || + if (isalnum(LineBuffer[TildeLoop]) || (LineBuffer[TildeLoop] == '-')) { TempTilde[TildeBufferLength++] = LineBuffer[TildeLoop]; } else { diff --git a/vms/perlvms.pod b/vms/perlvms.pod index e6d13f3081..17e83e5c1b 100644 --- a/vms/perlvms.pod +++ b/vms/perlvms.pod @@ -122,7 +122,7 @@ I<N.B.> The procedure by which extensions are built and tested creates several levels (at least 4) under the directory in which the extension's source files live. For this reason, you shouldn't nest the source directory -too deeply in your directory structure, lest you eccedd RMS' +too deeply in your directory structure, lest you exceed RMS' maximum of 8 levels of subdirectory in a filespec. (You can use rooted logical names to get another 8 levels of nesting, if you can't place the files near the top of @@ -167,7 +167,7 @@ translates to the full file specification of the shareable image. We have tried to make Perl aware of both VMS-style and Unix- style file specifications wherever possible. You may use either style, or both, on the command line and in scripts, -but you may not combine the two styles within a single fle +but you may not combine the two styles within a single file specification. VMS Perl interprets Unix pathnames in much the same way as the CRTL (I<e.g.> the first component of an absolute path is read as the device name for the @@ -233,7 +233,7 @@ Perl will wait for the subprocess to complete before continuing. =head1 PERL5LIB and PERLLIB -The PERL5LIB and PERLLIB logical names work as documented L<perl>, +The PERL5LIB and PERLLIB logical names work as documented in L<perl>, except that the element separator is '|' instead of ':'. The directory specifications may use either VMS or Unix syntax. @@ -516,7 +516,7 @@ true, a warning message is printed, and C<undef> is returned. =item kill -In most cases, C<kill> kill is implemented via the CRTL's C<kill()> +In most cases, C<kill> is implemented via the CRTL's C<kill()> function, so it will behave according to that function's documentation. If you send a SIGKILL, however, the $DELPRC system service is called directly. This insures that the target @@ -592,7 +592,7 @@ The array returned by the C<times> operator is divided up according to the same rules the CRTL C<times()> routine. Therefore, the "system time" elements will always be 0, since there is no difference between "user time" and "system" time -under VMS, and the time accumulated by subprocess may or may +under VMS, and the time accumulated by a subprocess may or may not appear separately in the "child time" field, depending on whether L<times> keeps track of subprocesses separately. Note especially that the VAXCRTL (at least) keeps track only of @@ -604,7 +604,9 @@ or backticks. C<unlink> will delete the highest version of a file only; in order to delete all versions, you need to say + 1 while (unlink LIST); + You may need to make this change to scripts written for a Unix system which expect that after a call to C<unlink>, no files with the names passed to C<unlink> will exist. @@ -644,8 +646,8 @@ time of the file (VMS revision date). =item waitpid PID,FLAGS -If PID is a subprocess started by a piped L<open>, C<waitpid> -will wait for that subprocess, and return its final +If PID is a subprocess started by a piped C<open()> (see L<open>), +C<waitpid> will wait for that subprocess, and return its final status value. If PID is a subprocess created in some other way (e.g. SPAWNed before Perl was invoked), or is not a subprocess of the current process, C<waitpid> will check once per second whether @@ -694,7 +696,7 @@ an element of C<%ENV>, the local symbol table is scanned first, followed by the global symbol table.. The characters following C<CLISYM_> are significant when an element of C<%ENV> is set or deleted: if the complete string is C<CLISYM_LOCAL>, the change is made in the local -symbol table, otherwise the global symbol table is changed. +symbol table; otherwise the global symbol table is changed. =item Any other string @@ -751,7 +753,7 @@ copy of Perl knows about the CRTL's C<setenv()> function. (This is present only in some versions of the DECCRTL; check C<$Config{d_setenv}> to see whether your copy of Perl was built with a CRTL that has this function.) - + When an element of C<%ENV> is set to C<undef>, the element is looked up as if it were being read, and if it is found, it is deleted. (An item "deleted" from the CRTL C<environ> @@ -796,7 +798,7 @@ to logical name tables caused by other programs. You do need to be careful with the logicals representing process-permanent files, such as C<SYS$INPUT> and C<SYS$OUTPUT>. The translations for these logicals are prepended with a two-byte binary value (0x1B 0x00) that needs to be -stripped off if you want to use it. (In previous versions of perl it wasn't +stripped off if you want to use it. (In previous versions of Perl it wasn't possible to get the values of these logicals, as the null byte acted as an end-of-string marker) @@ -830,7 +832,7 @@ portably test for successful completion of subprocesses. The low order 8 bits of C<$?> are always 0 under VMS, since the termination status of a process may or may not have been generated by an exception. The next 8 bits are derived from -severity portion of the subprocess' exit status: if the +the severity portion of the subprocess' exit status: if the severity was success or informational, these bits are all 0; otherwise, they contain the severity value shifted left one bit. As a result, C<$?> will always be zero if the subprocess' exit @@ -841,7 +843,7 @@ be found in C<$^S> (q.v.). =item $^S Under VMS, this is the 32-bit VMS status value returned by the -last subprocess to complete. Unlink C<$?>, no manipulation +last subprocess to complete. Unlike C<$?>, no manipulation is done to make this look like a POSIX wait(5) value, so it may be treated as a normal VMS status value. diff --git a/vms/perly_c.vms b/vms/perly_c.vms index b17faeade1..0676ebd249 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1387,6 +1387,9 @@ yyparse() #endif struct ysv *ysave; +#ifdef USE_ITHREADS + ENTER; /* force yydestruct() before we return */ +#endif New(73, ysave, 1, struct ysv); SAVEDESTRUCTOR_X(yydestruct, ysave); ysave->oldyydebug = yydebug; @@ -2479,6 +2482,9 @@ yyoverflow: yyabort: retval = 1; yyaccept: +#ifdef USE_ITHREADS + LEAVE; /* force yydestruct() before we return */ +#endif return retval; } diff --git a/vms/subconfigure.com b/vms/subconfigure.com index 4aea63bb62..ebb59e5af0 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -69,7 +69,10 @@ $ myname = myhostname $ IF myname .EQS. "" THEN myname = F$TRNLNM("SYS$NODE") $! $! ##ADD NEW CONSTANTS HERE## -$ perl_d_isnan= = "define" +$ perl_i_prot="undef" +$ perl_d_getespwnam="undef" +$ perl_d_getprpwnam="undef" +$ perl_d_isnan= "define" $ perl_sizesize = "4" $ perl_shmattype = "" $ perl_mmaptype = "" @@ -110,10 +113,7 @@ $ perl_i_sysmman="undef" $ perl_d_telldirproto="define" $ perl_i_sysmount="undef" $ perl_d_bincompat="undef" -$ perl_d_endspent="undef -$ perl_d_getspent="undef $ perl_d_getspnam="undef -$ perl_d_setspent="undef $ perl_d_fstatfs="undef" $ perl_d_getfsstat="undef" $ perl_i_machcthreads="undef" @@ -4027,6 +4027,7 @@ $ WC "subversion='" + subversion + "'" $ WC "PERL_VERSION='" + patchlevel + "'" $ WC "PERL_SUBVERSION='" + subversion + "'" $ WC "pager='" + perl_pager + "'" +$ WC "make='" + make + "'" $ WC "uidtype='" + perl_uidtype + "'" $ WC "uidformat='" + perl_uidformat + "'" $ WC "uidsize='" + perl_uidsize + "'" @@ -4192,10 +4193,7 @@ $ WC "vendorlib_stem='" + perl_vendorlib_stem + "'" $ WC "d_atolf='" + perl_d_atolf + "'" $ WC "d_atoll='" + perl_d_atoll + "'" $ WC "d_bincompat5005='" + perl_d_bincompat + "'" -$ WC "d_endspent='" + perl_d_endspent + "'" -$ WC "d_getspent='" + perl_d_getspent + "'" $ WC "d_getspnam='" + perl_d_getspnam + "'" -$ WC "d_setspent='" + perl_d_setspent + "'" $ WC "i_shadow='" + perl_i_shadow + "'" $ WC "i_socks='" + perl_i_socks + "'" $ WC "d_PRIfldbl='" + perl_d_PRIfldbl + "'" @@ -4265,6 +4263,9 @@ $ WC "d_frexpl='" + perl_d_frexpl + "'" $ WC "d_isnan='" + perl_d_isnan + "'" $ WC "d_isnanl='" + perl_d_isnanl + "'" $ WC "d_modfl='" + perl_d_modfl + "'" +$ WC "d_getprpwnam='" + perl_d_getprpwnam + "'" +$ WC "d_getespwnam='" + perl_d_getespwnam + "'" +$ WC "i_prot='" + perl_i_prot + "'" $! $! ##WRITE NEW CONSTANTS HERE## $! diff --git a/vms/test.com b/vms/test.com index 1039525e9e..b8ede8911e 100644 --- a/vms/test.com +++ b/vms/test.com @@ -93,8 +93,9 @@ $ $! And do it $ Show Process/Accounting $ testdir = "Directory/NoHead/NoTrail/Column=1" -$ Define/User 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe' -$ set message/nofacil/nosever/noiden/notext +$ oldshr = F$TrnLNm("''dbg'PerlShr","LNM$PROCESS") +$ If F$Length(oldshr).ne.0 Then Write Sys$Error "Superseding ''dbg'PerlShr . . ." +$ Define 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe' $ MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'" $ Deck/Dollar=$$END-OF-TEST$$ # $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $ @@ -241,8 +242,17 @@ print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n", $user,$sys,$cuser,$csys,$files,$totmax); $$END-OF-TEST$$ $ wrapup: +$ If F$Length(oldshr).ne.0 +$ Then +$ Write Sys$Error "restoring ''dbg'PerlShr . . ." +$ Def/Translation=Concealed 'dbg'PerlShr 'oldshr' +$ Else +$ Deassign 'dbg'PerlShr +$ EndIf $ Show Process/Accounting $ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;* $ Set Default &olddef $ Set Message 'oldmsg' $ Exit + + @@ -79,6 +79,16 @@ struct itmlst_3 { unsigned short int *retlen; }; +#define do_fileify_dirspec(a,b,c) mp_do_fileify_dirspec(aTHX_ a,b,c) +#define do_pathify_dirspec(a,b,c) mp_do_pathify_dirspec(aTHX_ a,b,c) +#define do_tovmsspec(a,b,c) mp_do_tovmsspec(aTHX_ a,b,c) +#define do_tovmspath(a,b,c) mp_do_tovmspath(aTHX_ a,b,c) +#define do_rmsexpand(a,b,c,d,e) mp_do_rmsexpand(aTHX_ a,b,c,d,e) +#define do_tounixspec(a,b,c) mp_do_tounixspec(aTHX_ a,b,c) +#define do_tounixpath(a,b,c) mp_do_tounixpath(aTHX_ a,b,c) +#define expand_wild_cards(a,b,c,d) mp_expand_wild_cards(aTHX_ a,b,c,d) +#define getredirection(a,b) mp_getredirection(aTHX_ a,b) + static char *__mystrtolower(char *str) { if (str) for (; *str; ++str) *str= tolower(*str); @@ -103,7 +113,7 @@ static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch}; /*{{{int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) */ int -vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, +Perl_vmstrnenv(pTHX_ const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) { char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2; @@ -240,7 +250,7 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, /*{{{ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)*/ /* Define as a function so we can access statics. */ -int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx) +int Perl_my_trnlnm(pTHX_ const char *lnm, char *eqv, unsigned long int idx) { return vmstrnenv(lnm,eqv,idx,fildev, #ifdef SECURE_INTERNAL_GETENV @@ -384,7 +394,7 @@ prime_env_iter(void) $DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(clitabdsc,"DCLTABLES"); $DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM"); $DESCRIPTOR(local,"_LOCAL"); $DESCRIPTOR(mbxdsc,mbxnam); -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) static perl_mutex primenv_mutex; MUTEX_INIT(&primenv_mutex); #endif @@ -757,13 +767,13 @@ my_crypt(const char *textpasswd, const char *usrname) /*}}}*/ -static char *do_rmsexpand(char *, char *, int, char *, unsigned); -static char *do_fileify_dirspec(char *, char *, int); -static char *do_tovmsspec(char *, char *, int); +static char *mp_do_rmsexpand(pTHX_ char *, char *, int, char *, unsigned); +static char *mp_do_fileify_dirspec(pTHX_ char *, char *, int); +static char *mp_do_tovmsspec(pTHX_ char *, char *, int); /*{{{int do_rmdir(char *name)*/ int -do_rmdir(char *name) +Perl_do_rmdir(pTHX_ char *name) { char dirfile[NAM$C_MAXRSS+1]; int retval; @@ -1110,7 +1120,7 @@ popen_completion_ast(struct pipe_details *thispipe) } static unsigned long int setup_cmddsc(char *cmd, int check_img); -static void vms_execfree(); +static void vms_execfree(pTHX); static PerlIO * safe_popen(char *cmd, char *mode) @@ -1157,7 +1167,7 @@ safe_popen(char *cmd, char *mode) 0, popen_completion_ast,info,0,0,0)); } - vms_execfree(); + vms_execfree(aTHX); if (!handler_set_up) { _ckvmssts(sys$dclexh(&pipe_exitblock)); handler_set_up = TRUE; @@ -1315,10 +1325,10 @@ my_gconvert(double val, int ndig, int trail, char *buf) * rmesexpand() returns the address of the resultant string if * successful, and NULL on error. */ -static char *do_tounixspec(char *, char *, int); +static char *mp_do_tounixspec(pTHX_ char *, char *, int); static char * -do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) +mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) { static char __rmsexpand_retbuf[NAM$C_MAXRSS+1]; char vmsfspec[NAM$C_MAXRSS+1], tmpfspec[NAM$C_MAXRSS+1]; @@ -1453,9 +1463,9 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) } /*}}}*/ /* External entry points */ -char *rmsexpand(char *spec, char *buf, char *def, unsigned opt) +char *Perl_rmsexpand(pTHX_ char *spec, char *buf, char *def, unsigned opt) { return do_rmsexpand(spec,buf,0,def,opt); } -char *rmsexpand_ts(char *spec, char *buf, char *def, unsigned opt) +char *Perl_rmsexpand_ts(pTHX_ char *spec, char *buf, char *def, unsigned opt) { return do_rmsexpand(spec,buf,1,def,opt); } @@ -1494,7 +1504,7 @@ char *rmsexpand_ts(char *spec, char *buf, char *def, unsigned opt) */ /*{{{ char *fileify_dirspec[_ts](char *path, char *buf)*/ -static char *do_fileify_dirspec(char *dir,char *buf,int ts) +static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts) { static char __fileify_retbuf[NAM$C_MAXRSS+1]; unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0; @@ -1806,13 +1816,13 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } /* end of do_fileify_dirspec() */ /*}}}*/ /* External entry points */ -char *fileify_dirspec(char *dir, char *buf) +char *Perl_fileify_dirspec(pTHX_ char *dir, char *buf) { return do_fileify_dirspec(dir,buf,0); } -char *fileify_dirspec_ts(char *dir, char *buf) +char *Perl_fileify_dirspec_ts(pTHX_ char *dir, char *buf) { return do_fileify_dirspec(dir,buf,1); } /*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/ -static char *do_pathify_dirspec(char *dir,char *buf, int ts) +static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts) { static char __pathify_retbuf[NAM$C_MAXRSS+1]; unsigned long int retlen; @@ -1992,13 +2002,13 @@ static char *do_pathify_dirspec(char *dir,char *buf, int ts) } /* end of do_pathify_dirspec() */ /*}}}*/ /* External entry points */ -char *pathify_dirspec(char *dir, char *buf) +char *Perl_pathify_dirspec(pTHX_ char *dir, char *buf) { return do_pathify_dirspec(dir,buf,0); } -char *pathify_dirspec_ts(char *dir, char *buf) +char *Perl_pathify_dirspec_ts(pTHX_ char *dir, char *buf) { return do_pathify_dirspec(dir,buf,1); } /*{{{ char *tounixspec[_ts](char *path, char *buf)*/ -static char *do_tounixspec(char *spec, char *buf, int ts) +static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts) { static char __tounixspec_retbuf[NAM$C_MAXRSS+1]; char *dirend, *rslt, *cp1, *cp2, *cp3, tmp[NAM$C_MAXRSS+1]; @@ -2122,11 +2132,11 @@ static char *do_tounixspec(char *spec, char *buf, int ts) } /* end of do_tounixspec() */ /*}}}*/ /* External entry points */ -char *tounixspec(char *spec, char *buf) { return do_tounixspec(spec,buf,0); } -char *tounixspec_ts(char *spec, char *buf) { return do_tounixspec(spec,buf,1); } +char *Perl_tounixspec(pTHX_ char *spec, char *buf) { return do_tounixspec(spec,buf,0); } +char *Perl_tounixspec_ts(pTHX_ char *spec, char *buf) { return do_tounixspec(spec,buf,1); } /*{{{ char *tovmsspec[_ts](char *path, char *buf)*/ -static char *do_tovmsspec(char *path, char *buf, int ts) { +static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) { static char __tovmsspec_retbuf[NAM$C_MAXRSS+1]; char *rslt, *dirend; register char *cp1, *cp2; @@ -2266,11 +2276,11 @@ static char *do_tovmsspec(char *path, char *buf, int ts) { } /* end of do_tovmsspec() */ /*}}}*/ /* External entry points */ -char *tovmsspec(char *path, char *buf) { return do_tovmsspec(path,buf,0); } -char *tovmsspec_ts(char *path, char *buf) { return do_tovmsspec(path,buf,1); } +char *Perl_tovmsspec(pTHX_ char *path, char *buf) { return do_tovmsspec(path,buf,0); } +char *Perl_tovmsspec_ts(pTHX_ char *path, char *buf) { return do_tovmsspec(path,buf,1); } /*{{{ char *tovmspath[_ts](char *path, char *buf)*/ -static char *do_tovmspath(char *path, char *buf, int ts) { +static char *mp_do_tovmspath(pTHX_ char *path, char *buf, int ts) { static char __tovmspath_retbuf[NAM$C_MAXRSS+1]; int vmslen; char pathified[NAM$C_MAXRSS+1], vmsified[NAM$C_MAXRSS+1], *cp; @@ -2294,12 +2304,12 @@ static char *do_tovmspath(char *path, char *buf, int ts) { } /* end of do_tovmspath() */ /*}}}*/ /* External entry points */ -char *tovmspath(char *path, char *buf) { return do_tovmspath(path,buf,0); } -char *tovmspath_ts(char *path, char *buf) { return do_tovmspath(path,buf,1); } +char *Perl_tovmspath(pTHX_ char *path, char *buf) { return do_tovmspath(path,buf,0); } +char *Perl_tovmspath_ts(pTHX_ char *path, char *buf) { return do_tovmspath(path,buf,1); } /*{{{ char *tounixpath[_ts](char *path, char *buf)*/ -static char *do_tounixpath(char *path, char *buf, int ts) { +static char *mp_do_tounixpath(pTHX_ char *path, char *buf, int ts) { static char __tounixpath_retbuf[NAM$C_MAXRSS+1]; int unixlen; char pathified[NAM$C_MAXRSS+1], unixified[NAM$C_MAXRSS+1], *cp; @@ -2323,8 +2333,8 @@ static char *do_tounixpath(char *path, char *buf, int ts) { } /* end of do_tounixpath() */ /*}}}*/ /* External entry points */ -char *tounixpath(char *path, char *buf) { return do_tounixpath(path,buf,0); } -char *tounixpath_ts(char *path, char *buf) { return do_tounixpath(path,buf,1); } +char *Perl_tounixpath(pTHX_ char *path, char *buf) { return do_tounixpath(path,buf,0); } +char *Perl_tounixpath_ts(pTHX_ char *path, char *buf) { return do_tounixpath(path,buf,1); } /* * @(#)argproc.c 2.2 94/08/16 Mark Pizzolato (mark@infocomm.com) @@ -2369,10 +2379,10 @@ static void add_item(struct list_item **head, char *value, int *count); -static void expand_wild_cards(char *item, - struct list_item **head, - struct list_item **tail, - int *count); +static void mp_expand_wild_cards(pTHX_ char *item, + struct list_item **head, + struct list_item **tail, + int *count); static int background_process(int argc, char **argv); @@ -2380,7 +2390,7 @@ static void pipe_and_fork(char **cmargv); /*{{{ void getredirection(int *ac, char ***av)*/ static void -getredirection(int *ac, char ***av) +mp_getredirection(pTHX_ int *ac, char ***av) /* * Process vms redirection arg's. Exit if any error is seen. * If getredirection() processes an argument, it is erased @@ -2630,7 +2640,7 @@ static void add_item(struct list_item **head, ++(*count); } -static void expand_wild_cards(char *item, +static void mp_expand_wild_cards(pTHX_ char *item, struct list_item **head, struct list_item **tail, int *count) @@ -2984,7 +2994,7 @@ vms_image_init(int *argcp, char ***argvp) */ /*{{{int trim_unixpath(char *fspec, char *wildspec, int opts)*/ int -trim_unixpath(char *fspec, char *wildspec, int opts) +Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts) { char unixified[NAM$C_MAXRSS+1], unixwild[NAM$C_MAXRSS+1], *template, *base, *end, *cp1, *cp2; @@ -3143,7 +3153,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts) */ /*{{{ DIR *opendir(char*name) */ DIR * -opendir(char *name) +Perl_opendir(pTHX_ char *name) { DIR *dd; char dir[NAM$C_MAXRSS+1]; @@ -3397,7 +3407,7 @@ my_vfork() static void -vms_execfree() { +vms_execfree(pTHX) { if (PL_Cmd) { if (PL_Cmd != VMScmd.dsc$a_pointer) Safefree(PL_Cmd); PL_Cmd = Nullch; @@ -3647,7 +3657,7 @@ vms_do_exec(char *cmd) Perl_warner(aTHX_ WARN_EXEC,"Can't exec \"%*s\": %s", VMScmd.dsc$w_length, VMScmd.dsc$a_pointer, Strerror(errno)); } - vms_execfree(); + vms_execfree(aTHX); } return FALSE; @@ -3712,7 +3722,7 @@ do_spawn(char *cmd) Strerror(errno)); } } - vms_execfree(); + vms_execfree(aTHX); return substs; } /* end of do_spawn() */ @@ -4858,7 +4868,7 @@ my_getlogin() */ /*{{{int rmscopy(char *src, char *dst, int preserve_dates)*/ int -rmscopy(char *spec_in, char *spec_out, int preserve_dates) +Perl_rmscopy(pTHX_ char *spec_in, char *spec_out, int preserve_dates) { char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS], rsa[NAM$C_MAXRSS], ubf[32256]; @@ -5220,6 +5230,82 @@ rmscopy_fromperl(pTHX_ CV *cv) XSRETURN(1); } + +void +mod2fname(CV *cv) +{ + dXSARGS; + char ultimate_name[NAM$C_MAXRSS+1], work_name[NAM$C_MAXRSS*8 + 1], + workbuff[NAM$C_MAXRSS*1 + 1]; + int total_namelen = 3, counter, num_entries; + /* ODS-5 ups this, but we want to be consistent, so... */ + int max_name_len = 39; + AV *in_array = (AV *)SvRV(ST(0)); + + num_entries = av_len(in_array); + + /* All the names start with PL_. */ + strcpy(ultimate_name, "PL_"); + + /* Clean up our working buffer */ + Zero(work_name, sizeof(work_name), char); + + /* Run through the entries and build up a working name */ + for(counter = 0; counter <= num_entries; counter++) { + /* If it's not the first name then tack on a __ */ + if (counter) { + strcat(work_name, "__"); + } + strcat(work_name, SvPV(*av_fetch(in_array, counter, FALSE), + PL_na)); + } + + /* Check to see if we actually have to bother...*/ + if (strlen(work_name) + 3 <= max_name_len) { + strcat(ultimate_name, work_name); + } else { + /* It's too darned big, so we need to go strip. We use the same */ + /* algorithm as xsubpp does. First, strip out doubled __ */ + char *source, *dest, last; + dest = workbuff; + last = 0; + for (source = work_name; *source; source++) { + if (last == *source && last == '_') { + continue; + } + *dest++ = *source; + last = *source; + } + /* Go put it back */ + strcpy(work_name, workbuff); + /* Is it still too big? */ + if (strlen(work_name) + 3 > max_name_len) { + /* Strip duplicate letters */ + last = 0; + dest = workbuff; + for (source = work_name; *source; source++) { + if (last == toupper(*source)) { + continue; + } + *dest++ = *source; + last = toupper(*source); + } + strcpy(work_name, workbuff); + } + + /* Is it *still* too big? */ + if (strlen(work_name) + 3 > max_name_len) { + /* Too bad, we truncate */ + work_name[max_name_len - 2] = 0; + } + strcat(ultimate_name, work_name); + } + + /* Okay, return it */ + ST(0) = sv_2mortal(newSVpv(ultimate_name, 0)); + XSRETURN(1); +} + void init_os_extras() { @@ -5240,6 +5326,7 @@ init_os_extras() newXSproto("VMS::Filespec::vmspath",vmspath_fromperl,file,"$"); newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$"); newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$"); + newXSproto("DynaLoader::mod2fname", mod2fname, file, "$"); newXS("File::Copy::rmscopy",rmscopy_fromperl,file); return; diff --git a/vms/vmsish.h b/vms/vmsish.h index 382e314743..104eabce1e 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -91,43 +91,63 @@ #define DONT_DECLARE_STD 1 /* Our own contribution to PerlShr's global symbols . . . */ -#define vmstrnenv Perl_vmstrnenv -#define my_trnlnm Perl_my_trnlnm #define my_getenv_len Perl_my_getenv_len #define prime_env_iter Perl_prime_env_iter #define vmssetenv Perl_vmssetenv #if !defined(PERL_IMPLICIT_CONTEXT) +#define my_trnlnm Perl_my_trnlnm +#define vmstrnenv Perl_vmstrnenv #define my_setenv Perl_my_setenv #define my_getenv Perl_my_getenv +#define tounixspec Perl_tounixspec +#define tounixspec_ts Perl_tounixspec_ts +#define tovmsspec Perl_tovmsspec +#define tovmsspec_ts Perl_tovmsspec_ts +#define tounixpath Perl_tounixpath +#define tounixpath_ts Perl_tounixpath_ts +#define tovmspath Perl_tovmspath +#define tovmspath_ts Perl_tovmspath_ts +#define do_rmdir Perl_do_rmdir +#define fileify_dirspec Perl_fileify_dirspec +#define fileify_dirspec_ts Perl_fileify_dirspec_ts +#define pathify_dirspec Perl_pathify_dirspec +#define pathify_dirspec_ts Perl_pathify_dirspec_ts +#define trim_unixpath Perl_trim_unixpath +#define opendir Perl_opendir +#define rmscopy Perl_rmscopy #else +#define my_trnlnm(a,b,c) Perl_my_trnlnm(aTHX_ a,b,c) +#define vmstrnenv(a,b,c,d,e) Perl_vmstrnenv(aTHX_ a,b,c,d,e) #define my_setenv(a,b) Perl_my_setenv(aTHX_ a,b) #define my_getenv(a,b) Perl_my_getenv(aTHX_ a,b) +#define tounixspec(a,b) Perl_tounixspec(aTHX_ a,b) +#define tounixspec_ts(a,b) Perl_tounixspec_ts(aTHX_ a,b) +#define tovmsspec(a,b) Perl_tovmsspec(aTHX_ a,b) +#define tovmsspec_t(a,b) Perl_tovmsspec_ts(aTHX_ a,b) +#define tounixpath(a,b) Perl_tounixpath(aTHX_ a,b) +#define tounixpath_ts(a,b) Perl_tounixpath_ts(aTHX_ a,b) +#define tovmspath(a,b) Perl_tovmspath(aTHX_ a,b) +#define tovmspath_ts(a,b) Perl_tovmspath_ts(aTHX_ a,b) +#define do_rmdir(a) Perl_do_rmdir(aTHX_ a) +#define fileify_dirspec(a,b) Perl_fileify_dirspec(aTHX_ a,b) +#define fileify_dirspec_ts(a,b) Perl_fileify_dirspec_ts(aTHX_ a,b) +#define pathify_dirspec Perl_pathify_dirspec +#define pathify_dirspec_ts Perl_pathify_dirspec_ts +#define rmsexpand(a,b,c,d) Perl_rmsexpand(aTHX_ a,b,c,d) +#define rmsexpand_ts(a,b,c,d) Perl_rmsexpand_ts(aTHX_ a,b,c,d) +#define trim_unixpath(a,b,c) Perl_trim_unixpath(aTHX_ a,b,c) +#define opendir(a) Perl_opendir(aTHX_ a) +#define rmscopy(a,b,c) Perl_rmscopy(aTHX_ a,b,c) #endif #define my_crypt Perl_my_crypt #define my_waitpid Perl_my_waitpid #define my_gconvert Perl_my_gconvert -#define do_rmdir Perl_do_rmdir #define kill_file Perl_kill_file #define my_mkdir Perl_my_mkdir #define my_chdir Perl_my_chdir #define my_tmpfile Perl_my_tmpfile #define my_utime Perl_my_utime -#define rmsexpand Perl_rmsexpand -#define rmsexpand_ts Perl_rmsexpand_ts -#define fileify_dirspec Perl_fileify_dirspec -#define fileify_dirspec_ts Perl_fileify_dirspec_ts -#define pathify_dirspec Perl_pathify_dirspec -#define pathify_dirspec_ts Perl_pathify_dirspec_ts -#define tounixspec Perl_tounixspec -#define tounixspec_ts Perl_tounixspec_ts -#define tovmsspec Perl_tovmsspec -#define tovmsspec_ts Perl_tovmsspec_ts -#define tounixpath Perl_tounixpath -#define tounixpath_ts Perl_tounixpath_ts -#define tovmspath Perl_tovmspath -#define tovmspath_ts Perl_tovmspath_ts #define vms_image_init Perl_vms_image_init -#define opendir Perl_opendir #define readdir Perl_readdir #define telldir Perl_telldir #define seekdir Perl_seekdir @@ -145,7 +165,6 @@ #define cando_by_name Perl_cando_by_name #define flex_fstat Perl_flex_fstat #define flex_stat Perl_flex_stat -#define trim_unixpath Perl_trim_unixpath #define my_vfork Perl_my_vfork #define vms_do_aexec Perl_vms_do_aexec #define vms_do_exec Perl_vms_do_exec @@ -158,7 +177,6 @@ #define my_getpwent Perl_my_getpwent #define my_endpwent Perl_my_endpwent #define my_getlogin Perl_my_getlogin -#define rmscopy Perl_rmscopy #define init_os_extras Perl_init_os_extras /* Delete if at all possible, changing protections if necessary. */ @@ -638,40 +656,62 @@ void prime_env_iter (void); void init_os_extras (); /* prototype section start marker; `typedef' passes through cpp */ typedef char __VMS_PROTOTYPES__; -int vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int); -int my_trnlnm (const char *, char *, unsigned long int); #if !defined(PERL_IMPLICIT_CONTEXT) char * Perl_my_getenv (const char *, bool); +int Perl_vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int); +int Perl_my_trnlnm (const char *, char *, unsigned long int); +char * Perl_tounixspec (char *, char *); +char * Perl_tounixspec_ts (char *, char *); +char * Perl_tovmsspec (char *, char *); +char * Perl_tovmsspec_ts (char *, char *); +char * Perl_tounixpath (char *, char *); +char * Perl_tounixpath_ts (char *, char *); +char * Perl_tovmspath (char *, char *); +char * Perl_tovmspath_ts (char *, char *); +int Perl_do_rmdir (char *); +char * Perl_fileify_dirspec (char *, char *); +char * Perl_fileify_dirspec_ts (char *, char *); +char * Perl_pathify_dirspec (char *, char *); +char * Perl_pathify_dirspec_ts (char *, char *); +char * Perl_rmsexpand (char *, char *, char *, unsigned); +char * Perl_rmsexpand_ts (char *, char *, char *, unsigned); +int Perl_trim_unixpath (char *, char*, int); +DIR * Perl_opendir (char *); +int Perl_rmscopy (char *, char *, int); #else +int Perl_vmstrnenv (pTHX_ const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int); char * Perl_my_getenv (pTHX_ const char *, bool); +int Perl_my_trnlnm (pTHX_ const char *, char *, unsigned long int); +char * Perl_tounixspec (pTHX_ char *, char *); +char * Perl_tounixspec_ts (pTHX_ char *, char *); +char * Perl_tovmsspec (pTHX_ char *, char *); +char * Perl_tovmsspec_ts (pTHX_ char *, char *); +char * Perl_tounixpath (pTHX_ char *, char *); +char * Perl_tounixpath_ts (pTHX_ char *, char *); +char * Perl_tovmspath (pTHX_ char *, char *); +char * Perl_tovmspath_ts (pTHX_ char *, char *); +int Perl_do_rmdir (pTHX_ char *); +char * Perl_fileify_dirspec (pTHX_ char *, char *); +char * Perl_fileify_dirspec_ts (pTHX_ char *, char *); +char * Perl_pathify_dirspec (pTHX_ char *, char *); +char * Perl_pathify_dirspec_ts (pTHX_ char *, char *); +char * Perl_rmsexpand (pTHX_ char *, char *, char *, unsigned); +char * Perl_rmsexpand_ts (pTHX_ char *, char *, char *, unsigned); +int Perl_trim_unixpath (pTHX_ char *, char*, int); +DIR * Perl_opendir (pTHX_ char *); +int Perl_rmscopy (pTHX_ char *, char *, int); #endif char * my_getenv_len (const char *, unsigned long *, bool); int vmssetenv (char *, char *, struct dsc$descriptor_s **); char * my_crypt (const char *, const char *); Pid_t my_waitpid (Pid_t, int *, int); char * my_gconvert (double, int, int, char *); -int do_rmdir (char *); int kill_file (char *); int my_mkdir (char *, Mode_t); int my_chdir (char *); FILE * my_tmpfile (void); int my_utime (char *, struct utimbuf *); -char * rmsexpand (char *, char *, char *, unsigned); -char * rmsexpand_ts (char *, char *, char *, unsigned); -char * fileify_dirspec (char *, char *); -char * fileify_dirspec_ts (char *, char *); -char * pathify_dirspec (char *, char *); -char * pathify_dirspec_ts (char *, char *); -char * tounixspec (char *, char *); -char * tounixspec_ts (char *, char *); -char * tovmsspec (char *, char *); -char * tovmsspec_ts (char *, char *); -char * tounixpath (char *, char *); -char * tounixpath_ts (char *, char *); -char * tovmspath (char *, char *); -char * tovmspath_ts (char *, char *); void vms_image_init (int *, char ***); -DIR * opendir (char *); struct dirent * readdir (DIR *); long telldir (DIR *); void seekdir (DIR *, long); @@ -691,7 +731,6 @@ int my_sigprocmask (int, sigset_t *, sigset_t *); I32 cando_by_name (I32, Uid_t, char *); int flex_fstat (int, Stat_t *); int flex_stat (const char *, Stat_t *); -int trim_unixpath (char *, char*, int); int my_vfork (); bool vms_do_aexec (SV *, SV **, SV **); bool vms_do_exec (char *); @@ -704,7 +743,6 @@ struct passwd * my_getpwuid (Uid_t uid); struct passwd * my_getpwent (); void my_endpwent (); char * my_getlogin (); -int rmscopy (char *, char *, int); typedef char __VMS_SEPYTOTORP__; /* prototype section end marker; `typedef' passes through cpp */ diff --git a/vos/config.def b/vos/config.def index 092d76ad3d..1ef1effe84 100644 --- a/vos/config.def +++ b/vos/config.def @@ -53,7 +53,6 @@ $d_endnent='define' $d_endpent='define' $d_endpwent='undef' $d_endsent='define' -$d_endspent='undef' $d_eofnblk='define' $d_fchmod='define' $d_fchown='undef' @@ -74,6 +73,7 @@ $d_fstatvfs='undef' $d_ftello='undef' $d_Gconvert='sprintf((b),"%.*g",(n),(x))' $d_getcwd='define' +$d_getespwnam='undef' $d_getfsstat='undef' $d_getgrent='undef' $d_getgrps='undef' @@ -98,12 +98,12 @@ $d_getpgrp='define' $d_getppid='define' $d_getprior='undef' $d_getprotoprotos='define' +$d_getprpwnam='undef' $d_getpwent='undef' $d_getsbyname='define' $d_getsbyport='define' $d_getsent='define' $d_getservprotos='define' -$d_getspent='undef' $d_getspnam='undef' $d_gettimeod='undef' $d_gnulibc='undef' @@ -156,6 +156,7 @@ $d_munmap='undef' $d_mymalloc='undef' $d_nice='undef' $d_nv_preserves_uv='define' +$d_nv_preserves_uv_bits='32' $d_off64_t='undef' $d_old_pthread_create_joinable='undef' $d_oldpthreads='undef' @@ -216,7 +217,6 @@ $d_setrgid='undef' $d_setruid='undef' $d_setsent='define' $d_setsid='undef' -$d_setspent='undef' $d_setvbuf='define' $d_sfio='undef' $d_shm='undef' @@ -324,6 +324,7 @@ $i_neterrno='undef' $i_netinettcp='undef' $i_niin='define' $i_poll='undef' +$i_prot='undef' $i_pthread='undef' $i_pwd='undef' $i_rpcsvcdbm='undef' diff --git a/vos/config.h b/vos/config.h index 5e4e665a93..47942251ce 100644 --- a/vos/config.h +++ b/vos/config.h @@ -1324,12 +1324,6 @@ */ #define HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1401,6 +1395,12 @@ */ #define HAS_GETCWD /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM /**/ + /* HAS_GETFSSTAT: * This symbol, if defined, indicates that the getfsstat routine is * available to stat filesystems in bulk. @@ -1531,6 +1531,12 @@ */ #define HAS_GETPROTO_PROTOS /**/ +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1552,12 +1558,6 @@ */ #define HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. @@ -1739,6 +1739,13 @@ /*#define HAS_MMAP /**/ #define Mmap_t $mmaptype /**/ +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +/*#define HAS_MODFL /**/ + /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is * available to modify the access protection of a memory mapped file. @@ -1863,12 +1870,6 @@ */ #define HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2337,6 +2338,12 @@ */ /*#define I_POLL /**/ +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +/*#define I_PROT /**/ + /* I_PTHREAD: * This symbol, if defined, indicates to the C program that it should * include <pthread.h>. @@ -2588,6 +2595,16 @@ #define Netdb_name_t char * /**/ #define Netdb_net_t long /**/ +/* PERL_OTHERLIBDIRS: + * This variable contains a colon-separated set of paths for the perl + * binary to search for additional library files or modules. + * These directories will be tacked to the end of @INC. + * Perl will automatically search below each path for version- + * and architecture-specific directories. See PERL_INC_VERSION_LIST + * for more details. + */ +/*#define PERL_OTHERLIBDIRS "" /**/ + /* IVTYPE: * This symbol defines the C type used for Perl's IV. */ @@ -2656,7 +2673,7 @@ */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bits of a variable of type UVTYPE. */ #define IVTYPE int /**/ #define UVTYPE unsigned int /**/ @@ -3104,11 +3121,4 @@ #define PERL_XS_APIVERSION "5.00563" #define PERL_PM_APIVERSION "5.00563" -/* HAS_MODFL: - * This symbol, if defined, indicates that the modfl routine is - * available to split a long double x into a fractional part f and - * an integer part i such that |f| < 1.0 and (f + i) = x. - */ -/*#define HAS_MODFL /**/ - #endif diff --git a/vos/config_h.SH_orig b/vos/config_h.SH_orig index cc35077c79..1781def436 100755 --- a/vos/config_h.SH_orig +++ b/vos/config_h.SH_orig @@ -1342,12 +1342,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_endsent HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -#$d_endspent HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1419,6 +1413,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getcwd HAS_GETCWD /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +#$d_getespwnam HAS_GETESPWNAM /**/ + /* HAS_GETFSSTAT: * This symbol, if defined, indicates that the getfsstat routine is * available to stat filesystems in bulk. @@ -1549,6 +1549,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +#$d_getprpwnam HAS_GETPRPWNAM /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1570,12 +1576,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getservprotos HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -#$d_getspent HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. @@ -1757,6 +1757,13 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_mmap HAS_MMAP /**/ #define Mmap_t $mmaptype /**/ +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +#$d_modfl HAS_MODFL /**/ + /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is * available to modify the access protection of a memory mapped file. @@ -1881,12 +1888,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setsent HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -#$d_setspent HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2355,6 +2356,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_poll I_POLL /**/ +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +#$i_prot I_PROT /**/ + /* I_PTHREAD: * This symbol, if defined, indicates to the C program that it should * include <pthread.h>. @@ -2606,6 +2613,16 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define Netdb_name_t $netdb_name_type /**/ #define Netdb_net_t $netdb_net_type /**/ +/* PERL_OTHERLIBDIRS: + * This variable contains a colon-separated set of paths for the perl + * binary to search for additional library files or modules. + * These directories will be tacked to the end of @INC. + * Perl will automatically search below each path for version- + * and architecture-specific directories. See PERL_INC_VERSION_LIST + * for more details. + */ +#$d_perl_otherlibdirs PERL_OTHERLIBDIRS "$otherlibdirs" /**/ + /* IVTYPE: * This symbol defines the C type used for Perl's IV. */ @@ -2674,7 +2691,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bits of a variable of type UVTYPE. */ #define IVTYPE $ivtype /**/ #define UVTYPE $uvtype /**/ @@ -2732,16 +2749,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Pid_t $pidtype /* PID type */ -/* PERL_OTHERLIBDIRS: - * This variable contains a colon-separated set of paths for the perl - * binary to search for additional library files or modules. - * These directories will be tacked to the end of @INC. - * Perl will automatically search below each path for version- - * and architecture-specific directories. See PERL_INC_VERSION_LIST - * for more details. - */ -#$d_perl_otherlibdirs PERL_OTHERLIBDIRS "$otherlibdirs" /**/ - /* PRIVLIB: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's @@ -3132,12 +3139,5 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PERL_XS_APIVERSION "$xs_apiversion" #define PERL_PM_APIVERSION "$pm_apiversion" -/* HAS_MODFL: - * This symbol, if defined, indicates that the modfl routine is - * available to split a long double x into a fractional part f and - * an integer part i such that |f| < 1.0 and (f + i) = x. - */ -#$d_modfl HAS_MODFL /**/ - #endif !GROK!THIS! diff --git a/warnings.pl b/warnings.pl index 791beed353..0e74f3de90 100644 --- a/warnings.pl +++ b/warnings.pl @@ -382,7 +382,7 @@ will be used. =back -See L<perlmod/Pragmatic Modules> and L<perllexwarn>. +See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>. =cut diff --git a/win32/Makefile b/win32/Makefile index d669516974..1bcda2878c 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -972,6 +972,8 @@ utils: $(PERLEXE) $(X2P) copy ..\vms\perlvms.pod .\perlvms.pod copy ..\README.win32 .\perlwin32.pod $(MAKE) -f ..\win32\pod.mak converters + cd ..\lib + $(PERLEXE) lib_pm.PL cd ..\win32 $(PERLEXE) $(PL2BAT) $(UTILS) diff --git a/win32/config.bc b/win32/config.bc index ae854b46f9..4bce61b517 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -125,7 +125,6 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' -d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -149,6 +148,7 @@ d_fstatvfs='undef' d_ftello='undef' d_ftime='define' d_getcwd='undef' +d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' @@ -173,12 +173,12 @@ d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getprpwnam='undef' d_getpwent='undef' d_getsbyname='define' d_getsbyport='define' d_getsent='undef' d_getservprotos='define' -d_getspent='undef' d_getspnam='undef' d_gettimeod='undef' d_gnulibc='undef' @@ -235,6 +235,7 @@ d_munmap='undef' d_mymalloc='undef' d_nice='undef' d_nv_preserves_uv='define' +d_nv_preserves_uv_bits='32' d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' @@ -298,7 +299,6 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' -d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='undef' @@ -448,6 +448,7 @@ i_neterrno='undef' i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_prot='undef' i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' diff --git a/win32/config.gc b/win32/config.gc index f63813ed42..7f6a63ce89 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -125,7 +125,6 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' -d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -149,6 +148,7 @@ d_fstatvfs='undef' d_ftello='undef' d_ftime='define' d_getcwd='undef' +d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' @@ -173,12 +173,12 @@ d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getprpwnam='undef' d_getpwent='undef' d_getsbyname='define' d_getsbyport='define' d_getsent='undef' d_getservprotos='define' -d_getspent='undef' d_getspnam='undef' d_gettimeod='undef' d_gnulibc='undef' @@ -235,6 +235,7 @@ d_munmap='undef' d_mymalloc='undef' d_nice='undef' d_nv_preserves_uv='define' +d_nv_preserves_uv_bits='32' d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' @@ -298,7 +299,6 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' -d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='undef' @@ -448,6 +448,7 @@ i_neterrno='undef' i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_prot='undef' i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' diff --git a/win32/config.vc b/win32/config.vc index db52680dcb..853290db68 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -125,7 +125,6 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' -d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -149,6 +148,7 @@ d_fstatvfs='undef' d_ftello='undef' d_ftime='define' d_getcwd='undef' +d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' @@ -173,12 +173,12 @@ d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getprpwnam='undef' d_getpwent='undef' d_getsbyname='define' d_getsbyport='define' d_getsent='undef' d_getservprotos='define' -d_getspent='undef' d_getspnam='undef' d_gettimeod='undef' d_gnulibc='undef' @@ -235,6 +235,7 @@ d_munmap='undef' d_mymalloc='undef' d_nice='undef' d_nv_preserves_uv='define' +d_nv_preserves_uv_bits='32' d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' @@ -298,7 +299,6 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' -d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='undef' @@ -448,6 +448,7 @@ i_neterrno='undef' i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_prot='undef' i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' diff --git a/win32/config_H.bc b/win32/config_H.bc index 8ca757c913..3ed8e0476e 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -1331,12 +1331,6 @@ */ /*#define HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1546,18 +1540,30 @@ */ #define HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. */ /*#define HAS_GETSPNAM /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM /**/ + +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM /**/ + +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +/*#define I_PROT /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1857,12 +1863,6 @@ */ /*#define HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2647,7 +2647,11 @@ */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bit of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE long /**/ #define UVTYPE unsigned long /**/ @@ -2675,6 +2679,7 @@ #define U64SIZE 8 /**/ #endif #define NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 32 /* IVdf: * This symbol defines the format string used for printing a Perl IV diff --git a/win32/config_H.gc b/win32/config_H.gc index 289eadd767..dca79c1401 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -1331,12 +1331,6 @@ */ /*#define HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1546,18 +1540,30 @@ */ #define HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. */ /*#define HAS_GETSPNAM /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM /**/ + +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM /**/ + +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +/*#define I_PROT /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1857,12 +1863,6 @@ */ /*#define HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2647,7 +2647,11 @@ */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bit of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE long /**/ #define UVTYPE unsigned long /**/ @@ -2675,6 +2679,7 @@ #define U64SIZE 8 /**/ #endif #define NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 32 /* IVdf: * This symbol defines the format string used for printing a Perl IV diff --git a/win32/config_H.vc b/win32/config_H.vc index b0702f079c..cc9264691e 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1331,12 +1331,6 @@ */ /*#define HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in <sys/types.h> @@ -1546,18 +1540,30 @@ */ #define HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. */ /*#define HAS_GETSPNAM /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM /**/ + +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM /**/ + +/* I_PROT: + * This symbol, if defined, indicates that <prot.h> exists and + * should be included. + */ +/*#define I_PROT /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1857,12 +1863,6 @@ */ /*#define HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -2647,7 +2647,11 @@ */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bit of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE long /**/ #define UVTYPE unsigned long /**/ @@ -2675,6 +2679,7 @@ #define U64SIZE 8 /**/ #endif #define NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 32 /* IVdf: * This symbol defines the format string used for printing a Perl IV diff --git a/win32/config_h.PL b/win32/config_h.PL index 5b0450609f..91f35a4753 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -11,6 +11,9 @@ while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/) $opt{$1}=$2; shift(@ARGV); } + +$opt{CONFIG_H} ||= 'config.h'; + my $patchlevel = $opt{INST_VER}; $patchlevel =~ s|^[\\/]||; $patchlevel =~ s|~VERSION~|$Config{version}|g; @@ -24,6 +27,8 @@ while (<SH>) } ($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/; +$file =~ s/^\$(\w+)$/$opt{$1}/g; + my $str = "sub munge\n{\n"; while ($pat =~ s/-e\s+'([^']*)'\s*//) diff --git a/win32/makefile.mk b/win32/makefile.mk index 21836b22ec..6722a5efcf 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1191,6 +1191,7 @@ utils: $(PERLEXE) $(X2P) copy ..\README.os2 ..\pod\perlos2.pod copy ..\vms\perlvms.pod ..\pod\perlvms.pod cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters + cd ..\lib && $(PERLEXE) lib_pm.PL $(PERLEXE) $(PL2BAT) $(UTILS) distclean: clean diff --git a/win32/perllib.c b/win32/perllib.c index 857aada247..fae334608f 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -338,6 +338,10 @@ RunPerl(int argc, char **argv, char **env) EXTERN_C void set_w32_module_name(void); +EXTERN_C void +EndSockets(void); + + #ifdef __MINGW32__ EXTERN_C /* GCC in C++ mode mangles the name, otherwise */ #endif @@ -367,6 +371,7 @@ DllMain(HANDLE hModule, /* DLL module handle */ * process termination or call to FreeLibrary. */ case DLL_PROCESS_DETACH: + EndSockets(); break; /* The attached process creates a new thread. */ diff --git a/win32/vdir.h b/win32/vdir.h index df9a10b130..0b634a80fc 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -10,7 +10,11 @@ #ifndef ___VDir_H___ #define ___VDir_H___ -const int driveCount = 30; +/* + * Allow one slot for each possible drive letter + * and one additional slot for a UNC name + */ +const int driveCount = ('Z'-'A')+1+1; class VDir { @@ -105,6 +109,8 @@ protected: inline int DriveIndex(char chr) { + if (chr == '\\' || chr == '/') + return ('Z'-'A')+1; return (chr | 0x20)-'a'; }; @@ -366,8 +372,12 @@ char *VDir::MapPathA(const char *pInName) */ char szBuffer[(MAX_PATH+1)*2]; char szlBuf[MAX_PATH+1]; + int length = strlen(pInName); + + if (!length) + return (char*)pInName; - if (strlen(pInName) > MAX_PATH) { + if (length > MAX_PATH) { strncpy(szlBuf, pInName, MAX_PATH); if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { /* absolute path - reduce length by 2 for drive specifier */ @@ -430,32 +440,23 @@ char *VDir::MapPathA(const char *pInName) int VDir::SetCurrentDirectoryA(char *lpBuffer) { - HANDLE hHandle; - WIN32_FIND_DATA win32FD; - char szBuffer[MAX_PATH+1], *pPtr; + char *pPtr; int length, nRet = -1; - GetFullPathNameA(MapPathA(lpBuffer), sizeof(szBuffer), szBuffer, &pPtr); - /* if the last char is a '\\' or a '/' then add - * an '*' before calling FindFirstFile - */ - length = strlen(szBuffer); - if(length > 0 && IsPathSep(szBuffer[length-1])) { - szBuffer[length] = '*'; - szBuffer[length+1] = '\0'; + pPtr = MapPathA(lpBuffer); + length = strlen(pPtr); + if(length > 3 && IsPathSep(pPtr[length-1])) { + /* don't remove the trailing slash from 'x:\' */ + pPtr[length-1] = '\0'; } - hHandle = FindFirstFileA(szBuffer, &win32FD); - if (hHandle != INVALID_HANDLE_VALUE) { - FindClose(hHandle); - - /* if an '*' was added remove it */ - if(szBuffer[length] == '*') - szBuffer[length] = '\0'; - - SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); + DWORD r = GetFileAttributesA(pPtr); + if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY)) + { + SetDefaultDirA(pPtr, DriveIndex(pPtr[0])); nRet = 0; } + return nRet; } @@ -590,8 +591,12 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) */ WCHAR szBuffer[(MAX_PATH+1)*2]; WCHAR szlBuf[MAX_PATH+1]; + int length = wcslen(pInName); - if (wcslen(pInName) > MAX_PATH) { + if (!length) + return (WCHAR*)pInName; + + if (length > MAX_PATH) { wcsncpy(szlBuf, pInName, MAX_PATH); if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { /* absolute path - reduce length by 2 for drive specifier */ @@ -653,32 +658,23 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) int VDir::SetCurrentDirectoryW(WCHAR *lpBuffer) { - HANDLE hHandle; - WIN32_FIND_DATAW win32FD; - WCHAR szBuffer[MAX_PATH+1], *pPtr; + WCHAR *pPtr; int length, nRet = -1; - GetFullPathNameW(MapPathW(lpBuffer), (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr); - /* if the last char is a '\\' or a '/' then add - * an '*' before calling FindFirstFile - */ - length = wcslen(szBuffer); - if(length > 0 && IsPathSep(szBuffer[length-1])) { - szBuffer[length] = '*'; - szBuffer[length+1] = '\0'; + pPtr = MapPathW(lpBuffer); + length = wcslen(pPtr); + if(length > 3 && IsPathSep(pPtr[length-1])) { + /* don't remove the trailing slash from 'x:\' */ + pPtr[length-1] = '\0'; } - hHandle = FindFirstFileW(szBuffer, &win32FD); - if (hHandle != INVALID_HANDLE_VALUE) { - FindClose(hHandle); - - /* if an '*' was added remove it */ - if(szBuffer[length] == '*') - szBuffer[length] = '\0'; - - SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0])); + DWORD r = GetFileAttributesW(pPtr); + if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY)) + { + SetDefaultDirW(pPtr, DriveIndex((char)pPtr[0])); nRet = 0; } + return nRet; } diff --git a/win32/win32.c b/win32/win32.c index c589ff5e88..6856884472 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -53,7 +53,6 @@ #else #include <utime.h> #endif - #ifdef __GNUC__ /* Mingw32 defaults to globing command line * So we turn it off like this: @@ -1645,8 +1644,12 @@ win32_waitpid(int pid, int *status, int flags) long child = find_pseudo_pid(-pid); if (child >= 0) { HANDLE hThread = w32_pseudo_child_handles[child]; - DWORD waitcode = WaitForSingleObject(hThread, INFINITE); - if (waitcode != WAIT_FAILED) { + DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE; + DWORD waitcode = WaitForSingleObject(hThread, timeout); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode != WAIT_FAILED) { if (GetExitCodeThread(hThread, &waitcode)) { *status = (int)((waitcode & 0xff) << 8); retval = (int)w32_pseudo_child_pids[child]; @@ -1663,14 +1666,18 @@ win32_waitpid(int pid, int *status, int flags) long child = find_pid(pid); if (child >= 0) { HANDLE hProcess = w32_child_handles[child]; - DWORD waitcode = WaitForSingleObject(hProcess, INFINITE); - if (waitcode != WAIT_FAILED) { - if (GetExitCodeProcess(hProcess, &waitcode)) { - *status = (int)((waitcode & 0xff) << 8); - retval = (int)w32_child_pids[child]; - remove_dead_process(child); - return retval; - } + DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE; + DWORD waitcode = WaitForSingleObject(hProcess, timeout); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode != WAIT_FAILED) { + if (GetExitCodeProcess(hProcess, &waitcode)) { + *status = (int)((waitcode & 0xff) << 8); + retval = (int)w32_child_pids[child]; + remove_dead_process(child); + return retval; + } } else errno = ECHILD; @@ -2393,7 +2400,9 @@ win32_popen(const char *command, const char *mode) /* close saved handle */ win32_close(oldfd); + LOCK_FDPID_MUTEX; sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); + UNLOCK_FDPID_MUTEX; /* set process id so that it can be returned by perl's open() */ PL_forkprocess = childpid; @@ -2429,7 +2438,9 @@ win32_pclose(FILE *pf) int childpid, status; SV *sv; + LOCK_FDPID_MUTEX; sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE); + if (SvIOK(sv)) childpid = SvIVX(sv); else @@ -2442,6 +2453,7 @@ win32_pclose(FILE *pf) win32_fclose(pf); SvIVX(sv) = 0; + UNLOCK_FDPID_MUTEX; if (win32_waitpid(childpid, &status, 0) == -1) return -1; @@ -4032,6 +4044,8 @@ win32_get_child_IO(child_IO_table* ptbl) # define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init # undef Perl_sys_intern_dup # define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup +# undef Perl_sys_intern_clear +# define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear # define pPerl this # endif @@ -4052,6 +4066,18 @@ Perl_sys_intern_init(pTHX) w32_init_socktype = 0; } +void +Perl_sys_intern_clear(pTHX) +{ + Safefree(w32_perlshell_tokens); + Safefree(w32_perlshell_vec); + /* NOTE: w32_fdpid is freed by sv_clean_all() */ + Safefree(w32_children); +# ifdef USE_ITHREADS + Safefree(w32_pseudo_children); +# endif +} + # ifdef USE_ITHREADS void diff --git a/win32/win32.h b/win32/win32.h index 3929bcc15c..eb5ecd2971 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -135,6 +135,12 @@ struct utsname { #define USE_FIXED_OSFHANDLE #endif +/* Define PERL_WIN32_SOCK_DLOAD to have Perl dynamically load the winsock + DLL when needed. Don't use if your compiler supports delayloading (ie, VC++ 6.0) + -- BKS 5-29-2000 */ +#if !(defined(_M_IX86) && _MSC_VER >= 1200) +#define PERL_WIN32_SOCK_DLOAD +#endif #define ENV_IS_CASELESS #ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers don't have this */ @@ -213,6 +219,7 @@ typedef long gid_t; #endif #define flushall _flushall #define fcloseall _fcloseall +#define isnan _isnan /* ...same libraries as MSVC */ #ifdef PERL_OBJECT # define MEMBER_TO_FPTR(name) &(name) @@ -485,5 +492,9 @@ struct interp_intern { */ #include "win32iop.h" +#ifndef WNOHANG +# define WNOHANG 1 +#endif + #endif /* _INC_WIN32_PERL5 */ diff --git a/win32/win32sck.c b/win32/win32sck.c index 93d501edef..f7d101bc8b 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -39,12 +39,12 @@ # define TO_SOCKET(x) (x) #endif /* USE_SOCKETS_AS_HANDLES */ -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) #define StartSockets() \ STMT_START { \ if (!wsock_started) \ start_sockets(); \ - set_socktype(); \ + set_socktype(); \ } STMT_END #else #define StartSockets() \ @@ -56,12 +56,6 @@ } STMT_END #endif -#define EndSockets() \ - STMT_START { \ - if (wsock_started) \ - WSACleanup(); \ - } STMT_END - #define SOCKET_TEST(x, y) \ STMT_START { \ StartSockets(); \ @@ -77,6 +71,13 @@ static struct servent* win32_savecopyservent(struct servent*d, static int wsock_started = 0; +EXTERN_C void +EndSockets(void) +{ + if (wsock_started) + WSACleanup(); +} + void start_sockets(void) { @@ -103,8 +104,8 @@ void set_socktype(void) { #ifdef USE_SOCKETS_AS_HANDLES -#ifdef USE_THREADS - dTHX; +#if defined(USE_THREADS) || defined(USE_ITHREADS) + dTHXo; if (!w32_init_socktype) { #endif int iSockOpt = SO_SYNCHRONOUS_NONALERT; @@ -113,7 +114,7 @@ set_socktype(void) */ setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, (char *)&iSockOpt, sizeof(iSockOpt)); -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) w32_init_socktype = 1; } #endif @@ -142,7 +143,7 @@ my_fdopen(int fd, char *mode) /* * If we get here, then fd is actually a socket. */ - Newz(1310, fp, 1, FILE); + Newz(1310, fp, 1, FILE); /* XXX leak, good thing this code isn't used */ if(fp == NULL) { errno = ENOMEM; return NULL; @@ -421,18 +422,19 @@ win32_socket(int af, int type, int protocol) int my_fclose (FILE *pf) { - int osf, retval; + int osf; if (!wsock_started) /* No WinSock? */ return(fclose(pf)); /* Then not a socket. */ osf = TO_SOCKET(fileno(pf));/* Get it now before it's gone! */ - retval = fclose(pf); /* Must fclose() before closesocket() */ if (osf != -1 && closesocket(osf) == SOCKET_ERROR && WSAGetLastError() != WSAENOTSOCK) { + (void)fclose(pf); return EOF; } - return retval; + else + return fclose(pf); } struct hostent * diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH index 8ed7d315a1..ce5c46c521 100755 --- a/x2p/Makefile.SH +++ b/x2p/Makefile.SH @@ -135,7 +135,7 @@ clean: rm -f a2p *$(OBJ_EXT) $(plexe) $(plc) $(plm) realclean: clean - rm -f *.orig core $(addedbyconf) all malloc.c + rm -f core $(addedbyconf) all malloc.c rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old # The following lint has practically everything turned on. Unfortunately, @@ -121,6 +121,7 @@ #ifdef DOSISH # if defined(OS2) +# define PTHX_UNUSED # include "../os2ish.h" # else # include "../dosish.h" |