This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
YA resync with mainstem, including VMS patches from others
authorCharles Bailey <bailey@newman.upenn.edu>
Fri, 4 Aug 2000 01:18:46 +0000 (01:18 +0000)
committerbailey <bailey@newman.upenn.edu>
Fri, 4 Aug 2000 01:18:46 +0000 (01:18 +0000)
p4raw-id: //depot/vmsperl@6514

332 files changed:
AUTHORS
Configure
MAINTAIN
MANIFEST
Makefile.SH
Makefile.micro [new file with mode: 0644]
Porting/Glossary
Porting/config.sh
Porting/config_H
Porting/p4desc
README
README.cygwin
README.epoc
README.hpux
README.micro [new file with mode: 0644]
README.posix-bc
Todo-5.6
Todo.micro [new file with mode: 0644]
av.c
av.h
config_h.SH
cop.h
cygwin/Makefile.SHs
doio.c
doop.c
emacs/cperl-mode.el
embed.h
embed.pl
embedvar.h
epoc/config.sh
epoc/createpkg.pl
epoc/epocish.c
epoc/epocish.h
ext/B/B/Stash.pm
ext/DB_File/Makefile.PL
ext/Data/Dumper/Dumper.xs
ext/Devel/DProf/DProf.xs
ext/Devel/Peek/Peek.pm
ext/DynaLoader/DynaLoader_pm.PL
ext/DynaLoader/dl_mac.xs [new file with mode: 0644]
ext/DynaLoader/hints/netbsd.pl [new file with mode: 0644]
ext/File/Glob/Glob.pm
ext/IPC/SysV/Makefile.PL
ext/NDBM_File/Makefile.PL
ext/Opcode/Opcode.xs
ext/POSIX/POSIX.pm
ext/POSIX/POSIX.pod
ext/POSIX/POSIX.xs
ext/SDBM_File/SDBM_File.pm
ext/Socket/Socket.pm
fix_pl [new file with mode: 0644]
global.sym
gv.c
handy.h
hints/aix.sh
hints/bsdos.sh
hints/dec_osf.sh
hints/freebsd.sh
hints/hpux.sh
hints/irix_6.sh
hints/linux.sh
hints/machten.sh
hints/mpeix.sh
hints/os2.sh
hints/powerux.sh
hints/solaris_2.sh
hints/unicos.sh
hv.c
installperl
intrpvar.h
jpl/JNI/Makefile.PL
lib/AutoLoader.pm
lib/AutoSplit.pm
lib/CGI/Util.pm
lib/Cwd.pm
lib/English.pm
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/MM_VMS.pm
lib/ExtUtils/MakeMaker.pm
lib/ExtUtils/typemap
lib/ExtUtils/xsubpp
lib/File/Find.pm
lib/File/Spec.pm
lib/File/Spec/Mac.pm
lib/File/Spec/Unix.pm
lib/File/Spec/VMS.pm
lib/File/Spec/Win32.pm
lib/File/Temp.pm
lib/IPC/Open3.pm
lib/Net/Ping.pm
lib/Pod/Html.pm
lib/Pod/LaTeX.pm [new file with mode: 0644]
lib/Pod/Man.pm
lib/Pod/Text.pm
lib/Pod/Usage.pm
lib/SelfLoader.pm
lib/Symbol.pm
lib/Test/Harness.pm
lib/Text/Wrap.pm
lib/Win32.pod [moved from pod/Win32.pod with 100% similarity]
lib/lib_pm.PL [moved from lib/lib.pm with 77% similarity]
lib/perl5db.pl
lib/unicode/Is/BidiAL.pl [new file with mode: 0644]
lib/unicode/Is/BidiBN.pl [new file with mode: 0644]
lib/unicode/Is/BidiLRE.pl [new file with mode: 0644]
lib/unicode/Is/BidiLRO.pl [new file with mode: 0644]
lib/unicode/Is/BidiNSM.pl [new file with mode: 0644]
lib/unicode/Is/BidiPDF.pl [new file with mode: 0644]
lib/unicode/Is/BidiRLE.pl [new file with mode: 0644]
lib/unicode/Is/BidiRLO.pl [new file with mode: 0644]
lib/unicode/Is/Cf.pl [new file with mode: 0644]
lib/unicode/Is/Cn.pl
lib/unicode/Is/Cs.pl [new file with mode: 0644]
lib/unicode/Is/DCfraction.pl [new file with mode: 0644]
lib/unicode/Is/Graph.pl
lib/unicode/Is/Me.pl [new file with mode: 0644]
lib/unicode/Is/Nl.pl [new file with mode: 0644]
lib/unicode/Is/Pc.pl [new file with mode: 0644]
lib/unicode/Is/Pf.pl [new file with mode: 0644]
lib/unicode/Is/Pi.pl [new file with mode: 0644]
lib/unicode/Is/Punct.pl
lib/unicode/Is/Sk.pl [new file with mode: 0644]
lib/unicode/Is/Space.pl
lib/unicode/Is/SylA.pl
lib/unicode/Is/SylAA.pl [new file with mode: 0644]
lib/unicode/Is/SylAAI.pl [new file with mode: 0644]
lib/unicode/Is/SylAI.pl [new file with mode: 0644]
lib/unicode/Is/SylC.pl
lib/unicode/Is/SylE.pl
lib/unicode/Is/SylEE.pl [new file with mode: 0644]
lib/unicode/Is/SylI.pl
lib/unicode/Is/SylII.pl [new file with mode: 0644]
lib/unicode/Is/SylN.pl [new file with mode: 0644]
lib/unicode/Is/SylO.pl
lib/unicode/Is/SylOO.pl [new file with mode: 0644]
lib/unicode/Is/SylU.pl
lib/unicode/Is/SylV.pl
lib/unicode/Is/SylWA.pl
lib/unicode/Is/SylWAA.pl [new file with mode: 0644]
lib/unicode/Is/SylWC.pl
lib/unicode/Is/SylWE.pl
lib/unicode/Is/SylWEE.pl [new file with mode: 0644]
lib/unicode/Is/SylWI.pl
lib/unicode/Is/SylWII.pl [new file with mode: 0644]
lib/unicode/Is/SylWO.pl [new file with mode: 0644]
lib/unicode/Is/SylWOO.pl [new file with mode: 0644]
lib/unicode/Is/SylWU.pl [new file with mode: 0644]
lib/unicode/Is/SylWV.pl
lib/unicode/Is/Upper.pl
lib/unicode/Makefile
lib/unicode/mktables.PL
lib/warnings.pm
lib/warnings/register.pm
makedef.pl
mg.c
mpeix/relink
myconfig.SH
objXSUB.h
op.c
op.h
opcode.h
opcode.pl
opnames.h
os2/Makefile.SHs
os2/OS2/REXX/t/rx_dllld.t
os2/OS2/REXX/t/rx_objcall.t
os2/OS2/REXX/t/rx_tievar.t
os2/OS2/REXX/t/rx_tieydb.t
os2/os2.c
os2/os2ish.h
perl.c
perl.h
perlapi.c
perlapi.h
perlio.c
perlsfio.h
perly.c
perly_c.diff
pod/Makefile [deleted file]
pod/Makefile.SH [new file with mode: 0644]
pod/buildtoc [deleted file]
pod/buildtoc.PL [new file with mode: 0644]
pod/perl.pod
pod/perl56delta.pod
pod/perlapi.pod
pod/perldata.pod
pod/perldebguts.pod
pod/perldebug.pod
pod/perldiag.pod
pod/perlembed.pod
pod/perlfaq2.pod
pod/perlfaq4.pod
pod/perlfaq6.pod
pod/perlfaq9.pod
pod/perlfunc.pod
pod/perlguts.pod
pod/perlhack.pod
pod/perlintern.pod
pod/perlipc.pod
pod/perllocale.pod
pod/perlmodlib.PL [new file with mode: 0644]
pod/perlmodlib.pod
pod/perlnewmod.pod [new file with mode: 0644]
pod/perlobj.pod
pod/perlop.pod
pod/perlport.pod
pod/perlre.pod
pod/perlrequick.pod
pod/perlretut.pod
pod/perlsub.pod
pod/perlsyn.pod
pod/perltie.pod
pod/perltoc.pod
pod/perltrap.pod
pod/perlutil.pod [new file with mode: 0644]
pod/perlvar.pod
pod/perlxstut.pod
pod/pod2latex.PL
pod/roffitall
pp.c
pp_ctl.c
pp_hot.c
pp_sys.c
proto.h
regcomp.c
regexec.c
scope.c
scope.h
sv.c
sv.h
t/base/lex.t
t/comp/require.t
t/io/argv.t
t/lib/anydbm.t
t/lib/b.t
t/lib/charnames.t
t/lib/complex.t
t/lib/dprof.t
t/lib/dumper-ovl.t
t/lib/dumper.t
t/lib/english.t
t/lib/filefind.t
t/lib/ftmp-mktemp.t
t/lib/ftmp-posix.t
t/lib/ftmp-security.t
t/lib/ftmp-tempfile.t
t/lib/hostname.t
t/lib/ipc_sysv.t
t/lib/peek.t
t/lib/selfloader.t [new file with mode: 0755]
t/lib/syslfs.t
t/op/64bitint.t
t/op/args.t
t/op/arith.t
t/op/do.t
t/op/gv.t
t/op/lfs.t
t/op/method.t
t/op/misc.t
t/op/my_stash.t [new file with mode: 0644]
t/op/numconvert.t
t/op/pack.t
t/op/pat.t
t/op/re_tests
t/op/runlevel.t
t/op/split.t
t/op/sprintf.t
t/op/stat.t
t/op/taint.t
t/op/tr.t
t/op/vec.t
t/op/wantarray.t
t/op/write.t
t/pragma/constant.t
t/pragma/overload.t
t/pragma/strict-vars
t/pragma/strict.t
t/pragma/utf8.t
t/pragma/warn/2use
t/pragma/warn/3both
t/pragma/warn/4lint
t/pragma/warn/5nolint
t/pragma/warn/7fatal
t/pragma/warn/8signal
t/pragma/warn/9enabled
t/pragma/warn/doio
t/pragma/warn/op
t/pragma/warn/pp_hot
t/pragma/warn/pp_sys
t/pragma/warn/regcomp
t/pragma/warn/sv
t/pragma/warn/toke
t/pragma/warnings.t
thread.h
toke.c
uconfig.h [new file with mode: 0644]
uconfig.sh [new file with mode: 0755]
unixish.h
utf8.c
util.c
util.h
utils/h2xs.PL
utils/perlbug.PL
vmesa/vmesa.c
vms/descrip_mms.template
vms/munchconfig.c
vms/perlvms.pod
vms/perly_c.vms
vms/subconfigure.com
vms/test.com
vms/vms.c
vms/vmsish.h
vos/config.def
vos/config.h
vos/config_h.SH_orig
warnings.pl
win32/Makefile
win32/config.bc
win32/config.gc
win32/config.vc
win32/config_H.bc
win32/config_H.gc
win32/config_H.vc
win32/config_h.PL
win32/makefile.mk
win32/perllib.c
win32/vdir.h
win32/win32.c
win32/win32.h
win32/win32sck.c
x2p/Makefile.SH
x2p/a2p.h

