Change 19161 by [EMAIL PROTECTED] on 2003/04/07 04:20:20
Integrate:
[ 19126]
Fix bug #21742. require should be always invoked in
scalar context. This wasn't the case when called from
an eval(""), because the void context doesn't propagate
through the leaveeval op. Instead of making scalarvoid()
handle OP_LEAVEEVAL -- this breaks AutoLoader -- implement
a workaround in doeval().
[ 19127]
Subject: Re: [perl #21744] Deparse bug: "\::" deparsed as "::"
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Sat, 29 Mar 2003 19:45:41 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 19128]
Subject: [PATCH 5.8.0 UTIL] Fix installhtml for splitting and PM/POD conflicts
From: Steve Hay <[EMAIL PROTECTED]>
Date: Thu, 20 Mar 2003 12:34:15 +0000
Message-ID: <[EMAIL PROTECTED]>
(with a few minor tweaks)
[ 19129]
MM_VMS tweak from Craig Berry:
http://nntp.x.perl.org/group/perl.makemaker/1002
[ 19130]
Cannot portably compare files if one of them is still open
(from Craig Berry).
[ 19131]
Spread IlyaZ's PERL_CORE detection trick.
[ 19132]
#19122 should have been tested on non-glibc system (like AIX)
[ 19133]
Add packname->stash cache before the check if a packname is a
filehandle or a package, it works because only packnames
that have been resolved to stashes are added to the cache,
and when a newIO is created we clean the cache.
Results in roughly 1.8 speed increase for class->method()
calls.
[ 19134]
Fix some small nits, thanks to Rafael.
[ 19135]
Subject: Re: [perl #21765] $s = ""; $n = @a = split(/,/, $s); results in undef
$n
From: [EMAIL PROTECTED] (Yitzchak Scott-Thoennes)
Date: Tue, 01 Apr 2003 16:32:46 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 19136]
Fixes for "installhtml --splithead", based on :
Subject: Re: [PATCH 5.8.0 UTIL] Fix installhtml for splitting and PM/POD
conflicts
From: Steve Hay <[EMAIL PROTECTED]>
Date: Wed, 02 Apr 2003 11:33:41 +0100
Message-ID: <[EMAIL PROTECTED]>
This also includes a small patch to Pod::Html : when generating
anchor names, play on the safe side and turn every non-alphanumeric
character into an '_'. Moreover, Pod::Html::anchorify() is now
optionally exported.
[ 19137]
Adjust test for the recent change (#19136) to Pod::Html
[ 19138]
Make at least the thread count make sense.
[ 19139]
Make perldiag agree with #19138.
[ 19140]
Subject: [PATCH 5.8.0 DOC] Fix missing functions when splitting perlfunc
From: Steve Hay <[EMAIL PROTECTED]>
Date: Thu, 20 Mar 2003 11:55:01 +0000
Message-ID: <[EMAIL PROTECTED]>
[ 19141]
Don't recurse from threads to threads/shared (since
threads/shared is built separately, temp solution from
Schwern while MM is being fixed.)
[ 19142]
Subject: Re: [PATCH 5.8.0 DOC] Fix missing functions when splitting perlfunc
From: [EMAIL PROTECTED] (Andreas J. Koenig)
Date: Thu, 03 Apr 2003 08:28:52 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 19143]
Subject: [PATCH] VMS %ENV fix (follow-up to 18852)
From: "Craig A. Berry" <[EMAIL PROTECTED]>
Date: Wed, 02 Apr 2003 18:09:03 -0600
Message-Id: <[EMAIL PROTECTED]>
[ 19144]
Upgrade to Unicode::Normalize 0.21 and Unicode::Collate 0.24,
by SADAHIRO Tomoyuki.
[ 19145]
The manpages don't have to be built by MakeMaker for the
core modules in ext/. Disable this in Devel::PPPort (not
up-to-date on CPAN), Unicode::Normalize (the CPAN version
uses a different Makefile.PL anyway) and XS::APItest
(not CPANized.)
[ 19146]
Heredocs and use encoding didn't work for SJIS;
patch from Inaba Hiroto.
[ 19147]
Subject: [PATCH 5.8.1 @19053] Embedding
From: Ilya Zakharevich <[EMAIL PROTECTED]>
Date: Mon, 31 Mar 2003 12:39:24 -0800
Message-ID: <[EMAIL PROTECTED]>
Advertise the pair of macros PERL_SYS_INIT3 / PERL_SYS_TERM
to be used in a C program's main function.
[ 19148]
[perl #21839] perluniintro.pod: nice_string() doesn't escape
literal escape chars -- use Sadahiro-san's fix(es).
[ 19149]
Upgrade to Locale::Maketext 1.04.
[ 19150]
Subject: LD_PRELOAD hack, still badly flawed / a solution
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Thu, 3 Apr 2003 15:50:48 +0300
Message-ID: <[EMAIL PROTECTED]>
On linux, when building a shared library, generate
a small shell wrapper, "preload", that preloads libperl.so
only if it exists. Useful when the 'make' process stops
before the link phase.
[ 19151]
Subject: PATCH (was: Re: [perl #18180] problem with sys:syslog on solaris 8
with perl 5.8.0)
From: Joost van Baal <[EMAIL PROTECTED]>
Date: Mon, 25 Nov 2002 17:35:37 +0100
Message-ID: <[EMAIL PROTECTED]>
(The .pm patch modified a bit, and removed the false
claim that _PATH_INFO would be coming from syslog.ph)
[ 19152]
Remove unportable ">|" shell syntax
Subject: Re: Change 19150: LD_PRELOAD hack, still badly flawed / a solution
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Sun, 6 Apr 2003 21:13:27 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 19153]
Subject: [DOC PATCH] README.solaris and -Dcc=gcc
From: Robert Spier <[EMAIL PROTECTED]>
Date: Sat, 05 Apr 2003 21:12:20 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 19154]
An unconditional carp is not nice.
[ 19156]
Subject: [PATCH] B::Deparse: sv_no != 0
From: Stephen McCamant <[EMAIL PROTECTED]>
Date: Sun, 6 Apr 2003 17:00:48 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 19157]
Subject: CvFILE for constant subs
From: Stephen McCamant <[EMAIL PROTECTED]>
Date: Sun, 6 Apr 2003 16:39:13 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 19158]
More WinCE tweaking for Vadim Konovalov.
[ 19159]
Future binary compat wishful thinking:
maint will use the stashcache, but not the dbassertion.
[ 19160]
Time::HiRes: Do not create files in blib directories under core
(from Rafael)
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#44 integrate
... //depot/maint-5.8/perl/Makefile.SH#9 integrate
... //depot/maint-5.8/perl/README.solaris#2 integrate
... //depot/maint-5.8/perl/embedvar.h#13 integrate
... //depot/maint-5.8/perl/ext/B/B/Deparse.pm#4 integrate
... //depot/maint-5.8/perl/ext/Devel/PPPort/Makefile.PL#2 integrate
... //depot/maint-5.8/perl/ext/Encode/Makefile.PL#2 integrate
... //depot/maint-5.8/perl/ext/Encode/t/enc_module.t#5 integrate
... //depot/maint-5.8/perl/ext/Sys/Syslog/Makefile.PL#2 integrate
... //depot/maint-5.8/perl/ext/Sys/Syslog/Syslog.pm#3 integrate
... //depot/maint-5.8/perl/ext/Sys/Syslog/syslog.t#3 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/Makefile.PL#11 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/Changes#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/Makefile.PL#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/Normalize.pm#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/README#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/mkheader#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/t/func.t#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/t/norm.t#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/t/test.t#3 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/Makefile.PL#2 integrate
... //depot/maint-5.8/perl/ext/threads/Makefile.PL#2 integrate
... //depot/maint-5.8/perl/ext/threads/threads.xs#9 integrate
... //depot/maint-5.8/perl/gv.c#8 integrate
... //depot/maint-5.8/perl/hv.c#8 integrate
... //depot/maint-5.8/perl/installhtml#2 integrate
... //depot/maint-5.8/perl/intrpvar.h#13 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/MM_VMS.pm#3 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/t/Embed.t#4 integrate
... //depot/maint-5.8/perl/lib/Locale/Maketext.pm#2 integrate
... //depot/maint-5.8/perl/lib/Locale/Maketext.pod#2 integrate
... //depot/maint-5.8/perl/lib/Locale/Maketext/ChangeLog#2 integrate
... //depot/maint-5.8/perl/lib/Locale/Maketext/README#2 integrate
... //depot/maint-5.8/perl/lib/Locale/Maketext/t/00about.t#1 branch
... //depot/maint-5.8/perl/lib/Locale/Maketext/t/01make.t#1 branch
... //depot/maint-5.8/perl/lib/Locale/Maketext/t/02get.t#1 branch
... //depot/maint-5.8/perl/lib/Locale/Maketext/t/03http.t#1 branch
... //depot/maint-5.8/perl/lib/Locale/Maketext/test.pl#2 delete
... //depot/maint-5.8/perl/lib/Pod/Functions.pm#3 integrate
... //depot/maint-5.8/perl/lib/Pod/Html.pm#3 integrate
... //depot/maint-5.8/perl/lib/Pod/t/Functions.t#2 integrate
... //depot/maint-5.8/perl/lib/Pod/t/htmlview.t#3 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate.pm#3 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/Changes#3 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/README#3 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/t/index.t#3 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/t/test.t#4 integrate
... //depot/maint-5.8/perl/op.c#19 integrate
... //depot/maint-5.8/perl/perl.c#27 integrate
... //depot/maint-5.8/perl/perlapi.h#12 integrate
... //depot/maint-5.8/perl/pod/perldiag.pod#19 integrate
... //depot/maint-5.8/perl/pod/perlembed.pod#5 integrate
... //depot/maint-5.8/perl/pod/perlfunc.pod#14 integrate
... //depot/maint-5.8/perl/pod/perluniintro.pod#7 integrate
... //depot/maint-5.8/perl/pod/splitpod#2 integrate
... //depot/maint-5.8/perl/pp.c#17 integrate
... //depot/maint-5.8/perl/pp_ctl.c#20 integrate
... //depot/maint-5.8/perl/pp_hot.c#18 integrate
... //depot/maint-5.8/perl/sv.c#39 integrate
... //depot/maint-5.8/perl/t/comp/require.t#2 integrate
... //depot/maint-5.8/perl/t/op/split.t#8 integrate
... //depot/maint-5.8/perl/toke.c#15 integrate
... //depot/maint-5.8/perl/vms/vms.c#9 integrate
... //depot/maint-5.8/perl/vms/vmsish.h#3 integrate
... //depot/maint-5.8/perl/wince/Makefile.ce#5 integrate
... //depot/maint-5.8/perl/wince/compile-all.bat#2 integrate
... //depot/maint-5.8/perl/wince/compile.bat#4 integrate
... //depot/maint-5.8/perl/wince/makedist.pl#2 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#44 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#43~19105~ Mon Mar 31 02:54:05 2003
+++ perl/MANIFEST Sun Apr 6 21:20:20 2003
@@ -1256,8 +1256,11 @@
lib/Locale/Maketext.pod Locale::Maketext documentation
lib/Locale/Maketext/ChangeLog Locale::Maketext
lib/Locale/Maketext/README Locale::Maketext
-lib/Locale/Maketext/test.pl See if Locale::Maketext works
lib/Locale/Maketext/TPJ13.pod Locale::Maketext documentation article
+lib/Locale/Maketext/t/00about.t See if Locale::Maketext works
+lib/Locale/Maketext/t/01make.t See if Locale::Maketext works
+lib/Locale/Maketext/t/02get.t See if Locale::Maketext works
+lib/Locale/Maketext/t/03http.t See if Locale::Maketext works
lib/Locale/Script.pm Locale::Codes
lib/Locale/Script.pod Locale::Codes documentation
lib/look.pl A "look" equivalent
==== //depot/maint-5.8/perl/Makefile.SH#9 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH#8~19106~ Mon Mar 31 21:11:53 2003
+++ perl/Makefile.SH Sun Apr 6 21:20:20 2003
@@ -96,26 +96,33 @@
ldlibpth=`echo $ldlibpth | sed 's/:*$//'`
;;
esac
- ;;
-*) pldlflags=''
- static_target='static'
- ;;
-esac
-case "$ldlibpth" in
-# Protect any spaces
-*" "*) ldlibpth=`echo $ldlibpth|sed 's/ /\\\\ /g'` ;;
-esac
+ case "$ldlibpth" in
+ # Protect any spaces
+ *" "*) ldlibpth=`echo $ldlibpth|sed 's/ /\\\\ /g'` ;;
+ esac
-case "$osname" in
-linux)
- case "$useshrplib" in
- true)
- ldlibpth="LD_PRELOAD=\"\$\$LD_PRELOAD `pwd`/$libperl\" $ldlibpth"
- ;;
+ case "$osname" in
+ linux)
+ rm -f preload
+ cat <<-'EOT' > preload
+ #! /bin/sh
+ lib=$1
+ shift
+ test -r $lib && export LD_PRELOAD="$lib $LD_PRELOAD"
+ exec "$@"
+ EOT
+ chmod 755 preload
+ ldlibpth="$ldlibpth `pwd`/preload `pwd`/$libperl"
+ ;;
+ os390) test -f /bin/env && ldlibpth="/bin/env $ldlibpth"
+ ;;
esac
+
;;
-os390) test -f /bin/env && ldlibpth="/bin/env $ldlibpth"
+
+*) pldlflags=''
+ static_target='static'
;;
esac
@@ -944,6 +951,7 @@
rm -f lib/.exists lib/*/.exists lib/*/*/.exists
rm -f h2ph.man pstruct
rm -rf .config
+ rm -f preload
rm -f testcompile compilelog
-rmdir lib/B lib/Data lib/Digest
rm -rf lib/Encode
==== //depot/maint-5.8/perl/README.solaris#2 (text) ====
Index: perl/README.solaris
--- perl/README.solaris#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/README.solaris Sun Apr 6 21:20:20 2003
@@ -132,15 +132,18 @@
=head3 GCC
-If you use gcc, make sure your installation is recent and
-complete. As a point of reference, perl-5.6.0 built fine with
-gcc-2.8.1 on both Solaris 2.6 and Solaris 8. You should
-Configure perl with
+If you use gcc, make sure your installation is recent and complete.
+Perl versions since 5.6.0 build fine with gcc > 2.8.1 on Solaris >=
+2.6.
+
+You must Configure perl with
sh Configure -Dcc=gcc
+If you don't, you may experience strange build errors.
+
If you have updated your Solaris version, you may also have to update
-your GCC. For example, if you are running Solaris 2.6 and your gcc is
+your gcc. For example, if you are running Solaris 2.6 and your gcc is
installed under /usr/local, check in /usr/local/lib/gcc-lib and make
sure you have the appropriate directory, sparc-sun-solaris2.6/ or
i386-pc-solaris2.6/. If gcc's directory is for a different version of
==== //depot/maint-5.8/perl/embedvar.h#13 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h#12~19106~ Mon Mar 31 21:11:53 2003
+++ perl/embedvar.h Sun Apr 6 21:20:20 2003
@@ -704,6 +704,7 @@
#define PL_sort_RealCmp (vTHX->Isort_RealCmp)
#define PL_splitstr (vTHX->Isplitstr)
#define PL_srand_called (vTHX->Isrand_called)
+#define PL_stashcache (vTHX->Istashcache)
#define PL_statusvalue (vTHX->Istatusvalue)
#define PL_statusvalue_vms (vTHX->Istatusvalue_vms)
#define PL_stderrgv (vTHX->Istderrgv)
@@ -1014,6 +1015,7 @@
#define PL_Isort_RealCmp PL_sort_RealCmp
#define PL_Isplitstr PL_splitstr
#define PL_Isrand_called PL_srand_called
+#define PL_Istashcache PL_stashcache
#define PL_Istatusvalue PL_statusvalue
#define PL_Istatusvalue_vms PL_statusvalue_vms
#define PL_Istderrgv PL_stderrgv
==== //depot/maint-5.8/perl/ext/B/B/Deparse.pm#4 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#3~18791~ Fri Feb 28 12:05:43 2003
+++ perl/ext/B/B/Deparse.pm Sun Apr 6 21:20:20 2003
@@ -3181,7 +3181,7 @@
sub const {
my $sv = shift;
if (class($sv) eq "SPECIAL") {
- return ('undef', '1', '0')[$$sv-1]; # sv_undef, sv_yes, sv_no
+ return ('undef', '1', '(!1)')[$$sv-1]; # sv_undef, sv_yes, sv_no
} elsif (class($sv) eq "NULL") {
return 'undef';
} elsif ($sv->FLAGS & SVf_IOK) {
@@ -3243,10 +3243,10 @@
my $first = $self->dq($op->first);
my $last = $self->dq($op->last);
- # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+ # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]", "$foo\::bar"
($last =~ /^[A-Z\\\^\[\]_?]/ &&
$first =~ s/([EMAIL PROTECTED])\^$/${1}{^}/) # "${^}W" etc
- || ($last =~ /^[{\[\w_]/ &&
+ || ($last =~ /^[:'{\[\w_]/ &&
$first =~ s/([EMAIL PROTECTED])([A-Za-z_]\w*)$/${1}{$2}/);
return $first . $last;
==== //depot/maint-5.8/perl/ext/Devel/PPPort/Makefile.PL#2 (text) ====
Index: perl/ext/Devel/PPPort/Makefile.PL
--- perl/ext/Devel/PPPort/Makefile.PL#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Devel/PPPort/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -1,5 +1,16 @@
use ExtUtils::MakeMaker;
+unless($ENV{PERL_CORE}) {
+ $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
+}
+if ($ENV{PERL_CORE}) {
+ # Pods will be built by installman.
+ @coreopts = ( MAN3PODS => {} );
+}
+else {
+ @coreopts = ();
+}
+
WriteMakefile(
NAME => "Devel::PPPort",
DISTNAME => "Devel-PPPort",
@@ -12,5 +23,6 @@
OBJECT => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)',
XSPROTOARG => '-noprototypes',
'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" },
- 'clean' => { FILES => qw($(H_FILES))}
+ 'clean' => { FILES => qw($(H_FILES))},
+ @coreopts,
);
==== //depot/maint-5.8/perl/ext/Encode/Makefile.PL#2 (text) ====
Index: perl/ext/Encode/Makefile.PL
--- perl/ext/Encode/Makefile.PL#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Encode/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -3,7 +3,7 @@
# Just for sure :)
unless($ENV{PERL_CORE}) {
- $ENV{PERL_CORE} = 1 if ($^X =~ m{\bminiperl[^/\\\]>:]*$}o);
+ $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
}
my %tables =
==== //depot/maint-5.8/perl/ext/Encode/t/enc_module.t#5 (text) ====
Index: perl/ext/Encode/t/enc_module.t
--- perl/ext/Encode/t/enc_module.t#4~19103~ Mon Mar 31 02:41:09 2003
+++ perl/ext/Encode/t/enc_module.t Sun Apr 6 21:20:20 2003
@@ -38,6 +38,7 @@
print $obj->str, "\n";
$obj->set("�ƥ���ʸ����");
print $obj->str, "\n";
+close STDOUT;
my $cmp = compare_text($file0, $file1);
is($cmp, 0, "encoding vs. STDOUT");
@@ -51,7 +52,6 @@
is ($cmp[$i++], $_, "encoding vs. STDIN - $i");
}
-close STDOUT;
unlink $file1 unless $cmp;
__END__
==== //depot/maint-5.8/perl/ext/Sys/Syslog/Makefile.PL#2 (text) ====
Index: perl/ext/Sys/Syslog/Makefile.PL
--- perl/ext/Sys/Syslog/Makefile.PL#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Sys/Syslog/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -9,12 +9,20 @@
realclean => {FILES=> 'const-c.inc const-xs.inc'},
);
-# We hope syslogd understands /dev/log.
-#
-# Solaris has a -c /dev/log, but the syslog.t #1 and #2 don't
-# seem to be happy if that's _PATH_LOG.
-#
-my $_PATH_LOG = -S "/dev/log" ? "/dev/log" : "";
+my $_PATH_LOG;
+
+if (-S "/dev/log" && -w "/dev/log") {
+ # Most unixes have a unix domain socket /dev/log.
+ $_PATH_LOG = "/dev/log";
+} elsif (-c "/dev/conslog" && -w "/dev/conslog") {
+ # SunOS 5.8 has a worldwritable /dev/conslog STREAMS log driver.
+ # The /dev/log STREAMS log driver on this platform has permissions
+ # and ownership `crw-r----- root sys'. /dev/conslog has more liberal
+ # permissions.
+ $_PATH_LOG = "/dev/conslog";
+} else {
+ $_PATH_LOG = "";
+}
WriteConstants(
NAME => 'Sys::Syslog',
==== //depot/maint-5.8/perl/ext/Sys/Syslog/Syslog.pm#3 (text) ====
Index: perl/ext/Sys/Syslog/Syslog.pm
--- perl/ext/Sys/Syslog/Syslog.pm#2~18352~ Wed Dec 25 05:42:10 2002
+++ perl/ext/Sys/Syslog/Syslog.pm Sun Apr 6 21:20:20 2003
@@ -75,14 +75,16 @@
C<openlog()> or C<syslog()> and returns TRUE on success,
undef on failure.
-A value of 'unix' will connect to the UNIX domain socket returned by
-the C<_PATH_LOG> macro (if your system defines it) in F<syslog.ph>. A
-value of 'stream' will connect to the stream indicated by the pathname
-provided as the optional second parameter. A value of 'inet' will
-connect to an INET socket (either tcp or udp, tried in that order)
-returned by getservbyname(). 'tcp' and 'udp' can also be given as
-values. The value 'console' will send messages directly to the
-console, as for the 'cons' option in the logopts in openlog().
+A value of 'unix' will connect to the UNIX domain socket (in some
+systems a character special device) returned by the C<_PATH_LOG> macro
+(if your system defines it), or F</dev/log> or F</dev/conslog>,
+whatever is writable. A value of 'stream' will connect to the stream
+indicated by the pathname provided as the optional second parameter.
+A value of 'inet' will connect to an INET socket (either tcp or udp,
+tried in that order) returned by getservbyname(). 'tcp' and 'udp' can
+also be given as values. The value 'console' will send messages
+directly to the console, as for the 'cons' option in the logopts in
+openlog().
A reference to an array can also be passed as the first parameter.
When this calling method is used, the array should contain a list of
@@ -190,8 +192,21 @@
if (ref $setsock eq 'ARRAY') {
@connectMethods = @$setsock;
} elsif (lc($setsock) eq 'stream') {
- $syslog_path = '/dev/log' unless($syslog_path);
- if (!-w $syslog_path) {
+ unless (defined $syslog_path) {
+ my @try = qw(/dev/log /dev/conslog);
+ if (length &_PATH_LOG) { # Undefined _PATH_LOG is "".
+ unshift @try, &_PATH_LOG;
+ }
+ for my $try (@try) {
+ if (-w $try) {
+ $syslog_path = $try;
+ last;
+ }
+ }
+ carp "stream passed to setlogsock, but could not find any device"
+ unless defined $syslog_path;
+ }
+ unless (-w $syslog_path) {
carp "stream passed to setlogsock, but $syslog_path is not writable";
return undef;
} else {
==== //depot/maint-5.8/perl/ext/Sys/Syslog/syslog.t#3 (xtext) ====
Index: perl/ext/Sys/Syslog/syslog.t
--- perl/ext/Sys/Syslog/syslog.t#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/ext/Sys/Syslog/syslog.t Sun Apr 6 21:20:20 2003
@@ -47,8 +47,12 @@
if (Sys::Syslog::_PATH_LOG()) {
if (-e Sys::Syslog::_PATH_LOG()) {
- print defined(eval { setlogsock('unix') })
- ? "ok 1\n" : "not ok 1 # $!\n";
+ if ($^O =~ /^solaris$/) {
+ # we should check for stream support here, not for solaris
+ print defined(eval { setlogsock('stream') }) ? "ok 1\n" : "not ok 1 #
$!\n";
+ } else {
+ print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1 # $!\n";
+ }
if (defined(eval { openlog('perl', 'ndelay', 'local0') })) {
print "ok 2\n";
print defined(eval { syslog('info', $test_string ) })
==== //depot/maint-5.8/perl/ext/Time/HiRes/Makefile.PL#11 (text) ====
Index: perl/ext/Time/HiRes/Makefile.PL
--- perl/ext/Time/HiRes/Makefile.PL#10~19111~ Mon Mar 31 23:17:01 2003
+++ perl/ext/Time/HiRes/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -408,6 +408,10 @@
realclean => {FILES=> 'const-c.inc const-xs.inc'},
);
+ if ($ENV{PERL_CORE}) {
+ push @makefileopts, MAN3PODS => {};
+ }
+
WriteMakefile(@makefileopts);
}
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/Changes#3 (text) ====
Index: perl/ext/Unicode/Normalize/Changes
--- perl/ext/Unicode/Normalize/Changes#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/Changes Sun Apr 6 21:20:20 2003
@@ -1,5 +1,8 @@
Revision history for Perl extension Unicode::Normalize.
+0.21 Thu Apr 02 23:12:54 2003
+ - internal tweak: for (?un)pack 'U'.
+
0.20 Sun Mar 02 13:29:25 2003
- decompose Hangul syllables in a decomposition mapping.
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/Makefile.PL#2 (text) ====
Index: perl/ext/Unicode/Normalize/Makefile.PL
--- perl/ext/Unicode/Normalize/Makefile.PL#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -5,6 +5,17 @@
do "mkheader";
+unless($ENV{PERL_CORE}) {
+ $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
+}
+if ($ENV{PERL_CORE}) {
+ # Pods will be built by installman.
+ @coreopts = ( MAN3PODS => {} );
+}
+else {
+ @coreopts = ();
+}
+
WriteMakefile(
'NAME' => 'Unicode::Normalize',
'VERSION_FROM' => 'Normalize.pm', # finds $VERSION
@@ -12,4 +23,5 @@
(ABSTRACT_FROM => 'Normalize.pm', # retrieve abstract from module
AUTHOR => 'SADAHIRO Tomoyuki <[EMAIL PROTECTED]>') : ()),
clean => {FILES=> 'unfcan.h unfcmb.h unfcmp.h unfcpt.h unfexc.h'},
+ @coreopts,
);
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/Normalize.pm#3 (text) ====
Index: perl/ext/Unicode/Normalize/Normalize.pm
--- perl/ext/Unicode/Normalize/Normalize.pm#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/Normalize.pm Sun Apr 6 21:20:20 2003
@@ -1,8 +1,8 @@
package Unicode::Normalize;
BEGIN {
- if (ord("A") == 193) {
- die "Unicode::Normalize not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ die "Unicode::Normalize cannot stringify a Unicode code point\n";
}
}
@@ -11,7 +11,7 @@
use warnings;
use Carp;
-our $VERSION = '0.20';
+our $VERSION = '0.21';
our $PACKAGE = __PACKAGE__;
require Exporter;
@@ -35,6 +35,29 @@
bootstrap Unicode::Normalize $VERSION;
+use constant UNICODE_FOR_PACK => "A" eq pack('U', 0x41);
+use constant NATIVE_FOR_PACK => "A" eq pack('U', ord("A"));
+
+use constant UNICODE_FOR_UNPACK => 0x41 == unpack('U', "A");
+use constant NATIVE_FOR_UNPACK => ord("A") == unpack('U', "A");
+
+sub pack_U {
+ return UNICODE_FOR_PACK
+ ? pack('U*', @_)
+ : NATIVE_FOR_PACK
+ ? pack('U*', map utf8::unicode_to_native($_), @_)
+ : die "$PACKAGE, a Unicode code point cannot be stringified.\n";
+}
+
+sub unpack_U {
+ return UNICODE_FOR_UNPACK
+ ? unpack('U*', shift)
+ : NATIVE_FOR_UNPACK
+ ? map(utf8::native_to_unicode($_), unpack 'U*', shift)
+ : die "$PACKAGE, a code point returned from unpack U " .
+ "cannot be converted into Unicode.\n";
+}
+
use constant COMPAT => 1;
sub NFD ($) { reorder(decompose($_[0])) }
@@ -136,7 +159,7 @@
=item C<$decomposed_string = decompose($string, $useCompatMapping)>
-Decompose the specified string and returns the result.
+Decomposes the specified string and returns the result.
If the second parameter (a boolean) is omitted or false, decomposes it
using the Canonical Decomposition Mapping.
@@ -150,7 +173,7 @@
=item C<$reordered_string = reorder($string)>
-Reorder the combining characters and the like in the canonical ordering
+Reorders the combining characters and the like in the canonical ordering
and returns the result.
E.g., when you have a list of NFD/NFKD strings,
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/README#3 (text) ====
Index: perl/ext/Unicode/Normalize/README
--- perl/ext/Unicode/Normalize/README#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/README Sun Apr 6 21:20:20 2003
@@ -1,4 +1,4 @@
-Unicode/Normalize version 0.20
+Unicode/Normalize version 0.21
===================================
Unicode::Normalize - Unicode Normalization Forms
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/mkheader#3 (text) ====
Index: perl/ext/Unicode/Normalize/mkheader
--- perl/ext/Unicode/Normalize/mkheader#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/mkheader Sun Apr 6 21:20:20 2003
@@ -15,7 +15,11 @@
use Carp;
use File::Spec;
-our $IsEBCDIC = ord("A") != 0x41;
+BEGIN {
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ die "Unicode::Normalize cannot stringify a Unicode code point\n";
+ }
+}
our $PACKAGE = 'Unicode::Normalize, mkheader';
@@ -197,12 +201,17 @@
$Compat{$key} = [ getCompatList($key) ];
}
+sub _pack_U {
+ return "A" eq pack('U', 0x41)
+ ? pack('U*', @_)
+ : "A" eq pack('U', ord("A"))
+ ? pack('U*', map utf8::unicode_to_native($_), @_)
+ : die "$PACKAGE, a Unicode code point cannot be stringified.\n";
+}
+
sub _U_stringify {
sprintf '"%s"', join '',
- map sprintf("\\x%02x", $_), unpack 'C*',
- $IsEBCDIC
- ? pack('U*', map utf8::unicode_to_native($_), @_)
- : pack('U*', @_);
+ map sprintf("\\x%02x", $_), unpack 'C*', _pack_U(@_);
}
foreach my $hash (\%Canon, \%Compat) {
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/t/func.t#3 (text) ====
Index: perl/ext/Unicode/Normalize/t/func.t
--- perl/ext/Unicode/Normalize/t/func.t#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/t/func.t Sun Apr 6 21:20:20 2003
@@ -1,7 +1,8 @@
BEGIN {
- if (ord("A") == 193) {
- print "1..0 # Unicode::Normalize not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ print "1..0 # Unicode::Normalize " .
+ "cannot stringify a Unicode code point\n";
exit 0;
}
}
@@ -9,7 +10,7 @@
BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
- @INC = qw(../lib);
+ @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
}
}
@@ -22,19 +23,8 @@
use Unicode::Normalize qw(:all);
ok(1); # If we made it this far, we're ok.
-our $IsEBCDIC = ord("A") != 0x41;
-
-sub _pack_U {
- return $IsEBCDIC
- ? pack('U*', map utf8::unicode_to_native($_), @_)
- : pack('U*', @_);
-}
-
-sub _unpack_U {
- return $IsEBCDIC
- ? map(utf8::native_to_unicode($_), unpack 'U*', shift)
- : unpack('U*', shift);
-}
+sub _pack_U { Unicode::Normalize::pack_U(@_) }
+sub _unpack_U { Unicode::Normalize::unpack_U(@_) }
#########################
@@ -50,7 +40,7 @@
&& getCanon(0x00EF) eq _pack_U(0x0069, 0x0308)
&& getCanon(0x304C) eq _pack_U(0x304B, 0x3099)
&& getCanon(0x1EA4) eq _pack_U(0x0041, 0x0302, 0x0301)
- && getCanon(0x1F82) eq "\x{03B1}\x{0313}\x{0300}\x{0345}"
+ && getCanon(0x1F82) eq _pack_U(0x03B1, 0x0313, 0x0300, 0x0345)
&& getCanon(0x1FAF) eq _pack_U(0x03A9, 0x0314, 0x0342, 0x0345)
&& getCanon(0xAC00) eq _pack_U(0x1100, 0x1161)
&& getCanon(0xAE00) eq _pack_U(0x1100, 0x1173, 0x11AF)
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/t/norm.t#3 (text) ====
Index: perl/ext/Unicode/Normalize/t/norm.t
--- perl/ext/Unicode/Normalize/t/norm.t#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/t/norm.t Sun Apr 6 21:20:20 2003
@@ -1,7 +1,8 @@
BEGIN {
- if (ord("A") == 193) {
- print "1..0 # Unicode::Normalize not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ print "1..0 # Unicode::Normalize " .
+ "cannot stringify a Unicode code point\n";
exit 0;
}
}
@@ -9,7 +10,7 @@
BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
- @INC = qw(../lib);
+ @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
}
}
@@ -22,19 +23,8 @@
use Unicode::Normalize qw(normalize);
ok(1); # If we made it this far, we're ok.
-our $IsEBCDIC = ord("A") != 0x41;
-
-sub _pack_U {
- return $IsEBCDIC
- ? pack('U*', map utf8::unicode_to_native($_), @_)
- : pack('U*', @_);
-}
-
-sub _unpack_U {
- return $IsEBCDIC
- ? map(utf8::native_to_unicode($_), unpack 'U*', shift)
- : unpack('U*', shift);
-}
+sub _pack_U { Unicode::Normalize::pack_U(@_) }
+sub _unpack_U { Unicode::Normalize::unpack_U(@_) }
#########################
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/t/test.t#3 (text) ====
Index: perl/ext/Unicode/Normalize/t/test.t
--- perl/ext/Unicode/Normalize/t/test.t#2~18824~ Mon Mar 3 21:39:18 2003
+++ perl/ext/Unicode/Normalize/t/test.t Sun Apr 6 21:20:20 2003
@@ -1,7 +1,8 @@
BEGIN {
- if (ord("A") == 193) {
- print "1..0 # Unicode::Normalize not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ print "1..0 # Unicode::Normalize " .
+ "cannot stringify a Unicode code point\n";
exit 0;
}
}
@@ -9,7 +10,7 @@
BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
- @INC = qw(../lib);
+ @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
}
}
@@ -22,19 +23,8 @@
use Unicode::Normalize;
ok(1); # If we made it this far, we're ok.
-our $IsEBCDIC = ord("A") != 0x41;
-
-sub _pack_U {
- return $IsEBCDIC
- ? pack('U*', map utf8::unicode_to_native($_), @_)
- : pack('U*', @_);
-}
-
-sub _unpack_U {
- return $IsEBCDIC
- ? map(utf8::native_to_unicode($_), unpack 'U*', shift)
- : unpack('U*', shift);
-}
+sub _pack_U { Unicode::Normalize::pack_U(@_) }
+sub _unpack_U { Unicode::Normalize::unpack_U(@_) }
#########################
==== //depot/maint-5.8/perl/ext/XS/APItest/Makefile.PL#2 (text) ====
Index: perl/ext/XS/APItest/Makefile.PL
--- perl/ext/XS/APItest/Makefile.PL#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/XS/APItest/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -14,6 +14,7 @@
'INC' => '-I.', # e.g., '-I. -I/usr/include/other'
# Un-comment this if you add C files to link with later:
# 'OBJECT' => '$(O_FILES)', # link all the C files too
+ MAN3PODS => {}, # Pods will be built by installman.
);
sub MY::install { "install ::\n" };
==== //depot/maint-5.8/perl/ext/threads/Makefile.PL#2 (xtext) ====
Index: perl/ext/threads/Makefile.PL
--- perl/ext/threads/Makefile.PL#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/threads/Makefile.PL Sun Apr 6 21:20:20 2003
@@ -16,5 +16,13 @@
# 'INC' => '', # e.g., '-I/usr/include/other'
# Un-comment this if you add C files to link with later:
# 'OBJECT' => '$(O_FILES)', # link all the C files too
+
+ # ext/threads/shared is a completely different module. Don't
+ # recurse into it.
+ 'NORECURS' => 1,
+
+ # Bug in MakeMaker continues to put ext/threads/shared into DIR
+ # even if we said NORECURS. Remove when fixed.
+ 'DIR' => [],
);
==== //depot/maint-5.8/perl/ext/threads/threads.xs#9 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#8~19106~ Mon Mar 31 21:11:53 2003
+++ perl/ext/threads/threads.xs Sun Apr 6 21:20:20 2003
@@ -160,7 +160,7 @@
int veto_cleanup = 0;
MUTEX_LOCK(&create_destruct_mutex);
if (aTHX == PL_curinterp && active_threads != 1) {
- Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still
running",
+ Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running",
(IV)active_threads);
veto_cleanup = 1;
}
==== //depot/maint-5.8/perl/gv.c#8 (text) ====
Index: perl/gv.c
--- perl/gv.c#7~18881~ Mon Mar 10 08:58:22 2003
+++ perl/gv.c Sun Apr 6 21:20:20 2003
@@ -1138,6 +1138,9 @@
sv_upgrade((SV *)io,SVt_PVIO);
SvREFCNT(io) = 1;
SvOBJECT_on(io);
+ /* Clear the stashcache because a new IO could overrule a
+ package name */
+ hv_clear(PL_stashcache);
iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
==== //depot/maint-5.8/perl/hv.c#8 (text) ====
Index: perl/hv.c
--- perl/hv.c#7~18978~ Fri Mar 14 02:52:06 2003
+++ perl/hv.c Sun Apr 6 21:20:20 2003
@@ -1729,6 +1729,8 @@
hfreeentries(hv);
Safefree(xhv->xhv_array /* HvARRAY(hv) */);
if (HvNAME(hv)) {
+ if(PL_stashcache)
+ hv_delete_ent(PL_stashcache, sv_2mortal(newSVpv(HvNAME(hv),0)),
G_DISCARD, 0);
Safefree(HvNAME(hv));
HvNAME(hv) = 0;
}
==== //depot/maint-5.8/perl/installhtml#2 (xtext) ====
Index: perl/installhtml
--- perl/installhtml#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/installhtml Sun Apr 6 21:20:20 2003
@@ -6,7 +6,7 @@
use Config; # for config options in the makefile
use Getopt::Long; # for command-line parsing
use Cwd;
-use Pod::Html;
+use Pod::Html 'anchorify';
=head1 NAME
@@ -227,6 +227,7 @@
}
foreach my $dir (@splithead) {
+ (my $pod = $dir) =~ s,^.*/,,;
$dir .= ".pod" unless $dir =~ /(\.pod|\.pm)$/;
# let pod2html create the file
runpod2html($dir, 1);
@@ -243,15 +244,15 @@
$/ = "";
my @data = ();
while (<H>) {
- last if /NAME=/;
- $_ =~ s{HREF="#(.*)">}{
- my $url = "$file/$1.html" ;
- $url = Pod::Html::relativize_url( $url, "$file.html" )
- if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' );
- "HREF=\"$url\">" ;
- }eg;
+ last if /name="name"/i;
+ $_ =~ s{href="#(.*)">}{
+ my $url = "$pod/$1.html" ;
+ $url = Pod::Html::relativize_url( $url, "$file.html" )
+ if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' );
+ "href=\"$url\">" ;
+ }egi;
push @data, $_;
- }
+ }
close(H);
# now rewrite the file
@@ -303,6 +304,7 @@
sub create_index {
my($html, $dir) = @_;
+ (my $pod = $dir) =~ s,^.*/,,;
my(@files, @filedata, @index, $file);
my($lcp1,$lcp2);
@@ -328,20 +330,21 @@
close(IN);
# pull out the NAME section
- my $name;
- ($name) = grep(/NAME=/, @filedata);
- ($lcp1,$lcp2) = ($name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,sm);
- if (defined $lcp1 and $lcp1 eq '<P>') { # Uninteresting. Try again.
- ($lcp1,$lcp2) = ($name =~ m,/H1>\s<P>\s(\S+)\s[\s-]*(.*?)\s*$,sm);
+ my $name;
+ ($name) = grep(/name="name"/i, @filedata);
+ ($lcp1,$lcp2) = ($name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,smi);
+ if (defined $lcp1 and $lcp1 =~ m,^<P>$,i) { # Uninteresting. Try again.
+ ($lcp1,$lcp2) = ($name =~ m,/H1>\s<P>\s*(\S+)\s[\s-]*(.*?)\s*$,smi);
}
- my $url= "$dir/$file" ;
+ my $url= "$pod/$file" ;
if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' ) {
- $url = Pod::Html::relativize_url( "$dir/$file", $html ) ;
+ $url = Pod::Html::relativize_url( "$pod/$file", $html ) ;
}
- print HTML qq(<A HREF="$url">);
- print HTML "<DT>$lcp1</A><DD>$lcp2\n" if defined $lcp1;
-# print HTML qq(<A HREF="$url">$lcp1</A><BR>\n") if defined $lcp1;
+ if (defined $lcp1) {
+ print HTML qq(<DT><A HREF="$url">);
+ print HTML "$lcp1</A></DT><DD>$lcp2</DD>\n";
+ }
next;
@@ -350,7 +353,6 @@
for (@index) {
s/<!-- INDEX BEGIN -->(\s*<!--)(.*)(-->\s*)<!-- INDEX END -->/$lcp2/s;
s,#,$dir/$file#,g;
- # print HTML "$_\n";
print HTML "$_\n<P><HR><P>\n";
}
}
@@ -369,7 +371,7 @@
foreach $pod (@splithead) {
# figure out the directory name and filename
$pod =~ s,^([^/]*)$,/$1,;
- $pod =~ m,(.*?)/(.*?)(\.pod)?$,;
+ $pod =~ m,(.*)/(.*?)(\.pod)?$,;
$dirname = $1;
$filename = "$2.pod";
@@ -389,11 +391,11 @@
print "splitting files by item.\n" if $verbose && $#splititem >= 0;
$pwd = getcwd();
- my $splitter = absolute_path($pwd, "$splitpod/splitpod");
+ my $splitter = absolute_path($pwd, "$splitpod/splitpod");
foreach my $pod (@splititem) {
# figure out the directory to split into
$pod =~ s,^([^/]*)$,/$1,;
- $pod =~ m,(.*?)/(.*?)(\.pod)?$,;
+ $pod =~ m,(.*)/(.*?)(\.pod)?$,;
$dirname = "$1/$2";
$filename = "$2.pod";
@@ -410,7 +412,7 @@
die "$0: error changing to directory $podroot/$dirname: $!\n";
die "$splitter not found. Use '-splitpod dir' option.\n"
unless -f $splitter;
- system("perl", $splitter, "../$filename") &&
+ system($^X, $splitter, "../$filename") &&
warn "$0: error running '$splitter ../$filename'"
." from $podroot/$dirname";
}
@@ -452,7 +454,7 @@
# L<> links as necessary.
my %heads = ();
foreach $i (0..$#poddata) {
- $heads{htmlize($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/;
+ $heads{anchorify($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/;
}
# create a directory of a similar name and store all the
@@ -484,15 +486,15 @@
# determine an appropriate filename (this must correspond with
# what pod2html will try and guess)
# $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/;
- $file = "$dir/" . htmlize($section) . ".pod";
+ $file = "$dir/" . anchorify($section) . ".pod";
# create the new .pod file
print "\tcreating $poddir/$file\n" if $verbose;
open(SPLITOUT, ">$poddir/$file") ||
die "$0: error opening $poddir/$file for output: $!\n";
$poddata[$i] =~ s,L<([^<>]*)>,
- defined $heads{htmlize($1)} ? "L<$dir/$1>" : "L<$1>"
- ,ge;
+ defined $heads{anchorify($1)} ? "L<$dir/$1>" : "L<$1>"
+ ,ge;
print SPLITOUT $poddata[$i]."\n\n";
print SPLITOUT "=over 4\n\n";
print SPLITOUT "=item *\n\nBack to L<$dir/\"$prevsec\">\n\n" if $prevsec;
@@ -550,7 +552,7 @@
next if grep($_ eq "$podroot/$pod.pod", @$ignore);
# check if a .pm files exists too
- if (grep($_ eq "$pod.pm", @pmlist)) {
+ if (grep($_ eq $pod, @pmlist)) {
print "$0: Warning both `$podroot/$pod.pod' and "
. "`$podroot/$pod.pm' exist, using pod\n";
push(@ignore, "$pod.pm");
@@ -592,9 +594,7 @@
# invoke pod2html
print "$podroot/$pod => $htmldir/$html\n" if $verbose;
-#system("./pod2html",
- Pod::Html'pod2html(
- #Pod::Html'pod2html($pod2html,
+ Pod::Html::pod2html(
"--htmldir=$htmldir",
"--htmlroot=$htmlroot",
"--podpath=".join(":", @podpath),
@@ -606,5 +606,3 @@
"--infile=$podroot/$pod", "--outfile=$htmldir/$html");
die "$0: error running $pod2html: $!\n" if $?;
}
-
-sub htmlize { htmlify(0, @_) }
==== //depot/maint-5.8/perl/intrpvar.h#13 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#12~19106~ Mon Mar 31 21:11:53 2003
+++ perl/intrpvar.h Sun Apr 6 21:20:20 2003
@@ -537,6 +537,8 @@
PERLVAR(Isignals, U32) /* Using which pre-5.8 signals */
+PERLVAR(Istashcache, HV *) /* Cache to speed up S_method_common */
+
/* Don't forget to add your variable also to perl_clone()! */
/* New variables must be added to the very end, before this comment,
==== //depot/maint-5.8/perl/lib/ExtUtils/MM_VMS.pm#3 (text) ====
Index: perl/lib/ExtUtils/MM_VMS.pm
--- perl/lib/ExtUtils/MM_VMS.pm#2~19103~ Mon Mar 31 02:41:09 2003
+++ perl/lib/ExtUtils/MM_VMS.pm Sun Apr 6 21:20:20 2003
@@ -2226,7 +2226,7 @@
$self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
my $shr = $Config{dbgprefix} . 'PERLSHR';
- $self->{PERL_ARCHIVE} ||= $ENV{$shr} ? $ENV{$shr} :
"Sys\$Share:$shr.$Config{'dlext'}";
+ $self->{PERL_ARCHIVE} ||=
$self->catfile($self->{PERL_SRC},"$shr.$Config{'dlext'}");
$self->{PERL_ARCHIVE_AFTER} ||= '';
}
==== //depot/maint-5.8/perl/lib/ExtUtils/t/Embed.t#4 (text) ====
Index: perl/lib/ExtUtils/t/Embed.t
--- perl/lib/ExtUtils/t/Embed.t#3~18458~ Wed Jan 8 11:43:26 2003
+++ perl/lib/ExtUtils/t/Embed.t Sun Apr 6 21:20:20 2003
@@ -155,7 +155,11 @@
int main(int argc, char **argv, char **env)
{
- PerlInterpreter *my_perl = perl_alloc();
+ PerlInterpreter *my_perl;
+
+ PERL_SYS_INIT3(&argc,&argv,&env);
+
+ my_perl = perl_alloc();
my_puts("ok 2");
@@ -180,6 +184,8 @@
perl_free(my_perl);
my_puts("ok 8");
+
+ PERL_SYS_TERM();
return 0;
}
==== //depot/maint-5.8/perl/lib/Locale/Maketext.pm#2 (text) ====
Index: perl/lib/Locale/Maketext.pm
--- perl/lib/Locale/Maketext.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Locale/Maketext.pm Sun Apr 6 21:20:20 2003
@@ -1,5 +1,5 @@
-# Time-stamp: "2001-06-21 23:09:33 MDT"
+# Time-stamp: "2003-04-02 11:04:55 AHST"
require 5;
package Locale::Maketext;
@@ -14,7 +14,7 @@
BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
# define the constant 'DEBUG' at compile-time
-$VERSION = "1.03";
+$VERSION = "1.04";
@ISA = ();
$MATCH_SUPERS = 1;
@@ -252,11 +252,8 @@
unless(@languages) { # Calling with no args is magical! wooo, magic!
if(length( $ENV{'REQUEST_METHOD'} || '' )) { # I'm a CGI
- my $in = $ENV{'HTTP_ACCEPT_LANGUAGE'} || '';
- # supposedly that works under mod_perl, too.
- $in =~ s<\([\)]*\)><>g; # Kill parens'd things -- just a hack.
- @languages = &I18N::LangTags::extract_language_tags($in) if length $in;
- # ...which untaints, incidentally.
+ @languages = $base_class->_http_accept_langs;
+ # it's off in its own routine because it's complicated
} else { # Not running as a CGI: try to puzzle out from the environment
if(length( $ENV{'LANG'} || '' )) {
@@ -331,6 +328,62 @@
#
###########################################################################
+sub _http_accept_langs {
+ # Deal with HTTP "Accept-Language:" stuff. Hassle.
+ # This code is more lenient than RFC 3282, which you must read.
+ # Hm. Should I just move this into I18N::LangTags at some point?
+ no integer;
+
+ my $in = (@_ > 1) ? $_[1] : $ENV{'HTTP_ACCEPT_LANGUAGE'};
+ # (always ends up untainting)
+
+ return() unless defined $in and length $in;
+
+ $in =~ s/\([^\)]*\)//g; # nix just about any comment
+
+ if( $in =~ m/^\s*([a-zA-Z][-a-zA-Z]+)\s*$/s ) {
+ # Very common case: just one language tag
+ return lc $1;
+ } elsif( $in =~ m/^\s*[a-zA-Z][-a-zA-Z]+(?:\s*,\s*[a-zA-Z][-a-zA-Z]+)*\s*$/s ) {
+ # Common case these days: just "foo, bar, baz"
+ return map lc($_), $in =~ m/([a-zA-Z][-a-zA-Z]+)/g;
+ }
+
+ # Else it's complicated...
+
+ $in =~ s/\s+//g; # Yes, we can just do without the WS!
+ my @in = $in =~ m/([^,]+)/g;
+ my %pref;
+
+ my $q;
+ foreach my $tag (@in) {
+ next unless $tag =~
+ m/^([a-zA-Z][-a-zA-Z]+)
+ (?:
+ ;q=
+ (
+ \d* # a bit too broad of a RE, but so what.
+ (?:
+ \.\d+
+ )?
+ )
+ )?
+ $
+ /sx
+ ;
+ $q = (defined $2 and length $2) ? $2 : 1;
+ #print "$1 with q=$q\n";
+ push @{ $pref{$q} }, lc $1;
+ }
+
+ return # Read off %pref, in descending key order...
+ map @{$pref{$_}},
+ sort {$b <=> $a}
+ keys %pref;
+}
+
+###########################################################################
+
sub _compile {
# This big scarp routine compiles an entry.
# It returns either a coderef if there's brackety bits in this, or
@@ -673,3 +726,37 @@
###########################################################################
1;
+__END__
+
+HEY YOU! You need some FOOD!
+
+
+ ~~ Tangy Moroccan Carrot Salad ~~
+
+* 6 to 8 medium carrots, peeled and then sliced in 1/4-inch rounds
+* 1/4 teaspoon chile powder (cayenne, chipotle, ancho, or the like)
+* 1 tablespoon ground cumin
+* 1 tablespoon honey
+* The juice of about a half a big lemon, or of a whole smaller one
+* 1/3 cup olive oil
+* 1 tablespoon of fresh dill, washed and chopped fine
+* Pinch of salt, maybe a pinch of pepper
+
+Cook the carrots in a pot of boiling water until just tender -- roughly
+six minutes. (Just don't let them get mushy!) Drain the carrots.
+
+In a largish bowl, combine the lemon juice, the cumin, the chile
+powder, and the honey. Mix well.
+Add the olive oil and whisk it together well. Add the dill and stir.
+
+Add the warm carrots to the bowl and toss it all to coat the carrots
+well. Season with salt and pepper, to taste.
+
+Serve warm or at room temperature.
+
+The measurements here are very approximate, and you should feel free to
+improvise and experiment. It's a very forgiving recipe. For example,
+you could easily halve or double the amount of cumin, or use chopped mint
+leaves instead of dill, or lime juice instead of lemon, et cetera.
+
+[end]
==== //depot/maint-5.8/perl/lib/Locale/Maketext.pod#2 (text) ====
Index: perl/lib/Locale/Maketext.pod
--- perl/lib/Locale/Maketext.pod#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Locale/Maketext.pod Sun Apr 6 21:20:20 2003
@@ -1,9 +1,9 @@
-# Time-stamp: "2001-06-21 23:12:39 MDT"
+# Time-stamp: "2003-04-02 11:10:32 AHST"
=head1 NAME
-Locale::Maketext -- framework for localization
+Locale::Maketext - framework for localization
=head1 SYNOPSIS
@@ -110,7 +110,7 @@
=over
-=item *
+=item *
$lh = YourProjClass->get_handle( ...langtags... ) || die "lg-handle?";
@@ -146,7 +146,7 @@
Otherwise (i.e., if not a CGI), this tries various OS-specific ways
to get the language-tags for the current locale/language, and then
-pretends that those were the value(s) passed to C<cet_handle>.
+pretends that those were the value(s) passed to C<get_handle>.
Currently this OS-specific stuff consists of looking in the environment
variables "LANG" and "LANGUAGE"; and on MSWin machines (where those
@@ -325,7 +325,7 @@
"Your search matched [quant,_1,document]!"
It's for I<quantifying> a noun (i.e., saying how much of it there is,
-while giving the currect form of it). The behavior of this method is
+while giving the correct form of it). The behavior of this method is
handy for English and a few other Western European languages, and you
should override it for languages where it's not suitable. You can feel
free to read the source, but the current implementation is basically
@@ -347,7 +347,7 @@
C<"...[quant,_1,file]..."> is fine (for 0 it returns "0 files",
for 1 it returns "1 file", and for more it returns "2 files", etc.)
-But for "directory", you'd want C<"[quant,_1,direcory,directories]">
+But for "directory", you'd want C<"[quant,_1,directory,directories]">
so that our elementary C<quant> method doesn't think that the
plural of "directory" is "directorys". And you might find that the
output may sound better if you specify a negative form, as in:
@@ -511,7 +511,7 @@
While the key must be a string value (since that's a basic
restriction that Perl places on hash keys), the value in
-the lexicon can currenly be of several types:
+the lexicon can currently be of several types:
a defined scalar, scalarref, or coderef. The use of these is
explained above, in the section 'The "maketext" Method', and
Bracket Notation for strings is discussed in the next section.
@@ -570,7 +570,7 @@
I often just use a key "_USAGE_MESSAGE". At that point I then go
and immediately to define that lexicon entry in the
ProjectClass::L10N::en lexicon (since English is always my "project
-lanuage"):
+language"):
'_USAGE_MESSAGE' => <<'EOSTUFF',
...long long message...
@@ -755,7 +755,7 @@
),
Examples: "[_1]" and "[,_1]", which are synonymous; and
-"[,ID-(,_4,-,_2,)]", which compiles as
+"C<[,ID-(,_4,-,_2,)]>", which compiles as
C<join "", "ID-(", $_[4], "-", $_[2], ")">.
=item *
@@ -811,7 +811,7 @@
Currently, an unescaped "~" before a character
other than a bracket or a comma is taken to mean just a "~" and that
-charecter. I.e., "~X" means the same as "~~X" -- i.e., one literal tilde,
+character. I.e., "~X" means the same as "~~X" -- i.e., one literal tilde,
and then one literal "X". However, by using "~X", you are assuming that
no future version of Maketext will use "~X" as a magic escape sequence.
In practice this is not a great problem, since first off you can just
@@ -888,7 +888,7 @@
my $lh = ThisProject::I18N->get_handle();
# For the moment, assume that things are set up so
# that we load class ThisProject::I18N::en
- # and that's the class that $lh belongs to.
+ # and that that's the class that $lh belongs to.
...
if(-e $filename) {
go_process_file($filename)
@@ -1004,7 +1004,7 @@
S<eval { }>. However, I want programmers to reserve the right (via
the "fail" attribute) to treat lookup failure as something other than
an exception of the same level of severity as a config file being
-unreadable, or some essential resource being inaccessable.
+unreadable, or some essential resource being inaccessible.
One possibly useful value for the "fail" attribute is the method name
"failure_handler_auto". This is a method defined in class
@@ -1199,10 +1199,10 @@
language, so that you can override the C<numf> method as
appropriate. Typical variables in number formatting are: what to
use as a decimal point (comma? period?); what to use as a thousands
-separator (space? nonbreakinng space? comma? period? small
+separator (space? nonbreaking space? comma? period? small
middot? prime? apostrophe?); and even whether the so-called "thousands
separator" is actually for every third digit -- I've heard reports of
-two hundred thousand being expressable as "2,00,000" for some Indian
+two hundred thousand being expressible as "2,00,000" for some Indian
(Subcontinental) languages, besides the less surprising "S<200 000>",
"200.000", "200,000", and "200'000". Also, using a set of numeral
glyphs other than the usual ASCII "0"-"9" might be appreciated, as via
@@ -1275,7 +1275,8 @@
message catalogs that are just databases of sprintf formats.
L<File::Findgrep|File::Findgrep> is a sample application/module
-that uses Locale::Maketext to localize its messages.
+that uses Locale::Maketext to localize its messages. For a larger
+internationalized system, see also L<Apache::MP3>.
L<I18N::LangTags|I18N::LangTags>.
@@ -1303,7 +1304,7 @@
=head1 COPYRIGHT AND DISCLAIMER
-Copyright (c) 1999-2001 Sean M. Burke. All rights reserved.
+Copyright (c) 1999-2003 Sean M. Burke. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -1317,5 +1318,3 @@
Sean M. Burke C<[EMAIL PROTECTED]>
=cut
-
-# Zing!
==== //depot/maint-5.8/perl/lib/Locale/Maketext/ChangeLog#2 (text) ====
Index: perl/lib/Locale/Maketext/ChangeLog
--- perl/lib/Locale/Maketext/ChangeLog#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Locale/Maketext/ChangeLog Sun Apr 6 21:20:20 2003
@@ -1,6 +1,18 @@
Revision history for Perl suite Locale::Maketext
- Time-stamp: "2001-06-21 23:18:31 MDT"
+ Time-stamp: "2003-04-02 10:37:42 AHST"
+2003-04-02 Sean M. Burke [EMAIL PROTECTED]
+ * Release 1.04: Implementing proper HTTP "tag;q=rank" parsing for
+ get_handle. This should make all the difference for users/victims
+ of the current version of Safari, which uses that syntax as well
+ as inserts random languages with low q numbers.
+ Thanks to Jesse Vincent and the whole RT junta for finding this.
+
+ * Added more tests, now in t/
+
+ * Lots of typo fixes to Maketext.pm. Thanks to Evan A. Zacks for
+ patient help in finding them all.
+
2001-06-21 Sean M. Burke [EMAIL PROTECTED]
* Release 1.03: basically cosmetic tweaks to the docs and the
test.pl.
==== //depot/maint-5.8/perl/lib/Locale/Maketext/README#2 (text) ====
Index: perl/lib/Locale/Maketext/README
--- perl/lib/Locale/Maketext/README#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Locale/Maketext/README Sun Apr 6 21:20:20 2003
@@ -1,5 +1,5 @@
README for Locale::Maketext
- Time-stamp: "2001-05-25 08:15:55 MDT"
+ Time-stamp: "2003-04-02 11:06:17 AHST"
Locale::Maketext
@@ -17,7 +17,8 @@
This suite requires Perl 5. It also requires a recent version
of I18N::LangTags. MSWin users should also get Win32::Locale.
-File::Findgrep is also useful example code.
+File::Findgrep is also useful example code, as is the rather
+larger Apache::MP3 source (even if you don't run Apache).
INSTALLATION
@@ -55,12 +56,12 @@
The latest version of Locale::Maketext is available from the
Comprehensive Perl Archive Network (CPAN). Visit
-<http://www.cpan.org/> to find a CPAN site near you.
+<http://www.perl.com/CPAN/> to find a CPAN site near you.
COPYRIGHT
-Copyright 1999-2001, Sean M. Burke <[EMAIL PROTECTED]>, all rights
+Copyright 1999-2003, Sean M. Burke <[EMAIL PROTECTED]>, all rights
reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
==== //depot/maint-5.8/perl/lib/Locale/Maketext/t/00about.t#1 (text) ====
Index: perl/lib/Locale/Maketext/t/00about.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Locale/Maketext/t/00about.t Sun Apr 6 21:20:20 2003
@@ -0,0 +1,29 @@
+
+require 5;
+use Test;
+BEGIN { plan tests => 1; }
+use Locale::Maketext 1.01;
+
+print "#\n#\n",
+ "# Locale::Maketext v$Locale::Maketext::VERSION\n",
+ "# I18N::LangTags v", $I18N::LangTags::VERSION || "?", "\n",
+ "#\n#\n",
+;
+
+print "# Running under perl version $] for $^O",
+ (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n";
+
+print "# Win32::BuildNumber ", &Win32::BuildNumber(), "\n"
+ if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber();
+
+print "# MacPerl verison $MacPerl::Version\n"
+ if defined $MacPerl::Version;
+
+printf
+ "# Current time local: %s\n# Current time GMT: %s\n",
+ scalar( gmtime($^T)), scalar(localtime($^T));
+
+print "# Using Test.pm v", $Test::VERSION || "?", "\n";
+
+ok 1;
+
==== //depot/maint-5.8/perl/lib/Locale/Maketext/t/01make.t#1 (text) ====
Index: perl/lib/Locale/Maketext/t/01make.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Locale/Maketext/t/01make.t Sun Apr 6 21:20:20 2003
@@ -0,0 +1,34 @@
+
+require 5;
+use Test;
+BEGIN { plan tests => 6; }
+use Locale::Maketext 1.01;
+print "# Hi there...\n";
+ok 1;
+
+# declare some classes...
+{
+ package Woozle;
+ @ISA = ('Locale::Maketext');
+ sub dubbil { return $_[1] * 2 }
+ sub numerate { return $_[2] . 'en' }
+}
+{
+ package Woozle::elx;
+ @ISA = ('Woozle');
+ %Lexicon = (
+ 'd2' => 'hum [dubbil,_1]',
+ 'd3' => 'hoo [quant,_1,zaz]',
+ 'd4' => 'hoo [*,_1,zaz]',
+ );
+ keys %Lexicon; # dodges the 'used only once' warning
+}
+
+ok defined( $lh = Woozle->get_handle('elx') ) && ref($lh);
+ok $lh && $lh->maketext('d2', 7), "hum 14" ;
+ok $lh && $lh->maketext('d3', 7), "hoo 7 zazen" ;
+ok $lh && $lh->maketext('d4', 7), "hoo 7 zazen" ;
+
+print "# Byebye!\n";
+ok 1;
+
==== //depot/maint-5.8/perl/lib/Locale/Maketext/t/02get.t#1 (text) ====
Index: perl/lib/Locale/Maketext/t/02get.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Locale/Maketext/t/02get.t Sun Apr 6 21:20:20 2003
@@ -0,0 +1,69 @@
+
+require 5;
+use Test;
+BEGIN { plan tests => 11; }
+use Locale::Maketext 1.01;
+print "# Hi there...\n";
+ok 1;
+
+print "# --- Making sure that get_handle works ---\n";
+
+# declare some classes...
+{
+ package Woozle;
+ @ISA = ('Locale::Maketext');
+ sub dubbil { return $_[1] * 2 }
+ sub numerate { return $_[2] . 'en' }
+}
+{
+ package Woozle::eu_mt;
+ @ISA = ('Woozle');
+ %Lexicon = (
+ 'd2' => 'hum [dubbil,_1]',
+ 'd3' => 'hoo [quant,_1,zaz]',
+ 'd4' => 'hoo [*,_1,zaz]',
+ );
+ keys %Lexicon; # dodges the 'used only once' warning
+}
+
+my $lh;
+print "# Basic sanity:\n";
+ok defined( $lh = Woozle->get_handle('eu-mt') ) && ref($lh);
+ok $lh && $lh->maketext('d2', 7), "hum 14" ;
+
+
+
+print "# Make sure we can assign to ENV entries\n",
+ "# (Otherwise we can't run the subsequent tests)...\n";
+$ENV{'MYORP'} = 'Zing';
+ok $ENV{'MYORP'}, 'Zing';
+$ENV{'SWUZ'} = 'KLORTHO HOOBOY';
+ok $ENV{'SWUZ'}, 'KLORTHO HOOBOY';
+
+delete $ENV{'MYORP'};
+delete $ENV{'SWUZ'};
+
+print "# Test LANG...\n";
+$ENV{'REQUEST_METHOD'} = '';
+$ENV{'LANG'} = 'Eu_MT';
+$ENV{'LANGUAGE'} = '';
+ok defined( $lh = Woozle->get_handle() ) && ref($lh);
+
+print "# Test LANGUAGE...\n";
+$ENV{'LANG'} = '';
+$ENV{'LANGUAGE'} = 'Eu-MT';
+ok defined( $lh = Woozle->get_handle() ) && ref($lh);
+
+print "# Test HTTP_ACCEPT_LANGUAGE...\n";
+$ENV{'REQUEST_METHOD'} = 'GET';
+$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'eu-MT';
+ok defined( $lh = Woozle->get_handle() ) && ref($lh);
+$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eu-MT, i-klung';
+ok defined( $lh = Woozle->get_handle() ) && ref($lh);
+$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eU-Mt, i-klung';
+ok defined( $lh = Woozle->get_handle() ) && ref($lh);
+
+
+print "# Byebye!\n";
+ok 1;
+
==== //depot/maint-5.8/perl/lib/Locale/Maketext/t/03http.t#1 (text) ====
Index: perl/lib/Locale/Maketext/t/03http.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Locale/Maketext/t/03http.t Sun Apr 6 21:20:20 2003
@@ -0,0 +1,102 @@
+
+use Locale::Maketext;
+
+use Test;
+BEGIN { plan tests => 87 };
+
+my @in = grep m/\S/, split /\n/, q{
+
+[ sv ] sv
+[ en ] en
+[ en fi ] en, fi
+[ en-us ] en-us
+[ en-us ] en-US
+[ en-us ] EN-US
+
+[ en-au en i-klingon en-gb en-us mt-mt mt ja ] EN-au, JA;q=0.14, i-klingon;q=0.83,
en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
+[ en-au en i-klingon en-gb en-us mt-mt mt tli ja ] EN-au, tli;q=0.201, JA;q=0.14,
i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
+[ en-au en en-gb en-us ja ] en-au, ja;q=0.20, en-gb;q=0.60, en-us;q=0.40, en;q=0.80
+
+[ en-au en en-gb en-us mt-mt mt ja ] EN-au, JA;q=0.14, en-gb;q=0.71, en-us;q=0.57,
mt-mt;q=0.43, mt;q=0.29, en;q=0.86
+[ en-au en en-gb en-us ja ] en-au, ja;q=0.20, en-gb;q=0.60, en-us;q=0.40, en;q=0.80
+[ en fr ] en;q=1,fr;q=.5
+[ en fr ] en;q=1,fr;q=.99
+[ en ru ko ] en, ru;q=0.7, ko;q=0.3
+[ en ru ko ] en, ru;q=0.7, KO;q=0.3
+[ en-us en ] en-us, en;q=0.50
+[ en fr ] fr ; q = 0.9, en
+[ en fr ] en,fr;q=.90
+[ ru en-uk en fr ] ru, en-UK;q=0.5, en;q=0.3, fr;q=0.1
+[ en-us fr es-mx ] en-us,fr;q=0.7,es-mx;q=0.3
+[ en-us en ] en-us, en;q=0.50
+
+[ da en-gb en ] da, en-gb;q=0.8, en;q=0.7
+[ da en-gb en ] da, en;q=0.7, en-gb;q=0.8
+[ da en-gb en ] da, en-gb;q=0.8, en;q=0.7
+[ da en-gb en ] da,en;q=0.7,en-gb;q=0.8
+[ da en-gb en ] da, en-gb ; q=0.8, en ; q=0.7
+[ da en-gb en ] da , en-gb ; q = 0.8 , en ; q =0.7
+[ da en-gb en ] da (yup, Danish) , en-gb ; q = 0.8 , en ; q =0.7
+
+[ no dk en-uk en-us ] en-UK;q=0.7, en-US;q=0.6, no;q=1.0, dk;q=0.8
+[ no dk en-uk en-us ] en-US;q=0.6, en-UK;q=0.7, no;q=1.0, dk;q=0.8
+[ no dk en-uk en-us ] en-UK;q=0.7, no;q=1.0, en-US;q=0.6, dk;q=0.8
+[ no dk en-uk en-us ] en-UK;q=0.7, no;q=1.0, dk;q=0.8, en-US;q=0.6
+
+[ fi en ] fi;q=1, en;q=0.2
+[ de-de de en en-us en-gb ] de-DE, de;q=0.80, en;q=0.60, en-US;q=0.40, en-GB;q=0.20
+[ ru ] ru; q=1, *; q=0.1
+[ ru en ] ru, en; q=0.1
+[ ja en ] ja,en;q=0.5
+[ en ] en; q=1.0
+[ ja ] ja; q=1.0
+[ ja ] ja; q=1.0
+[ en ja ] en; q=0.5, ja; q=0.5
+[ fr-ca fr en ] fr-ca, fr;q=0.8, en;q=0.7
+[ NIX ] NIX
+};
+
+foreach my $in (@in) {
+ $in =~ s/^\s*\[([^\]]+)\]\s*//s or die "Bad input: $in";
+ my @should = do { my $x = $1; $x =~ m/(\S+)/g };
+
+ if($in eq 'NIX') { $in = ''; @should = (); }
+
+ local $ENV{'HTTP_ACCEPT_LANGUAGE'};
+
+ foreach my $modus (
+ sub {
+ print "# Testing with arg...\n";
+ $ENV{'HTTP_ACCEPT_LANGUAGE'} = 'PLORK';
+ return $_[0];
+ },
+ sub {
+ print "# Testing wath HTTP_ACCEPT_LANGUAGE...\n";
+ $ENV{'HTTP_ACCEPT_LANGUAGE'} = $_[0];
+ return();
+ },
+ ) {
+ my @args = &$modus($in);
+
+ # ////////////////////////////////////////////////////
+ my @out = Locale::Maketext->_http_accept_langs(@args);
+ # \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+ if(
+ @out == @should
+ and lc( join "\e", @out ) eq lc( join "\e", @should )
+ ) {
+ print "# Happily got [EMAIL PROTECTED] from [$in]\n";
+ ok 1;
+ } else {
+ ok 0;
+ print "#Got: [EMAIL PROTECTED]",
+ "# but wanted: [EMAIL PROTECTED]",
+ "# < \"$in\"\n#\n";
+ }
+ }
+}
+
+print "#\n#\n# Bye-bye!\n";
+ok 1;
+
==== //depot/maint-5.8/perl/lib/Pod/Functions.pm#3 (text) ====
Index: perl/lib/Pod/Functions.pm
--- perl/lib/Pod/Functions.pm#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Pod/Functions.pm Sun Apr 6 21:20:20 2003
@@ -284,12 +284,13 @@
quotemeta Regexp quote regular expression magic characters
qw/STRING/ LIST quote a list of words
qx/STRING/ Process backquote quote a string
-qr/PATTERN/ Regexp Compile pattern
+qr/STRING/ Regexp Compile pattern
rand Math retrieve the next pseudorandom number
read I/O,Binary fixed-length buffered input from a filehandle
readdir I/O get a directory from a directory handle
readline I/O fetch a record from a file
readlink File determine where a symbolic link is pointing
+readpipe Process execute a system command and collect standard output
recv Socket receive a message over a Socket
redo Flow start this loop iteration over again
ref Objects find out the type of thing being referenced
@@ -341,6 +342,7 @@
substr String get or alter a portion of a stirng
symlink File create a symbolic link to a file
syscall I/O,Binary execute an arbitrary system call
+sysopen File open a file, pipe, or descriptor
sysread I/O,Binary fixed-length unbuffered input from a filehandle
sysseek I/O,Binary position I/O pointer on handle used with sysread and
syswrite
system Process run a separate program
@@ -348,6 +350,7 @@
tell I/O get current seekpointer on a filehandle
telldir I/O get current seekpointer on a directory handle
tie Objects bind a variable to an object class
+tied Objects get a reference to the object underlying a tied variable
time Time return number of seconds since 1970
times Process,Time return elapsed time for self and child processes
tr/// String transliterate a string
==== //depot/maint-5.8/perl/lib/Pod/Html.pm#3 (text) ====
Index: perl/lib/Pod/Html.pm
--- perl/lib/Pod/Html.pm#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Pod/Html.pm Sun Apr 6 21:20:20 2003
@@ -2,10 +2,11 @@
use strict;
require Exporter;
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 1.04;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+$VERSION = 1.05;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);
[EMAIL PROTECTED] = qw(anchorify);
use Carp;
use Config;
@@ -1965,12 +1966,12 @@
}
#
-# similar to htmlify, but turns spaces into underscores
+# similar to htmlify, but turns non-alphanumerics into underscores
#
sub anchorify {
my ($anchor) = @_;
$anchor = htmlify($anchor);
- $anchor =~ s/\s/_/g; # fixup spaces left by htmlify
+ $anchor =~ s/\W/_/g;
return $anchor;
}
==== //depot/maint-5.8/perl/lib/Pod/t/Functions.t#2 (text) ====
Index: perl/lib/Pod/t/Functions.t
--- perl/lib/Pod/t/Functions.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Pod/t/Functions.t Sun Apr 6 21:20:20 2003
@@ -80,7 +80,7 @@
sprintf, substr, tr///, uc, ucfirst, y///
Regular expressions and pattern matching:
- m//, pos, qr/PATTERN/, quotemeta, s///, split, study
+ m//, pos, qr/STRING/, quotemeta, s///, split, study
Numeric functions:
abs, atan2, cos, exp, hex, int, log, oct, rand, sin, sqrt,
@@ -109,7 +109,7 @@
Functions for filehandles, files, or directories:
-X, chdir, chmod, chown, chroot, fcntl, glob, ioctl, link,
lstat, mkdir, open, opendir, readlink, rename, rmdir,
- stat, symlink, umask, unlink, utime
+ stat, symlink, sysopen, umask, unlink, utime
Keywords related to control flow of your perl program:
caller, continue, die, do, dump, eval, exit, goto, last,
@@ -124,14 +124,15 @@
Functions for processes and process groups:
alarm, exec, fork, getpgrp, getppid, getpriority, kill,
- pipe, qx/STRING/, setpgrp, setpriority, sleep, system,
- times, wait, waitpid
+ pipe, qx/STRING/, readpipe, setpgrp, setpriority, sleep,
+ system, times, wait, waitpid
Keywords related to perl modules:
do, import, no, package, require, use
Keywords related to classes and object-orientedness:
- bless, dbmclose, dbmopen, package, ref, tie, untie, use
+ bless, dbmclose, dbmopen, package, ref, tie, tied, untie,
+ use
Low-level socket functions:
accept, bind, connect, getpeername, getsockname,
==== //depot/maint-5.8/perl/lib/Pod/t/htmlview.t#3 (text) ====
Index: perl/lib/Pod/t/htmlview.t
--- perl/lib/Pod/t/htmlview.t#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Pod/t/htmlview.t Sun Apr 6 21:20:20 2003
@@ -32,11 +32,11 @@
<li><a href="#name">NAME</a></li>
<li><a href="#synopsis">SYNOPSIS</a></li>
<li><a href="#description">DESCRIPTION</a></li>
- <li><a href="#methods_=>_other_stuff">METHODS => OTHER STUFF</a></li>
+ <li><a href="#methods____other_stuff">METHODS => OTHER STUFF</a></li>
<ul>
- <li><a href="#new()"><code>new()</code></a></li>
- <li><a href="#old()"><code>old()</code></a></li>
+ <li><a href="#new__"><code>new()</code></a></li>
+ <li><a href="#old__"><code>old()</code></a></li>
</ul>
<li><a href="#testing_for_and_begin">TESTING FOR AND BEGIN</a></li>
@@ -75,11 +75,11 @@
<p>
</p>
<hr />
-<h1><a name="methods_=>_other_stuff">METHODS => OTHER STUFF</a></h1>
+<h1><a name="methods____other_stuff">METHODS => OTHER STUFF</a></h1>
<p>Here is a list of methods</p>
<p>
</p>
-<h2><a name="new()"><code>new()</code></a></h2>
+<h2><a name="new__"><code>new()</code></a></h2>
<p>Constructor method. Accepts the following config options:</p>
<dl>
<dt><strong><a name="item_foo">foo</a></strong><br />
@@ -113,7 +113,7 @@
</li>
<li><strong><a name="item_sat_on_the">Sat <em>on</em> the</a></strong><br />
</li>
-<li><strong><a name="item_mat%3c%21%3e">Mat<!></a></strong><br />
+<li><strong><a name="item_mat_3c_21_3e">Mat<!></a></strong><br />
</li>
</ul>
<p>Title on the same line as the =item + numerical bullets</p>
@@ -144,7 +144,7 @@
<p></p></dl>
<p>
</p>
-<h2><a name="old()"><code>old()</code></a></h2>
+<h2><a name="old__"><code>old()</code></a></h2>
<p>Destructor method</p>
<p>
</p>
==== //depot/maint-5.8/perl/lib/Unicode/Collate.pm#3 (text) ====
Index: perl/lib/Unicode/Collate.pm
--- perl/lib/Unicode/Collate.pm#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Unicode/Collate.pm Sun Apr 6 21:20:20 2003
@@ -1,8 +1,8 @@
package Unicode::Collate;
BEGIN {
- if (ord("A") == 193) {
- die "Unicode::Collate not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ die "Unicode::Collate cannot stringify a Unicode code point\n";
}
}
@@ -14,11 +14,7 @@
require Exporter;
-# Supporting on EBCDIC platform is not tested.
-# Tester(s) welcome!
-our $IsEBCDIC = ord("A") != 0x41;
-
-our $VERSION = '0.23';
+our $VERSION = '0.24';
our $PACKAGE = __PACKAGE__;
our @ISA = qw(Exporter);
@@ -37,7 +33,7 @@
unless ($@) {
$UNICODE_VERSION = Unicode::UCD::UnicodeVersion();
}
-else { # XXX, Perl 5.6.1
+else { # Perl 5.6.1
my($f, $fh);
foreach my $d (@INC) {
$f = File::Spec->catfile($d, "unicode", "Unicode.301");
@@ -59,17 +55,21 @@
# This is also used as a HAS_UNICODE_NORMALIZE flag.
our $getCombinClass;
+# Supported Levels
+use constant MinLevel => 1;
+use constant MaxLevel => 4;
+
# Minimum weights at level 2 and 3, respectively
-use constant Min2 => 0x20;
-use constant Min3 => 0x02;
+use constant Min2Wt => 0x20;
+use constant Min3Wt => 0x02;
# Shifted weight at 4th level
-use constant Shift4 => 0xFFFF;
+use constant Shift4Wt => 0xFFFF;
# Variable weight at 1st level.
# This is a negative value but should be regarded as zero on collation.
# This is for distinction of variable chars from level 3 ignorable chars.
-use constant Var1 => -1;
+use constant Var1Wt => -1;
# A boolean for Variable and 16-bit weights at 4 levels of Collation Element
@@ -79,10 +79,6 @@
# other than "shift" (as well as "shift-trimmed") is unreliable.
use constant VCE_TEMPLATE => 'Cn4';
-# Unicode encoding of strings to be collated
-# TODO: 'N*' for UTF-32BE, 'V*' for UTF-32LE.
-use constant UTF_TEMPLATE => 'U*';
-
# A sort key: 16-bit weights
# See also the PROBLEM on VCE_TEMPLATE above.
use constant KEY_TEMPLATE => 'n*';
@@ -113,6 +109,33 @@
sub Base_Unicode_Version { $UNICODE_VERSION || 'unknown' }
+######
+
+use constant UNICODE_FOR_PACK => ("A" eq pack('U', 0x41));
+use constant NATIVE_FOR_PACK => ("A" eq pack('U', ord("A")));
+
+use constant UNICODE_FOR_UNPACK => (0x41 == unpack('U', "A"));
+use constant NATIVE_FOR_UNPACK => (ord("A") == unpack('U', "A"));
+
+sub pack_U {
+ return UNICODE_FOR_PACK
+ ? pack('U*', @_)
+ : NATIVE_FOR_PACK
+ ? pack('U*', map utf8::unicode_to_native($_), @_)
+ : die "$PACKAGE, a Unicode code point cannot be stringified.\n";
+}
+
+sub unpack_U {
+ return UNICODE_FOR_UNPACK
+ ? unpack('U*', shift)
+ : NATIVE_FOR_UNPACK
+ ? map(utf8::native_to_unicode($_), unpack 'U*', shift)
+ : die "$PACKAGE, a code point returned from unpack U " .
+ "cannot be converted into Unicode.\n";
+}
+
+######
+
my (%AlternateOK);
@AlternateOK{ qw/
blanked non-ignorable shifted shift-trimmed
@@ -125,13 +148,15 @@
/;
our @ChangeNG = qw/
- entry entries table combining maxlength
+ entry entries table maxlength
ignoreChar ignoreName undefChar undefName
versionTable alternateTable backwardsTable forwardsTable rearrangeTable
derivCode normCode rearrangeHash L3_ignorable
+ backwardsFlag
/;
-# The hash key 'ignored' is deleted at VERSION 0.21.
-# The hash key 'isShift' are deleted at VERSION 0.23.
+# The hash key 'ignored' is deleted at v 0.21.
+# The hash key 'isShift' is deleted at v 0.23.
+# The hash key 'combining' is deleted at v 0.24.
my (%ChangeOK, %ChangeNG);
@ChangeOK{ @ChangeOK } = ();
@@ -155,12 +180,18 @@
return wantarray ? %old : $self;
}
+sub _checkLevel {
+ my $level = shift;
+ my $key = shift;
+ croak sprintf "Illegal level %d (in \$self->{%s}) lower than %d.",
+ $level, $key, MinLevel if MinLevel > $level;
+ croak sprintf "Unsupported level %d (in \$self->{%s}) higher than %d ",
+ $level, $key, MaxLevel if MaxLevel < $level;
+}
+
sub checkCollator {
my $self = shift;
- croak "Illegal level lower than 1 (passed $self->{level})."
- if $self->{level} < 1;
- croak "A level higher than 4 (passed $self->{level}) is not supported."
- if 4 < $self->{level};
+ _checkLevel($self->{level}, "level");
$self->{derivCode} =
$self->{UCA_Version} == 8 ? \&_derivCE_8 :
@@ -171,10 +202,24 @@
croak "$PACKAGE unknown alternate tag name: $self->{alternate}"
unless exists $AlternateOK{ $self->{alternate} };
- $self->{backwards} = []
- if ! defined $self->{backwards};
- $self->{backwards} = [ $self->{backwards} ]
- if ! ref $self->{backwards};
+ if (! defined $self->{backwards}) {
+ $self->{backwardsFlag} = 0;
+ }
+ elsif (! ref $self->{backwards}) {
+ _checkLevel($self->{backwards}, "backwards");
+ $self->{backwardsFlag} = 1 << $self->{backwards};
+ }
+ else {
+ my %level;
+ $self->{backwardsFlag} = 0;
+ for my $b (@{ $self->{backwards} }) {
+ _checkLevel($b, "backwards");
+ $level{$b} = 1;
+ }
+ for my $v (sort keys %level) {
+ $self->{backwardsFlag} += 1 << $v;
+ }
+ }
$self->{rearrange} = []
if ! defined $self->{rearrange};
@@ -223,7 +268,7 @@
$self->parseEntry($_) foreach split /\n/, $self->{entry};
}
- $self->{level} ||= 4;
+ $self->{level} ||= MaxLevel;
$self->{UCA_Version} ||= UCA_Version();
$self->{overrideHangul} = ''
@@ -305,10 +350,7 @@
$entry = join(CODE_SEP, @uv); # in JCPS
if (defined $self->{undefChar} || defined $self->{ignoreChar}) {
- # Do not use UTF_TEMPLATE; Perl' RE is only for utf8.
- my $ele = $IsEBCDIC
- ? pack('U*', map utf8::unicode_to_native($_), @uv)
- : pack('U*', @uv);
+ my $ele = pack_U(@uv);
# regarded as if it were not entried in the table
return
@@ -323,15 +365,12 @@
$k = '[.0000.0000.0000.0000]'
if defined $self->{ignoreName} && $name =~ /$self->{ignoreName}/;
- my $combining = TRUE; # primary = 0, secondary != 0;
my $is_L3_ignorable;
foreach my $arr ($k =~ /\[([^\[\]]+)\]/g) { # SPACEs allowed
my $var = $arr =~ /\*/; # exactly /^\*/ but be lenient.
my @wt = _getHexArray($arr);
push @key, pack(VCE_TEMPLATE, $var, @wt);
- $combining = FALSE
- unless $wt[0] == 0 && $wt[1] != 0;
$is_L3_ignorable = TRUE
if $wt[0] + $wt[1] + $wt[2] == 0;
# if $arr !~ /[1-9A-Fa-f]/; NG
@@ -340,11 +379,6 @@
$self->{entries}{$entry} = [EMAIL PROTECTED];
- $self->{combining}{$entry} = TRUE
- if $combining;
-
- # The key is a string representing a numeral code point.
-
$self->{L3_ignorable}{$uv[0]} = TRUE
if @uv == 1 && $is_L3_ignorable;
@@ -353,8 +387,9 @@
if @uv > 1;
}
+
##
-## arrayref[weights] = altCE(bool variable?, list[num] weights)
+## arrayref[weights] = altCE(VCE)
##
sub altCE
{
@@ -362,26 +397,29 @@
my($var, @wt) = unpack(VCE_TEMPLATE, shift);
$self->{alternate} eq 'blanked' ?
- $var ? [Var1, 0, 0, $wt[3]] : [EMAIL PROTECTED] :
+ $var ? [Var1Wt, 0, 0, $wt[3]] : [EMAIL PROTECTED] :
$self->{alternate} eq 'non-ignorable' ?
[EMAIL PROTECTED] :
$self->{alternate} eq 'shifted' ?
- $var ? [Var1, 0, 0, $wt[0] ]
- : [ @wt[0..2], $wt[0]+$wt[1]+$wt[2] ? Shift4 : 0 ] :
+ $var ? [Var1Wt, 0, 0, $wt[0] ]
+ : [ @wt[0..2], $wt[0]+$wt[1]+$wt[2] ? Shift4Wt : 0 ] :
$self->{alternate} eq 'shift-trimmed' ?
- $var ? [Var1, 0, 0, $wt[0] ] : [ @wt[0..2], 0 ] :
+ $var ? [Var1Wt, 0, 0, $wt[0] ] : [ @wt[0..2], 0 ] :
croak "$PACKAGE unknown alternate name: $self->{alternate}";
}
sub viewSortKey
{
my $self = shift;
- my $ver = $self->{UCA_Version};
+ $self->visualizeSortKey($self->getSortKey(@_));
+}
- my $key = $self->getSortKey(@_);
- my $view = join " ", map sprintf("%04X", $_), unpack(KEY_TEMPLATE, $key);
+sub visualizeSortKey
+{
+ my $self = shift;
+ my $view = join " ", map sprintf("%04X", $_), unpack(KEY_TEMPLATE, shift);
- if ($ver <= 8) {
+ if ($self->{UCA_Version} <= 8) {
$view =~ s/ ?0000 ?/|/g;
} else {
$view =~ s/\b0000\b/|/g;
@@ -423,9 +461,7 @@
}
# get array of Unicode code point of string.
- my @src = $IsEBCDIC
- ? map(utf8::native_to_unicode($_), unpack UTF_TEMPLATE, $str)
- : unpack(UTF_TEMPLATE, $str);
+ my @src = unpack_U($str);
# rearrangement:
# Character positions are not kept if rearranged,
@@ -529,7 +565,7 @@
$cjk
? map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$cjk($u))
: defined $cjk && $self->{UCA_Version} <= 8 && $u < 0x10000
- ? pack(VCE_TEMPLATE, NON_VAR, $u, Min2, Min3, $u)
+ ? pack(VCE_TEMPLATE, NON_VAR, $u, Min2Wt, Min3Wt, $u)
: $der->($u);
}
else {
@@ -557,7 +593,7 @@
if ($wt->[0] == 0) { # ignorable
next if $last_is_variable;
} else {
- $last_is_variable = ($wt->[0] == Var1);
+ $last_is_variable = ($wt->[0] == Var1Wt);
}
}
push @buf, $wt;
@@ -571,10 +607,6 @@
if 0 < $b->[$v];
}
}
- foreach (@{ $self->{backwards} }) {
- my $v = $_ - 1;
- @{ $ret[$v] } = reverse @{ $ret[$v] };
- }
# modification of tertiary weights
if ($self->{upper_before_lower}) {
@@ -591,6 +623,15 @@
elsif (0x0D <= $_ && $_ <= 0x0E) { $_ += 5 } # hiragana
}
}
+
+ if ($self->{backwardsFlag}) {
+ for (my $v = MinLevel; $v <= MaxLevel; $v++) {
+ if ($self->{backwardsFlag} & (1 << $v)) {
+ @{ $ret[$v-1] } = reverse @{ $ret[$v-1] };
+ }
+ }
+ }
+
join LEVEL_SEP, map pack(KEY_TEMPLATE, @$_), @ret;
}
@@ -630,8 +671,8 @@
my $aaaa = $base + ($u >> 15);
my $bbbb = ($u & 0x7FFF) | 0x8000;
return
- pack(VCE_TEMPLATE, NON_VAR, $aaaa, Min2, Min3, $u),
- pack(VCE_TEMPLATE, NON_VAR, $bbbb, 0, 0, $u);
+ pack(VCE_TEMPLATE, NON_VAR, $aaaa, Min2Wt, Min3Wt, $u),
+ pack(VCE_TEMPLATE, NON_VAR, $bbbb, 0, 0, $u);
}
sub _derivCE_8 {
@@ -684,7 +725,7 @@
my $wt = shift;
return if ! defined $wt;
my $lv = shift;
- return grep($wt->[$_] != 0, 0..$lv-1) ? TRUE : FALSE;
+ return grep($wt->[$_-1] != 0, MinLevel..$lv) ? TRUE : FALSE;
}
##
@@ -731,7 +772,6 @@
$pos = 0 if $pos < 0;
my $grob = shift;
- my $comb = $self->{combining};
my $lev = $self->{level};
my $ver9 = $self->{UCA_Version} > 8;
my $v2i = $self->{alternate} ne 'non-ignorable';
@@ -760,14 +800,14 @@
if ($wt->[0] == 0) {
$to_be_pushed = FALSE if $last_is_variable;
} else {
- $last_is_variable = ($wt->[0] == Var1);
+ $last_is_variable = ($wt->[0] == Var1Wt);
}
}
if (@subWt && $wt->[0] == 0) {
push @{ $subWt[-1] }, $wt if $to_be_pushed;
} else {
- $wt->[0] = 0 if $wt->[0] == Var1;
+ $wt->[0] = 0 if $wt->[0] == Var1Wt;
push @subWt, [ $wt ];
}
}
@@ -789,7 +829,7 @@
if ($wt->[0] == 0) {
$to_be_pushed = FALSE if $last_is_variable;
} else {
- $last_is_variable = ($wt->[0] == Var1);
+ $last_is_variable = ($wt->[0] == Var1Wt);
}
}
@@ -797,7 +837,7 @@
push @{ $strWt[-1] }, $wt if $to_be_pushed;
$finPos[-1] = $strCE->[$i][2];
} elsif ($to_be_pushed) {
- $wt->[0] = 0 if $wt->[0] == Var1;
+ $wt->[0] = 0 if $wt->[0] == Var1Wt;
push @strWt, [ $wt ];
push @iniPos, $found_base ? NOMATCHPOS : $strCE->[$i][1];
$finPos[-1] = NOMATCHPOS if $found_base;
@@ -1217,9 +1257,9 @@
B<NOTE>: These tags simplemindedly assume
any lowercase/uppercase or hiragana/katakana distinctions
-should occur in level 3, and their weights at level 3
-should be same as those mentioned in 7.3.1, UTS #10.
-If you define your collation elements which violates this,
+must occur in level 3, and their weights at level 3
+must be same as those mentioned in 7.3.1, UTS #10.
+If you define your collation elements which violate this requirement,
these tags don't work validly.
=back
==== //depot/maint-5.8/perl/lib/Unicode/Collate/Changes#3 (text) ====
Index: perl/lib/Unicode/Collate/Changes
--- perl/lib/Unicode/Collate/Changes#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Unicode/Collate/Changes Sun Apr 6 21:20:20 2003
@@ -1,5 +1,8 @@
Revision history for Perl extension Unicode::Collate.
+0.24 Thu Apr 02 23:12:54 2003
+ - internal tweak for (?un)pack 'U'.
+
0.23 Wed Sep 04 19:25:20 2002
- fix: scalar match() no longer returns an lvalue substr ref.
- fix: "Ignorable after variable" should be made level 3 ignorable
==== //depot/maint-5.8/perl/lib/Unicode/Collate/README#3 (text) ====
Index: perl/lib/Unicode/Collate/README
--- perl/lib/Unicode/Collate/README#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Unicode/Collate/README Sun Apr 6 21:20:20 2003
@@ -1,4 +1,4 @@
-Unicode/Collate version 0.23
+Unicode/Collate version 0.24
===============================
NAME
==== //depot/maint-5.8/perl/lib/Unicode/Collate/t/index.t#3 (text) ====
Index: perl/lib/Unicode/Collate/t/index.t
--- perl/lib/Unicode/Collate/t/index.t#2~18946~ Tue Mar 11 22:13:00 2003
+++ perl/lib/Unicode/Collate/t/index.t Sun Apr 6 21:20:20 2003
@@ -1,7 +1,8 @@
BEGIN {
- if (ord("A") == 193) {
- print "1..0 # Unicode::Collate not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ print "1..0 # Unicode::Collate " .
+ "cannot stringify a Unicode code point\n";
exit 0;
}
}
==== //depot/maint-5.8/perl/lib/Unicode/Collate/t/test.t#4 (text) ====
Index: perl/lib/Unicode/Collate/t/test.t
--- perl/lib/Unicode/Collate/t/test.t#3~18946~ Tue Mar 11 22:13:00 2003
+++ perl/lib/Unicode/Collate/t/test.t Sun Apr 6 21:20:20 2003
@@ -1,7 +1,8 @@
BEGIN {
- if (ord("A") == 193) {
- print "1..0 # Unicode::Collate not ported to EBCDIC\n";
+ unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
+ print "1..0 # Unicode::Collate " .
+ "cannot stringify a Unicode code point\n";
exit 0;
}
}
@@ -53,10 +54,12 @@
##############
-# Use pack('U'), not chr(), for Perl 5.6.1.
-my $A_acute = pack('U', $IsEBCDIC ? 0x65 : 0xC1);
-my $a_acute = pack('U', $IsEBCDIC ? 0x45 : 0xE1);
-my $acute = pack('U', 0x0301);
+sub _pack_U { Unicode::Collate::pack_U(@_) }
+sub _unpack_U { Unicode::Collate::unpack_U(@_) }
+
+my $A_acute = _pack_U(0xC1);
+my $a_acute = _pack_U(0xE1);
+my $acute = _pack_U(0x0301);
ok($Collator->cmp("A$acute", $A_acute), 0); # @version 3.1.1 (prev: -1)
ok($Collator->cmp($a_acute, $A_acute), -1);
==== //depot/maint-5.8/perl/op.c#19 (text) ====
Index: perl/op.c
--- perl/op.c#18~19040~ Thu Mar 20 21:00:59 2003
+++ perl/op.c Sun Apr 6 21:20:20 2003
@@ -4421,7 +4421,7 @@
CopSTASH_set(PL_curcop,stash);
}
- cv = newXS(name, const_sv_xsub, __FILE__);
+ cv = newXS(name, const_sv_xsub, CopFILE(PL_curcop));
CvXSUBANY(cv).any_ptr = sv;
CvCONST_on(cv);
sv_setpv((SV*)cv, ""); /* prototype is "" */
==== //depot/maint-5.8/perl/perl.c#27 (text) ====
Index: perl/perl.c
--- perl/perl.c#26~18978~ Fri Mar 14 02:52:06 2003
+++ perl/perl.c Sun Apr 6 21:20:20 2003
@@ -313,6 +313,8 @@
#endif
PL_clocktick = HZ;
+ PL_stashcache = newHV();
+
ENTER;
}
@@ -569,6 +571,9 @@
PL_regex_padav = Nullav;
PL_regex_pad = NULL;
#endif
+
+ SvREFCNT_dec((SV*) PL_stashcache);
+ PL_stashcache = NULL;
/* loosen bonds of global variables */
==== //depot/maint-5.8/perl/perlapi.h#12 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h#11~19106~ Mon Mar 31 21:11:53 2003
+++ perl/perlapi.h Sun Apr 6 21:20:20 2003
@@ -520,6 +520,8 @@
#define PL_splitstr (*Perl_Isplitstr_ptr(aTHX))
#undef PL_srand_called
#define PL_srand_called (*Perl_Isrand_called_ptr(aTHX))
+#undef PL_stashcache
+#define PL_stashcache (*Perl_Istashcache_ptr(aTHX))
#undef PL_statusvalue
#define PL_statusvalue (*Perl_Istatusvalue_ptr(aTHX))
#undef PL_statusvalue_vms
==== //depot/maint-5.8/perl/pod/perldiag.pod#19 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#18~19030~ Wed Mar 19 07:57:49 2003
+++ perl/pod/perldiag.pod Sun Apr 6 21:20:20 2003
@@ -44,7 +44,7 @@
=over 4
-=item A thread exited while %d other threads were still running
+=item A thread exited while %d threads were running
(W) When using threaded Perl, a thread (not necessarily the main
thread) exited while there were still other threads running.
==== //depot/maint-5.8/perl/pod/perlembed.pod#5 (text) ====
Index: perl/pod/perlembed.pod
--- perl/pod/perlembed.pod#4~18877~ Sun Mar 9 23:20:13 2003
+++ perl/pod/perlembed.pod Sun Apr 6 21:20:20 2003
@@ -183,6 +183,7 @@
int main(int argc, char **argv, char **env)
{
+ PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
@@ -190,11 +191,16 @@
perl_run(my_perl);
perl_destruct(my_perl);
perl_free(my_perl);
+ PERL_SYS_TERM();
}
Notice that we don't use the C<env> pointer. Normally handed to
C<perl_parse> as its final argument, C<env> here is replaced by
-C<NULL>, which means that the current environment will be used.
+C<NULL>, which means that the current environment will be used. The macros
+PERL_SYS_INIT3() and PERL_SYS_TERM() provide system-specific tune up
+of the C runtime environment necessary to run Perl interpreters; since
+PERL_SYS_INIT3() may change C<env>, it may be more appropriate to provide
+C<env> as an argument to perl_parse().
Now compile this program (I'll call it I<interp.c>) into an executable:
@@ -235,6 +241,7 @@
int main(int argc, char **argv, char **env)
{
char *args[] = { NULL };
+ PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
@@ -247,6 +254,7 @@
perl_destruct(my_perl);
perl_free(my_perl);
+ PERL_SYS_TERM();
}
where I<showtime> is a Perl subroutine that takes no arguments (that's the
@@ -308,6 +316,7 @@
STRLEN n_a;
char *embedding[] = { "", "-e", "0" };
+ PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct( my_perl );
@@ -329,6 +338,7 @@
perl_destruct(my_perl);
perl_free(my_perl);
+ PERL_SYS_TERM();
}
All of those strange functions with I<sv> in their names help convert Perl scalars to
C types. They're described in L<perlguts> and L<perlapi>.
@@ -489,6 +499,7 @@
SV *text;
STRLEN n_a;
+ PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
@@ -532,6 +543,7 @@
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
+ PERL_SYS_TERM();
}
which produces the output (again, long lines have been wrapped here)
@@ -614,6 +626,7 @@
{
char *my_argv[] = { "", "power.pl" };
+ PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct( my_perl );
@@ -625,6 +638,7 @@
perl_destruct(my_perl);
perl_free(my_perl);
+ PERL_SYS_TERM();
}
@@ -763,6 +777,7 @@
int exitstatus = 0;
STRLEN n_a;
+ PERL_SYS_INIT3(&argc,&argv,&env);
if((my_perl = perl_alloc()) == NULL) {
fprintf(stderr, "no memory!");
exit(1);
@@ -792,6 +807,7 @@
PL_perl_destruct_level = 0;
perl_destruct(my_perl);
perl_free(my_perl);
+ PERL_SYS_TERM();
exit(exitstatus);
}
@@ -884,12 +900,14 @@
int main(int argc, char **argv, char **env)
{
- PerlInterpreter
- *one_perl = perl_alloc(),
- *two_perl = perl_alloc();
+ PerlInterpreter *one_perl, *two_perl;
char *one_args[] = { "one_perl", SAY_HELLO };
char *two_args[] = { "two_perl", SAY_HELLO };
+ PERL_SYS_INIT3(&argc,&argv,&env);
+ one_perl = perl_alloc();
+ two_perl = perl_alloc();
+
PERL_SET_CONTEXT(one_perl);
perl_construct(one_perl);
PERL_SET_CONTEXT(two_perl);
@@ -914,6 +932,7 @@
perl_free(one_perl);
PERL_SET_CONTEXT(two_perl);
perl_free(two_perl);
+ PERL_SYS_TERM();
}
Note the calls to PERL_SET_CONTEXT(). These are necessary to initialize
==== //depot/maint-5.8/perl/pod/perlfunc.pod#14 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod#13~19093~ Sun Mar 30 07:16:16 2003
+++ perl/pod/perlfunc.pod Sun Apr 6 21:20:20 2003
@@ -246,11 +246,11 @@
=over 8
-=item I<-X> FILEHANDLE
+=item -X FILEHANDLE
-=item I<-X> EXPR
+=item -X EXPR
-=item I<-X>
+=item -X
A file test, where X is one of the letters listed below. This unary
operator takes one argument, either a filename or a filehandle, and
==== //depot/maint-5.8/perl/pod/perluniintro.pod#7 (text) ====
Index: perl/pod/perluniintro.pod
--- perl/pod/perluniintro.pod#6~18742~ Tue Feb 18 06:05:05 2003
+++ perl/pod/perluniintro.pod Sun Apr 6 21:20:20 2003
@@ -451,7 +451,7 @@
sprintf("\\x{%04X}", $_) : # \x{...}
chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
sprintf("\\x%02X", $_) : # \x..
- chr($_) # else as themselves
+ quotemeta(chr($_)) # else quoted or as themselves
} unpack("U*", $_[0])); # unpack Unicode characters
}
@@ -459,9 +459,11 @@
nice_string("foo\x{100}bar\n")
-returns:
+returns the string
- "foo\x{0100}bar\x0A"
+ 'foo\x{0100}bar\x0A'
+
+which is ready to be printed.
=head2 Special Cases
==== //depot/maint-5.8/perl/pod/splitpod#2 (xtext) ====
Index: perl/pod/splitpod
--- perl/pod/splitpod#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/pod/splitpod Sun Apr 6 21:20:20 2003
@@ -10,7 +10,8 @@
next unless /^=(?!cut)/ .. /^=cut/;
- if (s/=item (\S+)/$1/) {
+ if (/=item (\S+)/ and $1 ne '*') {
+ s/=item //;
#$cur = "POSIX::" . $1;
$next{$cur} = $1;
$cur = $1;
==== //depot/maint-5.8/perl/pp.c#17 (text) ====
Index: perl/pp.c
--- perl/pp.c#16~19119~ Tue Apr 1 08:21:37 2003
+++ perl/pp.c Sun Apr 6 21:20:20 2003
@@ -3433,8 +3433,8 @@
/* work around glibc-2.2.5 bug */
PL_reentrant_buffer->_crypt_struct_buffer->current_saltbits = 0;
}
- }
#endif
+ }
# endif /* HAS_CRYPT_R */
# endif /* USE_ITHREADS */
# ifdef FCRYPT
@@ -4803,12 +4803,10 @@
if (gimme == G_ARRAY)
RETURN;
}
- if (iters || !pm->op_pmreplroot) {
- GETTARGET;
- PUSHi(iters);
- RETURN;
- }
- RETPUSHUNDEF;
+
+ GETTARGET;
+ PUSHi(iters);
+ RETURN;
}
#ifdef USE_5005THREADS
==== //depot/maint-5.8/perl/pp_ctl.c#20 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#19~19073~ Wed Mar 26 20:25:46 2003
+++ perl/pp_ctl.c Sun Apr 6 21:20:20 2003
@@ -2858,7 +2858,13 @@
*startop = PL_eval_root;
} else
SAVEFREEOP(PL_eval_root);
- if (gimme & G_VOID)
+ if (gimme & G_VOID && ! PL_in_eval & EVAL_INREQUIRE)
+ /*
+ * EVAL_INREQUIRE (the code is being required) is special-cased :
+ * in this case we want scalar context to be forced, instead
+ * of void context, so a proper return value is returned from
+ * C<require> via this leaveeval op.
+ */
scalarvoid(PL_eval_root);
else if (gimme & G_ARRAY)
list(PL_eval_root);
==== //depot/maint-5.8/perl/pp_hot.c#18 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#17~19073~ Wed Mar 26 20:25:46 2003
+++ perl/pp_hot.c Sun Apr 6 21:20:20 2003
@@ -3052,8 +3052,17 @@
/* this isn't a reference */
packname = Nullch;
+
+ if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
+ HE* he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
+ if (he) {
+ stash = (HV*)HeVAL(he);
+ goto fetch;
+ }
+ }
+
if (!SvOK(sv) ||
- !(packname = SvPV(sv, packlen)) ||
+ !(packname) ||
!(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
@@ -3072,6 +3081,11 @@
stash = gv_stashpvn(packname, packlen, FALSE);
if (!stash)
packsv = sv;
+ else {
+ SvREFCNT_inc((SV*)stash);
+ if(!hv_store(PL_stashcache, packname, packlen, (SV*)stash, 0))
+ SvREFCNT_dec((SV*)stash);
+ }
goto fetch;
}
/* it _is_ a filehandle name -- replace with a reference */
==== //depot/maint-5.8/perl/sv.c#39 (text) ====
Index: perl/sv.c
--- perl/sv.c#38~19106~ Mon Mar 31 21:11:53 2003
+++ perl/sv.c Sun Apr 6 21:20:20 2003
@@ -11115,6 +11115,8 @@
/* Pluggable optimizer */
PL_peepp = proto_perl->Tpeepp;
+ PL_stashcache = newHV();
+
if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
==== //depot/maint-5.8/perl/t/comp/require.t#2 (xtext) ====
Index: perl/t/comp/require.t
--- perl/t/comp/require.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/comp/require.t Sun Apr 6 21:20:20 2003
@@ -11,8 +11,8 @@
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 23;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 20; }
+my $total_tests = 29;
+if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 26; }
print "1..$total_tests\n";
sub do_require {
@@ -129,6 +129,22 @@
dofile();
sub dofile { do "bleah.do"; };
print $x;
+
+# Test that scalar context is forced for require
+
+write_file('bleah.pm', <<'**BLEAH**'
+print "not " if !defined wantarray || wantarray ne '';
+print "ok $i - require() context\n";
+1;
+**BLEAH**
+);
+ delete $INC{"bleah.pm"}; ++$::i;
+$foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i;
[EMAIL PROTECTED] = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i;
+ eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i;
+$foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
[EMAIL PROTECTED] = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
+ eval {require bleah};
# UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input
==== //depot/maint-5.8/perl/t/op/split.t#8 (xtext) ====
Index: perl/t/op/split.t
--- perl/t/op/split.t#7~19155~ Sun Apr 6 12:56:30 2003
+++ perl/t/op/split.t Sun Apr 6 21:20:20 2003
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 52;
+plan tests => 54;
$FS = ':';
@@ -279,6 +279,13 @@
{
$p="a,b";
utf8::upgrade $p;
- @a=split(/[, ]+/,$p);
+ eval { @a=split(/[, ]+/,$p) };
is ("[EMAIL PROTECTED]@a-", '-a b-', '#20912 - split() to array with /[]+/ and
utf8');
+}
+
+{
+ is ([EMAIL PROTECTED], [EMAIL PROTECTED]"a"}, '@a must be global for following
test');
+ $p="";
+ $n = @a = split /,/,$p;
+ is ($n, 0, '#21765 - pmreplroot hack used to return undef for 0 iters');
}
==== //depot/maint-5.8/perl/toke.c#15 (text) ====
Index: perl/toke.c
--- perl/toke.c#14~18993~ Sun Mar 16 07:20:38 2003
+++ perl/toke.c Sun Apr 6 21:20:20 2003
@@ -6666,8 +6666,12 @@
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
}
SvREFCNT_dec(herewas);
- if (UTF && !IN_BYTES && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
- SvUTF8_on(tmpstr);
+ if (!IN_BYTES) {
+ if (UTF && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+ SvUTF8_on(tmpstr);
+ else if (PL_encoding)
+ sv_recode_to_utf8(tmpstr, PL_encoding);
+ }
PL_lex_stuff = tmpstr;
yylval.ival = op_type;
return s;
==== //depot/maint-5.8/perl/vms/vms.c#9 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#8~19110~ Mon Mar 31 21:33:03 2003
+++ perl/vms/vms.c Sun Apr 6 21:20:20 2003
@@ -284,7 +284,7 @@
}
}
else if (!ivlnm) {
- if (idx == 0) {
+ if ( (idx == 0) && (flags & PERL__TRNENV_JOIN_SEARCHLIST) ) {
midx = my_maxidx((char *) lnm);
for (idx = 0, cp1 = eqv; idx <= midx; idx++) {
lnmlst[1].bufadr = cp1;
@@ -312,7 +312,6 @@
(retsts == SS$_NOLOGNAM)) { continue; }
}
else {
- idx -= 1;
retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; }
if (retsts == SS$_NOLOGNAM) continue;
@@ -363,7 +362,7 @@
char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
unsigned long int idx = 0;
int trnsuccess, success, secure, saverr, savvmserr;
- int midx;
+ int midx, flags;
SV *tmpsv;
midx = my_maxidx((char *) lnm) + 1;
@@ -392,27 +391,43 @@
return eqv;
}
else {
- if ((cp2 = strchr(lnm,';')) != NULL) {
- strcpy(uplnm,lnm);
- uplnm[cp2-lnm] = '\0';
- idx = strtoul(cp2+1,NULL,0) + 1;
- lnm = uplnm;
- }
/* Impose security constraints only if tainting */
if (sys) {
/* Impose security constraints only if tainting */
secure = PL_curinterp ? PL_tainting : will_taint;
saverr = errno; savvmserr = vaxc$errno;
}
- else secure = 0;
- success = vmstrnenv(lnm,eqv,idx,
- secure ? fildev : NULL,
+ else {
+ secure = 0;
+ }
+
+ flags =
#ifdef SECURE_INTERNAL_GETENV
- secure ? PERL__TRNENV_SECURE : 0
+ secure ? PERL__TRNENV_SECURE : 0
#else
- 0
+ 0
#endif
- );
+ ;
+
+ /* For the getenv interface we combine all the equivalence names
+ * of a search list logical into one value to acquire a maximum
+ * value length of 255*128 (assuming %ENV is using logicals).
+ */
+ flags |= PERL__TRNENV_JOIN_SEARCHLIST;
+
+ /* If the name contains a semicolon-delimited index, parse it
+ * off and make sure we only retrieve the equivalence name for
+ * that index. */
+ if ((cp2 = strchr(lnm,';')) != NULL) {
+ strcpy(uplnm,lnm);
+ uplnm[cp2-lnm] = '\0';
+ idx = strtoul(cp2+1,NULL,0);
+ lnm = uplnm;
+ flags &= ~PERL__TRNENV_JOIN_SEARCHLIST;
+ }
+
+ success = vmstrnenv(lnm,eqv,idx,secure ? fildev : NULL,flags);
+
/* Discard NOLOGNAM on internal calls since we're often looking
* for an optional name, and this "error" often shows up as the
* (bogus) exit status for a die() call later on. */
@@ -430,7 +445,7 @@
{
char *buf, *cp1, *cp2;
unsigned long idx = 0;
- int midx;
+ int midx, flags;
static char *__my_getenv_len_eqv = NULL;
int secure, saverr, savvmserr;
SV *tmpsv;
@@ -462,26 +477,35 @@
return buf;
}
else {
- if ((cp2 = strchr(lnm,';')) != NULL) {
- strcpy(buf,lnm);
- buf[cp2-lnm] = '\0';
- idx = strtoul(cp2+1,NULL,0) + 1;
- lnm = buf;
- }
if (sys) {
/* Impose security constraints only if tainting */
secure = PL_curinterp ? PL_tainting : will_taint;
saverr = errno; savvmserr = vaxc$errno;
}
- else secure = 0;
- *len = vmstrnenv(lnm,buf,idx,
- secure ? fildev : NULL,
+ else {
+ secure = 0;
+ }
+
+ flags =
#ifdef SECURE_INTERNAL_GETENV
- secure ? PERL__TRNENV_SECURE : 0
+ secure ? PERL__TRNENV_SECURE : 0
#else
- 0
+ 0
#endif
- );
+ ;
+
+ flags |= PERL__TRNENV_JOIN_SEARCHLIST;
+
+ if ((cp2 = strchr(lnm,';')) != NULL) {
+ strcpy(buf,lnm);
+ buf[cp2-lnm] = '\0';
+ idx = strtoul(cp2+1,NULL,0);
+ lnm = buf;
+ flags &= ~PERL__TRNENV_JOIN_SEARCHLIST;
+ }
+
+ *len = vmstrnenv(lnm,buf,idx,secure ? fildev : NULL,flags);
+
/* Discard NOLOGNAM on internal calls since we're often looking
* for an optional name, and this "error" often shows up as the
* (bogus) exit status for a die() call later on. */
==== //depot/maint-5.8/perl/vms/vmsish.h#3 (text) ====
Index: perl/vms/vmsish.h
--- perl/vms/vmsish.h#2~19110~ Mon Mar 31 21:33:03 2003
+++ perl/vms/vmsish.h Sun Apr 6 21:20:20 2003
@@ -307,6 +307,7 @@
/* Flags for vmstrnenv() */
#define PERL__TRNENV_SECURE 0x01
+#define PERL__TRNENV_JOIN_SEARCHLIST 0x02
/* Handy way to vet calls to VMS system services and RTL routines. */
#define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
==== //depot/maint-5.8/perl/wince/Makefile.ce#5 (text) ====
Index: perl/wince/Makefile.ce
--- perl/wince/Makefile.ce#4~19053~ Sun Mar 23 20:44:50 2003
+++ perl/wince/Makefile.ce Sun Apr 6 21:20:20 2003
@@ -192,7 +192,7 @@
TARGETCPU = ARM
CEVersion = 300
OSVERSION = WCE300
-PLATFORM = HPC2000
+#PLATFORM = HPC2000
MCFLAGS = -D _MT -D _DLL -D ARM -D arm -D _arm_ -D _ARM_ \
-DPROCESSOR_ARM -DPALM_SIZE \
-I $(CELIBDLLDIR)\inc
@@ -349,9 +349,13 @@
!if "$(CFG)" == "RELEASE"
# -O2 and -Ot give internal compiler error in perl.c and lexer.
# Also the dll cannot be loaded by perl.exe...
+!if "$(CPU)" == "SH3"
+!else
CECFLAGS = $(CECFLAGS) -O2 -Ot
!endif
+!endif
+
RCDEFS = /l 0x407 /r /d "UNICODE" /d UNDER_CE=$(CEVersion) \
/d _WIN32_WCE=$(CEVersion)
@@ -767,7 +771,7 @@
#----------------------------------------------------------------------------------
Extensions: ..\win32\buildext.pl $(PERLDEP) $(CONFIGPM)
$(HPERL) -I..\lib -I..\win32 -MCross=$(CROSS_NAME) ..\win32\buildext.pl
$(MAKE) $(PERLDEP) $(EXTDIR) \
- !POSIX !Time/HiRes
+ !POSIX !Time/HiRes !XS/Typemap
Extensions_clean:
-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP)
$(EXTDIR) clean
@@ -913,7 +917,14 @@
!endif
dist: all
- $(HPERL) -I..\lib -MCross=$(CROSS_NAME) makedist.pl
--distdir=dist-$(CROSS_NAME)
+ $(HPERL) -I..\lib -MCross=$(CROSS_NAME) makedist.pl
--distdir=dist-$(CROSS_NAME) --cross-name=$(CROSS_NAME)
+
+zipdist: all
+ $(HPERL) -I..\lib -MCross=$(CROSS_NAME) makedist.pl
--distdir=dist-$(CROSS_NAME) --cross-name=$(CROSS_NAME)
+ $(HPERL) -I..\lib -MCross=$(CROSS_NAME) makedist.pl
--distdir=dist-$(CROSS_NAME) --cross-name=$(CROSS_NAME) --zip
+
+zip:
+ $(HPERL) -I..\lib -MCross=$(CROSS_NAME) makedist.pl
--distdir=dist-$(CROSS_NAME) --cross-name=$(CROSS_NAME) --zip
perl.ico:
$(HPERL) makeico.pl
==== //depot/maint-5.8/perl/wince/compile-all.bat#2 (text) ====
Index: perl/wince/compile-all.bat
--- perl/wince/compile-all.bat#1~19053~ Sun Mar 23 20:44:50 2003
+++ perl/wince/compile-all.bat Sun Apr 6 21:20:20 2003
@@ -1,13 +1,62 @@
-call compile.bat MACHINE=wince-arm-hpc-wce300
-call compile.bat MACHINE=wince-arm-hpc-wce211
-call compile.bat MACHINE=wince-sh3-hpc-wce211
-call compile.bat MACHINE=wince-mips-hpc-wce211
-call compile.bat MACHINE=wince-sh3-hpc-wce200
-call compile.bat MACHINE=wince-mips-hpc-wce200
-call compile.bat MACHINE=wince-arm-pocket-wce300
-call compile.bat MACHINE=wince-mips-pocket-wce300
-call compile.bat MACHINE=wince-sh3-pocket-wce300
-call compile.bat MACHINE=wince-x86em-pocket-wce300
-call compile.bat MACHINE=wince-mips-palm-wce211
-call compile.bat MACHINE=wince-sh3-palm-wce211
-call compile.bat MACHINE=wince-x86em-palm-wce211
[EMAIL PROTECTED] off
+rem
+rem Normally you do not need to run this file.
+rem Instead you should edit and execute compile.bat .
+rem
+rem This file assumes that you have a set of appropriate
+rem bat-files that prepare environment variables for build process
+rem and execute commands passed as arguments
+rem
+
+call wcearm-300 compile.bat "MACHINE=wince-arm-hpc-wce300"
+call wcearm-300 compile.bat "MACHINE=wince-arm-hpc-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call wcearm-211 compile.bat "MACHINE=wince-arm-hpc-wce211"
+call wcearm-211 compile.bat "MACHINE=wince-arm-hpc-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call wcesh3-211 compile.bat "MACHINE=wince-sh3-hpc-wce211"
+call wcesh3-211 compile.bat "MACHINE=wince-sh3-hpc-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call wcemips-211 compile.bat "MACHINE=wince-mips-hpc-wce211"
+call wcemips-211 compile.bat "MACHINE=wince-mips-hpc-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+rem TODO call wcesh3-200 compile.bat "MACHINE=wince-sh3-hpc-wce200"
+rem TODO call wcesh3-200 compile.bat "MACHINE=wince-sh3-hpc-wce200" zipdist
+rem TODO ..\miniperl makedist.pl --clean-exts
+
+rem TODO call compile.bat "MACHINE=wince-mips-hpc-wce200"
+rem TODO call compile.bat "MACHINE=wince-mips-hpc-wce200" zipdist
+rem TODO ..\miniperl makedist.pl --clean-exts
+
+call WCEARM-p300 compile.bat "MACHINE=wince-arm-pocket-wce300"
+call WCEARM-p300 compile.bat "MACHINE=wince-arm-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEMIPS-300 compile.bat "MACHINE=wince-mips-pocket-wce300"
+call WCEMIPS-300 compile.bat "MACHINE=wince-mips-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCESH3-300 compile.bat "MACHINE=wince-sh3-pocket-wce300"
+call WCESH3-300 compile.bat "MACHINE=wince-sh3-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEx86-300 compile.bat "MACHINE=wince-x86em-pocket-wce300"
+call WCEx86-300 compile.bat "MACHINE=wince-x86em-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEMIPS-palm211 compile.bat "MACHINE=wince-mips-palm-wce211"
+call WCEMIPS-palm211 compile.bat "MACHINE=wince-mips-palm-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCESH3-palm211 compile.bat "MACHINE=wince-sh3-palm-wce211"
+call WCESH3-palm211 compile.bat "MACHINE=wince-sh3-palm-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEx86-palm211 compile.bat "MACHINE=wince-x86em-palm-wce211"
+call WCEx86-palm211 compile.bat "MACHINE=wince-x86em-palm-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
==== //depot/maint-5.8/perl/wince/compile.bat#4 (text) ====
Index: perl/wince/compile.bat
--- perl/wince/compile.bat#3~19053~ Sun Mar 23 20:44:50 2003
+++ perl/wince/compile.bat Sun Apr 6 21:20:20 2003
@@ -6,7 +6,7 @@
set ARG-1=PV=
set ARG-2=INST_VER=
-set ARG-3=INSTALL_ROOT=\Storage [EMAIL PROTECTED]
+set ARG-3=INSTALL_ROOT=\Storage [EMAIL PROTECTED]
set ARG-4=WCEROOT=%SDKROOT%
set ARG-5=CEPATH=%WCEROOT%
set ARG-6=CELIBDLLDIR=d:\personal\pocketPC\celib-palm-3.0
==== //depot/maint-5.8/perl/wince/makedist.pl#2 (text) ====
Index: perl/wince/makedist.pl
--- perl/wince/makedist.pl#1~19053~ Sun Mar 23 20:44:50 2003
+++ perl/wince/makedist.pl Sun Apr 6 21:20:20 2003
@@ -5,6 +5,7 @@
my %opts = (
#defaults
+ 'verbose' => 1, # verbose level, in range from 0 to 2
'distdir' => 'distdir',
'unicode' => 1, # include unicode by default
'minimal' => 0, # minimal possible distribution.
@@ -14,18 +15,20 @@
'include-modules' => '', # TODO
'exclude-modules' => '', # TODO
#??? 'only-modules' => '', # TODO
- 'platform' => 'wince',
+ 'cross-name' => 'wince',
'strip-pod' => 0, # TODO strip POD from perl modules
'adaptation' => 0, # TODO do some adaptation, such as stripping such
# occurences as "if ($^O eq 'VMS'){...}" for certain modules
- 'zip' => 0, # perform zip (TODO)
+ 'zip' => 0, # perform zip
'clean-exts' => 0,
#options itself
(map {/^--([\-_\w]+)=(.*)$/} @ARGV), # --opt=smth
(map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), # --opt
--no-opt --noopt
);
-# TODO -- error checking. When something goes wrong, just exit with rc!=0
+# TODO
+# -- error checking. When something goes wrong, just exit with rc!=0
+# -- may be '--zip' option should be made differently?
my $cwd = cwd;
@@ -42,6 +45,17 @@
exit;
}
+# zip
+if ($opts{'zip'}) {
+ if ($opts{'verbose'} >=1) {
+ print STDERR "zipping...\n";
+ }
+ chdir $opts{'distdir'};
+ unlink <*.zip>;
+ `zip -R perl-$opts{'cross-name'} *`;
+ exit;
+}
+
my (%libexclusions, %extexclusions);
my @lfiles;
sub copy($$);
@@ -55,6 +69,9 @@
#inclusions
#...
#copy them
+if ($opts{'verbose'} >=1) {
+ print STDERR "Copying perl lib files...\n";
+}
for (@lfiles) {
/^(.*)\/[^\/]+$/;
mkpath "$opts{distdir}/lib/$1";
@@ -72,26 +89,41 @@
#...
#copy them
#{s[/(\w+)/\1\.pm][/$1.pm]} @efiles;
+if ($opts{'verbose'} >=1) {
+ print STDERR "Copying perl core extensions...\n";
+}
for (@efiles) {
/^(.*)\/([^\/]+)\/([^\/]+)$/;
copy "../ext/$_", "$opts{distdir}/lib/$1/$3";
}
-# Config.pm
-copy "../xlib/$opts{platform}/Config.pm", "$opts{distdir}/lib/Config.pm";
+# Config.pm, perl binaries
+if ($opts{'verbose'} >=1) {
+ print STDERR "Copying Config.pm, perl.dll and perl.exe...\n";
+}
+copy "../xlib/$opts{'cross-name'}/Config.pm", "$opts{distdir}/lib/Config.pm";
+copy "$opts{'cross-name'}/perl.exe", "$opts{distdir}/bin/perl.exe";
+copy "$opts{'cross-name'}/perl.dll", "$opts{distdir}/bin/perl.dll";
+# how do we know exact name of perl.dll?)
# auto
my @afiles;
-chdir "../xlib/$opts{platform}/auto";
+chdir "../xlib/$opts{'cross-name'}/auto";
find({no_chdir=>1,wanted=>sub{push @afiles, $_ if /\.(dll|bs)$/}},'.');
chdir $cwd;
+if ($opts{'verbose'} >=1) {
+ print STDERR "Copying binaries for perl core extensions...\n";
+}
for (@afiles) {
- copy "../xlib/$opts{platform}/auto/$_", "$opts{distdir}/lib/auto/$_";
+ copy "../xlib/$opts{'cross-name'}/auto/$_", "$opts{distdir}/lib/auto/$_";
}
-sub copy {
+sub copy($$) {
my ($fnfrom, $fnto) = @_;
- my $ffrom = do {local (@ARGV,$/) = $fnfrom; <>};
+ open my $fh, "<$fnfrom" or die "can not open $fnfrom: $!";
+ binmode $fh;
+ local $/;
+ my $ffrom = <$fh>;
if ($opts{'strip-pod'}) {
# actually following regexp is suspicious to not work everywhere.
# but we've checked on our set of modules, and it's fit for our purposes
@@ -100,7 +132,11 @@
}
mkpath $1 if $fnto=~/^(.*)\/([^\/]+)$/;
open my $fhout, ">$fnto";
+ binmode $fhout;
print $fhout $ffrom;
+ if ($opts{'verbose'} >=2) {
+ print STDERR "copying $fnfrom=>$fnto\n";
+ }
}
BEGIN {
End of Patch.