diff --git a/AUTHORS b/AUTHORS
index bf53871..3032d48 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -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
index 83a685d..54c85e2 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -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'
index bc74f1e..b2e370d 100644 (file)
--- a/MAINTAIN
+++ b/MAINTAIN
@@ -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
index 2500943..96eec9c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 285269d..caa647b 100644 (file)
@@ -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 (file)
index 0000000..1ac87b4
--- /dev/null
@@ -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
+
index f5ac6da..f1e7b8e 100644 (file)
@@ -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>.
index ec7b131..c9e9f71 100644 (file)
@@ -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'
index 46184ef..a2c196d 100644 (file)
@@ -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 
  */
  */
 #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>
  */
 #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_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.
  */
 #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_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.
  */
 #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.
  */
 #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>.
  */
 /* 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           /**/
 #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
 #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
index 0bf79da..2d1c9d8 100755 (executable)
@@ -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 {
diff --git a/README b/README
index 0925b98..e846c30 100644 (file)
--- a/README
+++ b/README
     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
index eb6c289..2a95ab9 100644 (file)
@@ -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
index b4bcca6..2163c46 100644 (file)
@@ -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.
index 06b39b9..47d1afc 100644 (file)
@@ -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 (file)
index 0000000..da84453
--- /dev/null
@@ -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.
+
+
index 1105f67..3dd8ea2 100644 (file)
@@ -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
index fac325c..d438969 100644 (file)
--- a/Todo-5.6
+++ b/Todo-5.6
@@ -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 (file)
index 0000000..76759b1
--- /dev/null
@@ -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
+
diff --git a/av.c b/av.c
index 819887e..ef2c905 100644 (file)
--- a/av.c
+++ b/av.c
@@ -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)
 {
diff --git a/av.h b/av.h
index 6b66bfd..4a18430 100644 (file)
--- a/av.h
+++ b/av.h
@@ -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.
index 5bb7ddd..e66e0c5 100644 (file)
@@ -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!
diff --git a/cop.h b/cop.h
index e588675..4584a96 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -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 */
index ca083d4..120e8ee 100644 (file)
@@ -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)
diff --git a/doio.c b/doio.c
index 0121633..7d52d6f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -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);
diff --git a/doop.c b/doop.c
index 4224b0e..ba8a7e5 100644 (file)
--- a/doop.c
+++ b/doop.c
 #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)
index f7d7a53..c6fa46c 100644 (file)
@@ -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
 
 ;;; 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)
 ;;;  (`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.
 ;;;  (`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:
 
 \f
                  ;; 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)))
 
+\f
+(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
+
+\f
 (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
-
diff --git a/embed.h b/embed.h
index b19115f..f0bae6f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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
 #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
 #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
 #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
 #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
 #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
 #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
 #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
 #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)
 #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
 #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
 #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
 #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)
 #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)
 #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)
 #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)
 #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)
 #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)
 #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)          &