Change 18824 by [EMAIL PROTECTED] on 2003/03/04 05:39:18
Integrate:
[ 18816]
Upgrade to Encode 1.89. The enc_module.t required
a little tweak, sending that to Dan.
[ 18817]
Upgrade to Unicode::Normalize 0.20.
[ 18818]
Sync with libnet-1.13
[ 18819]
Further clarification on PERL_UNICODE's semantics.
[ 18820]
Fixes bug #15654 bizarre constant mangling in 5.8.0
What happened was that a constant was freed, the pad released but
the pad slot still held the SV, when pad slot was reallocated
to be a target for a stringify, it did a sv_setpv on the target
and the original SV was wiped out. When this SV was later on
to new places using the constant, they got the wrong value.
By replacing pad_free with pad_swipe for these cases, we
won't have such a problem. (pad_swipe also removes the
pointer to the original SV).
[ 18821]
Can't test this without PerlIO.
[ 18822]
Subject: Re: [perl #21395] rcatline doesn't grok utf8
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Sun, 2 Mar 2003 05:43:54 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 18823]
Try to give rcatline() a good jog on Unicode.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#29 integrate
... //depot/maint-5.8/perl/ext/Encode/AUTHORS#6 integrate
... //depot/maint-5.8/perl/ext/Encode/Changes#8 integrate
... //depot/maint-5.8/perl/ext/Encode/Encode.pm#8 integrate
... //depot/maint-5.8/perl/ext/Encode/Encode.xs#7 integrate
... //depot/maint-5.8/perl/ext/Encode/MANIFEST#6 integrate
... //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.xs#6 integrate
... //depot/maint-5.8/perl/ext/Encode/encoding.pm#6 integrate
... //depot/maint-5.8/perl/ext/Encode/t/Mod_EUCJP.pm#1 branch
... //depot/maint-5.8/perl/ext/Encode/t/enc_eucjp.t#5 integrate
... //depot/maint-5.8/perl/ext/Encode/t/enc_module.enc#1 branch
... //depot/maint-5.8/perl/ext/Encode/t/enc_module.t#1 branch
... //depot/maint-5.8/perl/ext/Encode/t/enc_utf8.t#4 integrate
... //depot/maint-5.8/perl/ext/Encode/ucm/viscii.ucm#3 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/Changes#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/Normalize.pm#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/Normalize.xs#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/README#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/mkheader#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/t/func.t#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/t/norm.t#2 integrate
... //depot/maint-5.8/perl/ext/Unicode/Normalize/t/test.t#2 integrate
... //depot/maint-5.8/perl/lib/Net/ChangeLog.libnet#2 integrate
... //depot/maint-5.8/perl/lib/Net/Cmd.pm#2 integrate
... //depot/maint-5.8/perl/lib/Net/FTP.pm#2 integrate
... //depot/maint-5.8/perl/lib/Net/POP3.pm#2 integrate
... //depot/maint-5.8/perl/lib/Net/SMTP.pm#2 integrate
... //depot/maint-5.8/perl/op.c#15 integrate
... //depot/maint-5.8/perl/pod/perlrun.pod#12 integrate
... //depot/maint-5.8/perl/sv.c#31 integrate
... //depot/maint-5.8/perl/t/io/utf8.t#2 integrate
... //depot/maint-5.8/perl/t/uni/write.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#29 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#28~18804~ Sun Mar 2 08:22:35 2003
+++ perl/MANIFEST Mon Mar 3 21:39:18 2003
@@ -251,6 +251,7 @@
ext/Encode/Symbol/Makefile.PL Encode extension
ext/Encode/Symbol/Symbol.pm Encode extension
ext/Encode/t/Aliases.t test script
+ext/Encode/t/Mod_EUCJP.pm module that t/enc_module.enc uses
ext/Encode/t/at-cn.t test script
ext/Encode/t/at-tw.t test script
ext/Encode/t/big5-eten.enc test data
@@ -261,6 +262,8 @@
ext/Encode/t/Encode.t test script
ext/Encode/t/Encoder.t test script
ext/Encode/t/enc_eucjp.t test script
+ext/Encode/t/enc_module.enc test data for t/enc_module.t
+ext/Encode/t/enc_module.t test script
ext/Encode/t/enc_utf8.t test script
ext/Encode/t/encoding.t test script
ext/Encode/t/fallback.t test script
==== //depot/maint-5.8/perl/ext/Encode/AUTHORS#6 (text) ====
Index: perl/ext/Encode/AUTHORS
--- perl/ext/Encode/AUTHORS#5~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/AUTHORS Mon Mar 3 21:39:18 2003
@@ -36,6 +36,7 @@
Philip Newton <[EMAIL PROTECTED]>
Robin Barker <[EMAIL PROTECTED]>
SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
+SUGAWARA Hajime <[EMAIL PROTECTED]>
SUZUKI Norio <[EMAIL PROTECTED]>
Spider Boardman <[EMAIL PROTECTED]>
Tatsuhiko Miyagawa <[EMAIL PROTECTED]>
==== //depot/maint-5.8/perl/ext/Encode/Changes#8 (text) ====
Index: perl/ext/Encode/Changes
--- perl/ext/Encode/Changes#7~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/Changes Mon Mar 3 21:39:18 2003
@@ -1,8 +1,23 @@
# Revision history for Perl extension Encode.
#
-# $Id: Changes,v 1.88 2003/02/20 14:42:34 dankogai Exp dankogai $
+# $Id: Changes,v 1.89 2003/02/28 01:40:27 dankogai Exp dankogai $
#
-$Revision: 1.88 $ $Date: 2003/02/20 14:42:34 $
+$Revision: 1.89 $ $Date: 2003/02/28 01:40:27 $
+! Encode.xs
+ signed vs. unsigned issue discovered by Craig on OpenVM
+ Message-Id: <[EMAIL PROTECTED]>
+! encoding.pm AUTHORS
++ t/Mod_EUCJP.pm t/enc_module.enc t/enc_module.t
+ Because binmode() stacks layers instead of overwrite, you have to
+ ":raw :encoding()" in encoding.pm or your are in trouble when you
+ call encoding.pm multiple times. There are several workarounds
+ but Inaba-san's idea is in. SUGAWARA Hajime <[EMAIL PROTECTED]>,
+ who was the first to address this problem was added to AUTHORS.
+ The test suites was added for this, which is a modified version
+ of SUGAWARA-san's scripts
+ Message-Id: <[EMAIL PROTECTED]>
+
+1.88 2003/02/20 14:42:34
! Encode.xs
one signedness nit for Encode by jhi
<[EMAIL PROTECTED]>
==== //depot/maint-5.8/perl/ext/Encode/Encode.pm#8 (text) ====
Index: perl/ext/Encode/Encode.pm
--- perl/ext/Encode/Encode.pm#7~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/Encode.pm Mon Mar 3 21:39:18 2003
@@ -1,9 +1,9 @@
#
-# $Id: Encode.pm,v 1.88 2003/02/20 14:36:25 dankogai Exp $
+# $Id: Encode.pm,v 1.89 2003/02/28 01:36:02 dankogai Exp $
#
package Encode;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.88 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.89 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
our $DEBUG = 0;
use XSLoader ();
XSLoader::load(__PACKAGE__, $VERSION);
==== //depot/maint-5.8/perl/ext/Encode/Encode.xs#7 (text) ====
Index: perl/ext/Encode/Encode.xs
--- perl/ext/Encode/Encode.xs#6~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/Encode.xs Mon Mar 3 21:39:18 2003
@@ -1,5 +1,5 @@
/*
- $Id: Encode.xs,v 1.54 2003/02/20 14:42:34 dankogai Exp dankogai $
+ $Id: Encode.xs,v 1.55 2003/02/28 01:40:27 dankogai Exp dankogai $
*/
#define PERL_NO_GET_CONTEXT
@@ -78,11 +78,15 @@
if (offset) {
s += *offset;
- slen -= *offset;
+ if (slen > *offset){ /* safeguard against slen overflow */
+ slen -= *offset;
+ }else{
+ slen = 0;
+ }
tlen = slen;
}
- if (slen <= 0){
+ if (slen == 0){
SvCUR_set(dst, 0);
SvPOK_only(dst);
goto ENCODE_END;
==== //depot/maint-5.8/perl/ext/Encode/MANIFEST#6 (text) ====
Index: perl/ext/Encode/MANIFEST
--- perl/ext/Encode/MANIFEST#5~18567~ Wed Jan 22 10:37:55 2003
+++ perl/ext/Encode/MANIFEST Mon Mar 3 21:39:18 2003
@@ -54,6 +54,7 @@
t/CJKT.t test script
t/Encode.t test script
t/Encoder.t test script
+t/Mod_EUCJP.pm module that t/enc_module.enc uses
t/Unicode.t test script
t/at-cn.t test script
t/at-tw.t test script
@@ -62,6 +63,8 @@
t/big5-hkscs.enc test data
t/big5-hkscs.utf test data
t/enc_eucjp.t test script
+t/enc_module.enc test data for t/enc_module.t
+t/enc_module.t test script
t/enc_utf8.t test script
t/encoding.t test script
t/fallback.t test script
==== //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.xs#6 (text) ====
Index: perl/ext/Encode/Unicode/Unicode.xs
--- perl/ext/Encode/Unicode/Unicode.xs#5~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/Unicode/Unicode.xs Mon Mar 3 21:39:18 2003
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 1.7 2003/02/20 14:42:34 dankogai Exp dankogai $
+ $Id: Unicode.xs,v 1.7 2003/02/20 14:42:34 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
==== //depot/maint-5.8/perl/ext/Encode/encoding.pm#6 (text) ====
Index: perl/ext/Encode/encoding.pm
--- perl/ext/Encode/encoding.pm#5~18665~ Thu Feb 6 01:34:12 2003
+++ perl/ext/Encode/encoding.pm Mon Mar 3 21:39:18 2003
@@ -1,5 +1,5 @@
package encoding;
-our $VERSION = do { my @r = (q$Revision: 1.41 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.42 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
use Encode;
use strict;
@@ -62,19 +62,19 @@
$status ;
});
};
- } $DEBUG and warn "Filter installed";
+ } $DEBUG and warn "Filter installed";
for my $h (qw(STDIN STDOUT)){
if ($arg{$h}){
unless (defined find_encoding($arg{$h})) {
require Carp;
Carp::croak("Unknown encoding for $h, '$arg{$h}'");
}
- eval { binmode($h, ":encoding($arg{$h})") };
+ eval { binmode($h, ":raw :encoding($arg{$h})") };
}else{
unless (exists $arg{$h}){
eval {
no warnings 'uninitialized';
- binmode($h, ":encoding($name)");
+ binmode($h, ":raw :encoding($name)");
};
}
}
@@ -93,8 +93,8 @@
binmode(STDIN, ":raw");
binmode(STDOUT, ":raw");
}else{
- binmode(STDIN);
- binmode(STDOUT);
+ binmode(STDIN);
+ binmode(STDOUT);
}
if ($INC{"Filter/Util/Call.pm"}){
eval { filter_del() };
==== //depot/maint-5.8/perl/ext/Encode/t/Mod_EUCJP.pm#1 (text) ====
Index: perl/ext/Encode/t/Mod_EUCJP.pm
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/ext/Encode/t/Mod_EUCJP.pm Mon Mar 3 21:39:18 2003
@@ -0,0 +1,22 @@
+# $Id: Mod_EUCJP.pm,v 1.1 2003/02/28 01:40:27 dankogai Exp dankogai $
+# This file is in euc-jp
+package Mod_EUCJP;
+use encoding "euc-jp";
+sub new {
+ my $class = shift;
+ my $str = shift || qw/���ʸ����/;
+ my $self = bless {
+ str => '',
+ }, $class;
+ $self->set($str);
+ $self;
+}
+sub set {
+ my ($self,$str) = @_;
+ $self->{str} = $str;
+ $self;
+}
+sub str { shift->{str}; }
+sub put { print shift->{str}; }
+1;
+__END__
==== //depot/maint-5.8/perl/ext/Encode/t/enc_eucjp.t#5 (text) ====
Index: perl/ext/Encode/t/enc_eucjp.t
--- perl/ext/Encode/t/enc_eucjp.t#4~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/t/enc_eucjp.t Mon Mar 3 21:39:18 2003
@@ -1,4 +1,4 @@
-# $Id: enc_eucjp.t,v 1.3 2003/02/20 14:42:34 dankogai Exp dankogai $
+# $Id: enc_eucjp.t,v 1.3 2003/02/20 14:42:34 dankogai Exp $
# This is the twin of enc_utf8.t .
BEGIN {
==== //depot/maint-5.8/perl/ext/Encode/t/enc_module.enc#1 (text) ====
Index: perl/ext/Encode/t/enc_module.enc
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/ext/Encode/t/enc_module.enc Mon Mar 3 21:39:18 2003
@@ -0,0 +1,2 @@
+���ʸ����
+�ƥ���ʸ����
==== //depot/maint-5.8/perl/ext/Encode/t/enc_module.t#1 (text) ====
Index: perl/ext/Encode/t/enc_module.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/ext/Encode/t/enc_module.t Mon Mar 3 21:39:18 2003
@@ -0,0 +1,56 @@
+# $Id: enc_module.t,v 1.1 2003/02/28 01:40:27 dankogai Exp dankogai $
+# This file is in euc-jp
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bEncode\b/) {
+ print "1..0 # Skip: Encode was not built\n";
+ exit 0;
+ }
+ unless (find PerlIO::Layer 'perlio') {
+ print "1..0 # Skip: PerlIO was not built\n";
+ exit 0;
+ }
+ if (ord("A") == 193) {
+ print "1..0 # encoding pragma does not support EBCDIC platforms\n";
+ exit(0);
+ }
+}
+use lib 't';
+use lib qw(ext/Encode/t ../ext/Encode/t); # in case of perl core
+use Mod_EUCJP;
+use encoding "euc-jp";
+use Test::More tests => 3;
+use File::Basename;
+use File::Spec;
+use File::Compare qw(compare_text);
+
+my $dir = dirname(__FILE__);
+my $file0 = File::Spec->catfile($dir,"enc_module.enc");
+my $file1 = File::Spec->catfile($dir,"$$.enc");
+
+my $obj = Mod_EUCJP->new;
+# Isn't this dangerous in that we lose all possible warnings?
+# Maybe a scoped use warnings 'something' instead? --jhi
+local $SIG{__WARN__} = sub{}; # to silence reopening STD(IN|OUT) w/o closing
+
+open STDOUT, ">", $file1 or die "$file1:$!";
+print $obj->str, "\n";
+$obj->set("�ƥ���ʸ����");
+print $obj->str, "\n";
+close STDOUT;
+
+my $cmp = compare_text($file0, $file1);
+is($cmp, 0, "encoding vs. STDOUT");
+unlink $file1 unless $cmp;
+
+my @cmp = qw/���ʸ���� �ƥ���ʸ����/;
+open STDIN, "<", $file0 or die "$file0:$!";
+$obj = Mod_EUCJP->new;
+my $i = 0;
+while(<STDIN>){
+ chomp;
+ is ($cmp[$i++], $_, "encoding vs. STDIN - $i");
+}
+
+__END__
+
==== //depot/maint-5.8/perl/ext/Encode/t/enc_utf8.t#4 (text) ====
Index: perl/ext/Encode/t/enc_utf8.t
--- perl/ext/Encode/t/enc_utf8.t#3~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/t/enc_utf8.t Mon Mar 3 21:39:18 2003
@@ -1,4 +1,4 @@
-# $Id: enc_utf8.t,v 1.3 2003/02/20 14:42:34 dankogai Exp dankogai $
+# $Id: enc_utf8.t,v 1.3 2003/02/20 14:42:34 dankogai Exp $
# This is the twin of enc_eucjp.t .
BEGIN {
==== //depot/maint-5.8/perl/ext/Encode/ucm/viscii.ucm#3 (text) ====
Index: perl/ext/Encode/ucm/viscii.ucm
--- perl/ext/Encode/ucm/viscii.ucm#2~18783~ Wed Feb 26 11:39:59 2003
+++ perl/ext/Encode/ucm/viscii.ucm Mon Mar 3 21:39:18 2003
@@ -1,7 +1,7 @@
#
-# $Id: viscii.ucm,v 1.1 2003/02/20 14:42:34 dankogai Exp dankogai $
+# $Id: viscii.ucm,v 1.1 2003/02/20 14:42:34 dankogai Exp $
#
-# Written $Id: viscii.ucm,v 1.1 2003/02/20 14:42:34 dankogai Exp dankogai $
+# Written $Id: viscii.ucm,v 1.1 2003/02/20 14:42:34 dankogai Exp $
# ./compile -n viscii -o Encode/viscii.ucm Encode/viscii.enc
<code_set_name> "viscii"
<mb_cur_min> 1
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/Changes#2 (text) ====
Index: perl/ext/Unicode/Normalize/Changes
--- perl/ext/Unicode/Normalize/Changes#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/Changes Mon Mar 3 21:39:18 2003
@@ -1,5 +1,12 @@
Revision history for Perl extension Unicode::Normalize.
+0.20 Sun Mar 02 13:29:25 2003
+ - decompose Hangul syllables in a decomposition mapping.
+
+0.18 ... unreleased
+ - synchronization with bleadperl.
+ - Change 16262: by me
+
0.17 Sun Apr 28 23:13:32 2002
- now normalize('NFC',$1) should work.
- Some croak()'s are added in mkheader.
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/Normalize.pm#2 (text) ====
Index: perl/ext/Unicode/Normalize/Normalize.pm
--- perl/ext/Unicode/Normalize/Normalize.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/Normalize.pm Mon Mar 3 21:39:18 2003
@@ -11,7 +11,7 @@
use warnings;
use Carp;
-our $VERSION = '0.17';
+our $VERSION = '0.20';
our $PACKAGE = __PACKAGE__;
require Exporter;
@@ -173,7 +173,7 @@
=head2 Quick Check
-(see Annex 8, UAX #15; F<DerivedNormalizationProps.txt>)
+(see Annex 8, UAX #15, and F<DerivedNormalizationProps.txt>)
The following functions check whether the string is in that normalization form.
@@ -275,7 +275,7 @@
Returns a boolean whether the character of the specified codepoint is
a singleton.
-=item C<$is_non_startar_decomposition = isNonStDecomp($codepoint)>
+=item C<$is_non_starter_decomposition = isNonStDecomp($codepoint)>
Returns a boolean whether the canonical decomposition
of the character of the specified codepoint
@@ -302,10 +302,10 @@
http://homepage1.nifty.com/nomenclator/perl/
- Copyright(C) 2001-2002, SADAHIRO Tomoyuki. Japan. All rights reserved.
+ Copyright(C) 2001-2003, SADAHIRO Tomoyuki. Japan. All rights reserved.
- This program is free software; you can redistribute it and/or
- modify it under the same terms as Perl itself.
+ This module is free software; you can redistribute it
+ and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/Normalize.xs#2 (text) ====
Index: perl/ext/Unicode/Normalize/Normalize.xs
--- perl/ext/Unicode/Normalize/Normalize.xs#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/Normalize.xs Mon Mar 3 21:39:18 2003
@@ -13,12 +13,12 @@
/* Perl 5.6.1 ? */
#ifndef uvuni_to_utf8
#define uvuni_to_utf8 uv_to_utf8
-#endif /* uvuni_to_utf8 */
+#endif /* uvuni_to_utf8 */
/* Perl 5.6.1 ? */
#ifndef utf8n_to_uvuni
#define utf8n_to_uvuni utf8_to_uv
-#endif /* utf8n_to_uvuni */
+#endif /* utf8n_to_uvuni */
/* At present, char > 0x10ffff are unaffected without complaint, right? */
#define VALID_UTF_MAX (0x10ffff)
@@ -58,13 +58,15 @@
STRLEN pos; /* position */
} UNF_cc;
-int compare_cc(const void *a, const void *b)
+int compare_cc (const void *a, const void *b)
{
int ret_cc;
- ret_cc = (*(UNF_cc*)a).cc - (*(UNF_cc*)b).cc;
+ ret_cc = ((UNF_cc*) a)->cc - ((UNF_cc*) b)->cc;
if (ret_cc)
return ret_cc;
- return (*(UNF_cc*)a).pos - (*(UNF_cc*)b).pos;
+
+ return ( ((UNF_cc*) a)->pos > ((UNF_cc*) b)->pos )
+ - ( ((UNF_cc*) a)->pos < ((UNF_cc*) b)->pos );
}
U8* dec_canonical (UV uv)
@@ -460,13 +462,10 @@
isMAYBE = TRUE;
else if (ix) {
char *canon, *compat;
- /*
- * NFKC_NO when having compatibility mapping;
- * i.e. dec_compat(uv) defined & different with dec_canonical(uv).
- */
+ /* NFKC_NO when having compatibility mapping. */
canon = (char *) dec_canonical(uv);
compat = (char *) dec_compat(uv);
- if (compat && (!canon || strNE(canon, compat)))
+ if (compat && !(canon && strEQ(canon, compat)))
XSRETURN_NO;
} /* end of get NFC/NFKC property */
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/README#2 (text) ====
Index: perl/ext/Unicode/Normalize/README
--- perl/ext/Unicode/Normalize/README#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/README Mon Mar 3 21:39:18 2003
@@ -1,4 +1,4 @@
-Unicode/Normalize version 0.17
+Unicode/Normalize version 0.20
===================================
Unicode::Normalize - Unicode Normalization Forms
@@ -12,10 +12,8 @@
$NFKD_string = NFKD($string); # Normalization Form KD
$NFKC_string = NFKC($string); # Normalization Form KC
-
or
-
use Unicode::Normalize 'normalize';
$NFD_string = normalize('D', $string); # Normalization Form D
@@ -70,13 +68,13 @@
(1) In the perl-current, unicore/CompExcl.txt
is renamed unicore/CompositionExclusions.txt.
-(2) When these unicore/*.* files are updated;
+(2) After these unicore/*.* files are updated.
- in the case of an XS version:
+ In the case of an XS version:
You must rebuild the module,
as the data will be compiled on building.
- in the case of a NoXS version:
+ In the case of a NoXS version:
Rebuilding is not necessary,
as the data will be read on requirement.
@@ -88,7 +86,7 @@
http://homepage1.nifty.com/nomenclator/perl/
- Copyright(C) 2001-2002, SADAHIRO Tomoyuki. Japan. All rights reserved.
+ Copyright(C) 2001-2003, SADAHIRO Tomoyuki. Japan. All rights reserved.
- This program is free software; you can redistribute it and/or
- modify it under the same terms as Perl itself.
+ This module is free software; you can redistribute it
+ and/or modify it under the same terms as Perl itself.
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/mkheader#2 (text) ====
Index: perl/ext/Unicode/Normalize/mkheader
--- perl/ext/Unicode/Normalize/mkheader#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/mkheader Mon Mar 3 21:39:18 2003
@@ -13,6 +13,9 @@
use strict;
use warnings;
use Carp;
+use File::Spec;
+
+our $IsEBCDIC = ord("A") != 0x41;
our $PACKAGE = 'Unicode::Normalize, mkheader';
@@ -25,8 +28,9 @@
|| croak "$PACKAGE: Decomposition.pl not found";
our %Combin; # $codepoint => $number : combination class
-our %Canon; # $codepoint => $hexstring : canonical decomp.
-our %Compat; # $codepoint => $hexstring : compat. decomp.
+our %Canon; # $codepoint => [EMAIL PROTECTED] : canonical decomp.
+our %Compat; # $codepoint => [EMAIL PROTECTED] : compat. decomp.
+# after _U_stringify(), ($codepoint => $hexstring) for %Canon and %Compat
our %Exclus; # $codepoint => 1 : composition exclusions
our %Single; # $codepoint => 1 : singletons
our %NonStD; # $codepoint => 1 : non-starter decompositions
@@ -38,10 +42,39 @@
our $prefix = "UNF_";
our $structname = "${prefix}complist";
+########## definition of Hangul constants ##########
+use constant SBase => 0xAC00;
+use constant SFinal => 0xD7A3; # SBase -1 + SCount
+use constant SCount => 11172; # LCount * NCount
+use constant NCount => 588; # VCount * TCount
+use constant LBase => 0x1100;
+use constant LFinal => 0x1112;
+use constant LCount => 19;
+use constant VBase => 0x1161;
+use constant VFinal => 0x1175;
+use constant VCount => 21;
+use constant TBase => 0x11A7;
+use constant TFinal => 0x11C2;
+use constant TCount => 28;
+
+sub decomposeHangul {
+ my $SIndex = $_[0] - SBase;
+ my $LIndex = int( $SIndex / NCount);
+ my $VIndex = int(($SIndex % NCount) / TCount);
+ my $TIndex = $SIndex % TCount;
+ my @ret = (
+ LBase + $LIndex,
+ VBase + $VIndex,
+ $TIndex ? (TBase + $TIndex) : (),
+ );
+ wantarray ? @ret : pack('U*', @ret);
+ # any element in @ret greater than 0xFF, so no need of u2n conversion.
+}
+
+########## getting full decomposion ##########
{
my($f, $fh);
foreach my $d (@INC) {
- use File::Spec;
$f = File::Spec->catfile($d, "unicore", "CompositionExclusions.txt");
last if open($fh, $f);
$f = File::Spec->catfile($d, "unicode", "CompExcl.txt");
@@ -136,14 +169,20 @@
sub getCanonList {
my @src = @_;
- my @dec = map $Canon{$_} ? @{ $Canon{$_} } : $_, @src;
+ my @dec = map {
+ (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
+ : $Canon{$_} ? @{ $Canon{$_} } : $_
+ } @src;
return join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
# condition @src == @dec is not ok.
}
sub getCompatList {
my @src = @_;
- my @dec = map $Compat{$_} ? @{ $Compat{$_} } : $_, @src;
+ my @dec = map {
+ (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
+ : $Compat{$_} ? @{ $Compat{$_} } : $_
+ } @src;
return join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
# condition @src == @dec is not ok.
}
@@ -160,10 +199,11 @@
sub _U_stringify {
sprintf '"%s"', join '',
- map sprintf("\\x%02x", $_), unpack 'C*', pack 'U*', @_;
+ map sprintf("\\x%02x", $_), unpack 'C*',
+ $IsEBCDIC
+ ? pack('U*', map utf8::unicode_to_native($_), @_)
+ : pack('U*', @_);
}
-# Do we need say <pack 'U*', map utf8::unicode_to_native($_),>
-# instead of <pack 'U*',> for EBCDIC?
foreach my $hash (\%Canon, \%Compat) {
foreach my $key (keys %$hash) {
@@ -171,7 +211,7 @@
}
}
-####################################
+########## writing header files ##########
my @boolfunc = (
{
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/t/func.t#2 (text) ====
Index: perl/ext/Unicode/Normalize/t/func.t
--- perl/ext/Unicode/Normalize/t/func.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/t/func.t Mon Mar 3 21:39:18 2003
@@ -1,5 +1,3 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
BEGIN {
if (ord("A") == 193) {
@@ -8,6 +6,13 @@
}
}
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
#########################
use Test;
@@ -17,6 +22,20 @@
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);
+}
+
#########################
print getCombinClass( 0) == 0
@@ -27,32 +46,32 @@
print ! defined getCanon( 0)
&& ! defined getCanon(41)
- && getCanon(0x00C0) eq pack('U*', 0x0041, 0x0300)
- && getCanon(0x00EF) eq pack('U*', 0x0069, 0x0308)
- && getCanon(0x304C) eq pack('U*', 0x304B, 0x3099)
- && getCanon(0x1EA4) eq pack('U*', 0x0041, 0x0302, 0x0301)
+ && getCanon(0x00C0) eq _pack_U(0x0041, 0x0300)
+ && 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(0x1FAF) eq pack('U*', 0x03A9, 0x0314, 0x0342, 0x0345)
- && getCanon(0xAC00) eq pack('U*', 0x1100, 0x1161)
- && getCanon(0xAE00) eq pack('U*', 0x1100, 0x1173, 0x11AF)
+ && getCanon(0x1FAF) eq _pack_U(0x03A9, 0x0314, 0x0342, 0x0345)
+ && getCanon(0xAC00) eq _pack_U(0x1100, 0x1161)
+ && getCanon(0xAE00) eq _pack_U(0x1100, 0x1173, 0x11AF)
&& ! defined getCanon(0x212C)
&& ! defined getCanon(0x3243)
- && getCanon(0xFA2D) eq pack('U*', 0x9DB4)
+ && getCanon(0xFA2D) eq _pack_U(0x9DB4)
? "ok" : "not ok", " 3\n";
print ! defined getCompat( 0)
&& ! defined getCompat(41)
- && getCompat(0x00C0) eq pack('U*', 0x0041, 0x0300)
- && getCompat(0x00EF) eq pack('U*', 0x0069, 0x0308)
- && getCompat(0x304C) eq pack('U*', 0x304B, 0x3099)
- && getCompat(0x1EA4) eq pack('U*', 0x0041, 0x0302, 0x0301)
- && getCompat(0x1F82) eq pack('U*', 0x03B1, 0x0313, 0x0300, 0x0345)
- && getCompat(0x1FAF) eq pack('U*', 0x03A9, 0x0314, 0x0342, 0x0345)
- && getCompat(0x212C) eq pack('U*', 0x0042)
- && getCompat(0x3243) eq pack('U*', 0x0028, 0x81F3, 0x0029)
- && getCompat(0xAC00) eq pack('U*', 0x1100, 0x1161)
- && getCompat(0xAE00) eq pack('U*', 0x1100, 0x1173, 0x11AF)
- && getCompat(0xFA2D) eq pack('U*', 0x9DB4)
+ && getCompat(0x00C0) eq _pack_U(0x0041, 0x0300)
+ && getCompat(0x00EF) eq _pack_U(0x0069, 0x0308)
+ && getCompat(0x304C) eq _pack_U(0x304B, 0x3099)
+ && getCompat(0x1EA4) eq _pack_U(0x0041, 0x0302, 0x0301)
+ && getCompat(0x1F82) eq _pack_U(0x03B1, 0x0313, 0x0300, 0x0345)
+ && getCompat(0x1FAF) eq _pack_U(0x03A9, 0x0314, 0x0342, 0x0345)
+ && getCompat(0x212C) eq _pack_U(0x0042)
+ && getCompat(0x3243) eq _pack_U(0x0028, 0x81F3, 0x0029)
+ && getCompat(0xAC00) eq _pack_U(0x1100, 0x1161)
+ && getCompat(0xAE00) eq _pack_U(0x1100, 0x1173, 0x11AF)
+ && getCompat(0xFA2D) eq _pack_U(0x9DB4)
? "ok" : "not ok", " 4\n";
print ! defined getComposite( 0, 0)
@@ -85,11 +104,11 @@
? "ok" : "not ok", " 7\n";
print reorder("") eq ""
- && reorder(pack("U*", 0x0041, 0x0300, 0x0315, 0x0313, 0x031b, 0x0061))
- eq pack("U*", 0x0041, 0x031b, 0x0300, 0x0313, 0x0315, 0x0061)
- && reorder(pack("U*", 0x00C1, 0x0300, 0x0315, 0x0313, 0x031b,
+ && reorder(_pack_U(0x0041, 0x0300, 0x0315, 0x0313, 0x031b, 0x0061))
+ eq _pack_U(0x0041, 0x031b, 0x0300, 0x0313, 0x0315, 0x0061)
+ && reorder(_pack_U(0x00C1, 0x0300, 0x0315, 0x0313, 0x031b,
0x0061, 0x309A, 0x3099))
- eq pack("U*", 0x00C1, 0x031b, 0x0300, 0x0313, 0x0315,
+ eq _pack_U(0x00C1, 0x031b, 0x0300, 0x0313, 0x0315,
0x0061, 0x309A, 0x3099)
? "ok" : "not ok", " 8\n";
@@ -115,15 +134,15 @@
? "ok" : "not ok", " 9\n";
print 1
- && answer(checkNFD(NFD(pack('U*', 0xC1, 0x1100, 0x1173, 0x11AF)))) eq "YES"
- && answer(checkNFD(pack('U*', 0x20, 0xC1, 0x1100, 0x1173, 0x11AF))) eq "NO"
- && answer(checkNFC(pack('U*', 0x20, 0xC1, 0x1173, 0x11AF))) eq "MAYBE"
- && answer(checkNFC(pack('U*', 0x20, 0xC1, 0xAE00, 0x1100))) eq "YES"
- && answer(checkNFC(pack('U*', 0x20, 0xC1, 0xAE00, 0x1100, 0x300))) eq "MAYBE"
- && answer(checkNFC(pack('U*', 0x20, 0xC1, 0xFF71, 0x2025))) eq "YES"
- && answer(check("NFC", pack('U*', 0x20, 0xC1, 0x212B, 0x300))) eq "NO"
- && answer(checkNFKD(pack('U*', 0x20, 0xC1, 0xFF71, 0x2025))) eq "NO"
- && answer(checkNFKC(pack('U*', 0x20, 0xC1, 0xAE00, 0x2025))) eq "NO"
+ && answer(checkNFD(NFD(_pack_U(0xC1, 0x1100, 0x1173, 0x11AF)))) eq "YES"
+ && answer(checkNFD(_pack_U(0x20, 0xC1, 0x1100, 0x1173, 0x11AF))) eq "NO"
+ && answer(checkNFC(_pack_U(0x20, 0xC1, 0x1173, 0x11AF))) eq "MAYBE"
+ && answer(checkNFC(_pack_U(0x20, 0xC1, 0xAE00, 0x1100))) eq "YES"
+ && answer(checkNFC(_pack_U(0x20, 0xC1, 0xAE00, 0x1100, 0x300))) eq "MAYBE"
+ && answer(checkNFC(_pack_U(0x20, 0xC1, 0xFF71, 0x2025))) eq "YES"
+ && answer(check("NFC", _pack_U(0x20, 0xC1, 0x212B, 0x300))) eq "NO"
+ && answer(checkNFKD(_pack_U(0x20, 0xC1, 0xFF71, 0x2025))) eq "NO"
+ && answer(checkNFKC(_pack_U(0x20, 0xC1, 0xAE00, 0x2025))) eq "NO"
? "ok" : "not ok", " 10\n";
"012ABC" =~ /(\d+)(\w+)/;
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/t/norm.t#2 (text) ====
Index: perl/ext/Unicode/Normalize/t/norm.t
--- perl/ext/Unicode/Normalize/t/norm.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/t/norm.t Mon Mar 3 21:39:18 2003
@@ -1,5 +1,3 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
BEGIN {
if (ord("A") == 193) {
@@ -8,6 +6,13 @@
}
}
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
#########################
use Test;
@@ -17,6 +22,20 @@
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);
+}
+
#########################
ok(normalize('C', ""), "");
@@ -24,11 +43,11 @@
sub hexNFC {
join " ", map sprintf("%04X", $_),
- unpack 'U*', normalize 'C', pack 'U*', map hex(), split ' ', shift;
+ _unpack_U normalize 'C', _pack_U map hex, split ' ', shift;
}
sub hexNFD {
join " ", map sprintf("%04X", $_),
- unpack 'U*', normalize 'NFD', pack 'U*', map hex(), split ' ', shift;
+ _unpack_U normalize 'D', _pack_U map hex, split ' ', shift;
}
ok(hexNFC("0061 0315 0300 05AE 05C4 0062"), "00E0 05AE 05C4 0315 0062");
==== //depot/maint-5.8/perl/ext/Unicode/Normalize/t/test.t#2 (text) ====
Index: perl/ext/Unicode/Normalize/t/test.t
--- perl/ext/Unicode/Normalize/t/test.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Unicode/Normalize/t/test.t Mon Mar 3 21:39:18 2003
@@ -1,5 +1,3 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
BEGIN {
if (ord("A") == 193) {
@@ -8,6 +6,13 @@
}
}
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
#########################
use Test;
@@ -17,6 +22,20 @@
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);
+}
+
#########################
ok(NFC(""), "");
@@ -24,11 +43,11 @@
sub hexNFC {
join " ", map sprintf("%04X", $_),
- unpack 'U*', NFC pack 'U*', map hex(), split ' ', shift;
+ _unpack_U NFC _pack_U map hex, split ' ', shift;
}
sub hexNFD {
join " ", map sprintf("%04X", $_),
- unpack 'U*', NFD pack 'U*', map hex(), split ' ', shift;
+ _unpack_U NFD _pack_U map hex, split ' ', shift;
}
ok(hexNFC("0061 0315 0300 05AE 05C4 0062"), "00E0 05AE 05C4 0315 0062");
@@ -49,10 +68,11 @@
ok(hexNFD("0000 0041 0000 0000"), "0000 0041 0000 0000");
# should be unary.
-my $str11 = pack('U*', 0x41, 0x0302, 0x0301, 0x62);
-my $str12 = pack('U*', 0x1EA4, 0x62);
+my $str11 = _pack_U(0x41, 0x0302, 0x0301, 0x62);
+my $str12 = _pack_U(0x1EA4, 0x62);
ok(NFC $str11 eq $str12);
-my $str21 = pack('U*', 0xE0, 0xAC00);
-my $str22 = pack('U*', 0x61, 0x0300, 0x1100, 0x1161);
+my $str21 = _pack_U(0xE0, 0xAC00);
+my $str22 = _pack_U(0x61, 0x0300, 0x1100, 0x1161);
ok(NFD $str21 eq $str22);
+
==== //depot/maint-5.8/perl/lib/Net/ChangeLog.libnet#2 (text) ====
Index: perl/lib/Net/ChangeLog.libnet
--- perl/lib/Net/ChangeLog.libnet#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Net/ChangeLog.libnet Mon Mar 3 21:39:18 2003
@@ -1,3 +1,47 @@
+Change 772 on 2003/03/03 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Release 1.13
+
+Change 755 on 2002/11/03 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Fix typo
+
+Change 749 on 2002/09/23 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::POP3
+ - Make more compilant. +OK and -ERR responses do not have to be followed
+ by a space.
+
+Change 748 on 2002/09/23 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::FTP
+ - Fix unique name extraction to pick up name on initial
+ response, not just the final response
+
+Change 737 on 2002/07/18 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::Cmd
+ - Compatability fix for 5.004
+
+Change 736 on 2002/07/16 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::Cmd
+ - Ensure all debug output is via ->debug_print
+
+Change 735 on 2002/07/15 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::FTP
+ - Allow the user to specify a local address to use for sockets
+
+Change 734 on 2002/07/15 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::SMTP
+ - Avoid extra spaces on the end of the AUTH command
+
+Change 728 on 2002/05/28 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Release 1.12
+
Change 727 on 2002/05/28 by <[EMAIL PROTECTED]> (Graham Barr)
Net::SMTP
==== //depot/maint-5.8/perl/lib/Net/Cmd.pm#2 (text) ====
Index: perl/lib/Net/Cmd.pm
--- perl/lib/Net/Cmd.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Net/Cmd.pm Mon Mar 3 21:39:18 2003
@@ -1,4 +1,4 @@
-# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#28 $
+# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#30 $
#
# Copyright (c) 1995-1997 Graham Barr <[EMAIL PROTECTED]>. All rights reserved.
# This program is free software; you can redistribute it and/or
@@ -21,7 +21,7 @@
}
}
-$VERSION = "2.21";
+$VERSION = "2.23";
@ISA = qw(Exporter);
@EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
@@ -73,7 +73,6 @@
my @do = ($pkg);
my %spc = ( $pkg , "");
- print STDERR "\n";
while ($pkg = shift @do)
{
next if defined $done{$pkg};
@@ -85,7 +84,7 @@
: "";
my $spc = $spc{$pkg};
- print STDERR "$cmd: ${spc}${pkg}${v}\n";
+ $cmd->debug_print(1,"${spc}${pkg}${v}\n");
if(@{"${pkg}::ISA"})
{
@@ -93,8 +92,6 @@
unshift(@do, @{"${pkg}::ISA"});
}
}
-
- print STDERR "\n";
}
sub debug
@@ -398,10 +395,10 @@
return 1
unless length($line);
- if($cmd->debug)
- {
- my $b = "$cmd>>> ";
- print STDERR $b,join("\n$b",split(/\n/,$line)),"\n";
+ if($cmd->debug) {
+ foreach my $b (split(/\n/,$line)) {
+ $cmd->debug_print(1, "$b\n");
+ }
}
# Translate LF => CRLF, but not if the LF is
@@ -457,17 +454,13 @@
if(${*$cmd}{'net_cmd_lastch'} eq "\015")
{
syswrite($cmd,"\012",1);
- print STDERR "\n"
- if($cmd->debug);
}
elsif(${*$cmd}{'net_cmd_lastch'} ne "\012")
{
syswrite($cmd,"\015\012",2);
- print STDERR "\n"
- if($cmd->debug);
}
- print STDERR "$cmd>>> .\n"
+ $cmd->debug_print(1, ".\n")
if($cmd->debug);
syswrite($cmd,".\015\012",3);
@@ -497,7 +490,7 @@
# end-of-file when the dot is encountered.
sub READ {
my $cmd = shift;
- my (undef,$len,$offset) = @_;
+ my ($len,$offset) = @_[1,2];
return unless exists ${*$cmd}{'net_cmd_readbuf'};
my $done = 0;
while (!$done and length(${*$cmd}{'net_cmd_readbuf'}) < $len) {
@@ -714,6 +707,6 @@
=for html <hr>
-I<$Id: //depot/libnet/Net/Cmd.pm#28 $>
+I<$Id: //depot/libnet/Net/Cmd.pm#30 $>
=cut
==== //depot/maint-5.8/perl/lib/Net/FTP.pm#2 (text) ====
Index: perl/lib/Net/FTP.pm
--- perl/lib/Net/FTP.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Net/FTP.pm Mon Mar 3 21:39:18 2003
@@ -22,7 +22,7 @@
use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
# use AutoLoader qw(AUTOLOAD);
-$VERSION = "2.65"; # $Id: //depot/libnet/Net/FTP.pm#68 $
+$VERSION = "2.67"; # $Id: //depot/libnet/Net/FTP.pm#70 $
@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
# Someday I will "use constant", when I am not bothered to much about
@@ -76,6 +76,7 @@
my $ftp = $pkg->SUPER::new(PeerAddr => $peer,
PeerPort => $arg{Port} || 'ftp(21)',
+ LocalAddr => $arg{'LocalAddr'},
Proto => 'tcp',
Timeout => defined $arg{Timeout}
? $arg{Timeout}
@@ -86,6 +87,8 @@
${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode
${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240);
+ ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'};
+
${*$ftp}{'net_ftp_firewall'} = $fire
if(defined $fire);
${*$ftp}{'net_ftp_firewall_type'} = $fire_type
@@ -714,6 +717,9 @@
$sock = $ftp->_data_cmd($cmd, $remote) or
return undef;
+ $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
+ if 'STOU' eq uc $cmd;
+
my $blksize = ${*$ftp}{'net_ftp_blksize'};
my($count,$hashh,$hashb,$ref) = (0);
@@ -908,6 +914,7 @@
$data = $pkg->new(PeerAddr => join(".",@port[0..3]),
PeerPort => $port[4] * 256 + $port[5],
+ LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
Proto => 'tcp'
);
}
@@ -1277,6 +1284,9 @@
are displayed for all transfers. You can, of course, call C<hash()>
explicitly whenever you'd like.
+B<LocalAddr> - Local address to use for all socket connections, this
+argument will be passed to L<IO::Socket::INET>
+
If the constructor fails undef will be returned and an error message will
be in $@
@@ -1710,6 +1720,6 @@
=for html <hr>
-I<$Id: //depot/libnet/Net/FTP.pm#68 $>
+I<$Id: //depot/libnet/Net/FTP.pm#70 $>
=cut
==== //depot/maint-5.8/perl/lib/Net/POP3.pm#2 (text) ====
Index: perl/lib/Net/POP3.pm
--- perl/lib/Net/POP3.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Net/POP3.pm Mon Mar 3 21:39:18 2003
@@ -13,7 +13,7 @@
use Carp;
use Net::Config;
-$VERSION = "2.23"; # $Id: //depot/libnet/Net/POP3.pm#22 $
+$VERSION = "2.24"; # $Id: //depot/libnet/Net/POP3.pm#23 $
@ISA = qw(Net::Cmd IO::Socket::INET);
@@ -342,13 +342,13 @@
$cmd->debug_print(0,$str)
if ($cmd->debug);
- if($str =~ s/^\+OK\s+//io)
+ if($str =~ s/^\+OK\s*//io)
{
$code = "200"
}
else
{
- $str =~ s/^-ERR\s+//io;
+ $str =~ s/^-ERR\s*//io;
}
${*$cmd}{'net_cmd_resp'} = [ $str ];
@@ -540,6 +540,6 @@
=for html <hr>
-I<$Id: //depot/libnet/Net/POP3.pm#22 $>
+I<$Id: //depot/libnet/Net/POP3.pm#23 $>
=cut
==== //depot/maint-5.8/perl/lib/Net/SMTP.pm#2 (text) ====
Index: perl/lib/Net/SMTP.pm
--- perl/lib/Net/SMTP.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Net/SMTP.pm Mon Mar 3 21:39:18 2003
@@ -16,7 +16,7 @@
use Net::Cmd;
use Net::Config;
-$VERSION = "2.24"; # $Id: //depot/libnet/Net/SMTP.pm#25 $
+$VERSION = "2.25"; # $Id: //depot/libnet/Net/SMTP.pm#26 $
@ISA = qw(Net::Cmd IO::Socket::INET);
@@ -126,9 +126,12 @@
# todo that we would really need to change the ISA hierarchy
# so we dont inherit from IO::Socket, but instead hold it in an attribute
- my @cmd = ("AUTH", $client->mechanism, MIME::Base64::encode_base64($str,''));
+ my @cmd = ("AUTH", $client->mechanism);
my $code;
+ push @cmd, MIME::Base64::encode_base64($str,'')
+ if defined $str and length $str;
+
while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
@cmd = (MIME::Base64::encode_base64(
$client->client_step(
@@ -670,6 +673,6 @@
=for html <hr>
-I<$Id: //depot/libnet/Net/SMTP.pm#25 $>
+I<$Id: //depot/libnet/Net/SMTP.pm#26 $>
=cut
==== //depot/maint-5.8/perl/op.c#15 (text) ====
Index: perl/op.c
--- perl/op.c#14~18804~ Sun Mar 2 08:22:35 2003
+++ perl/op.c Mon Mar 3 21:39:18 2003
@@ -375,6 +375,18 @@
case OP_CONST:
SvREFCNT_dec(cSVOPo->op_sv);
cSVOPo->op_sv = Nullsv;
+#ifdef USE_ITHREADS
+ /** Bug #15654
+ Even if op_clear does a pad_free for the target of the op,
+ pad_free doesn't actually remove the sv that exists in the bad
+ instead it lives on. This results in that it could be reused as
+ a target later on when the pad was reallocated.
+ **/
+ if(o->op_targ) {
+ pad_swipe(o->op_targ,1);
+ o->op_targ = 0;
+ }
+#endif
break;
case OP_GOTO:
case OP_NEXT:
==== //depot/maint-5.8/perl/pod/perlrun.pod#12 (text) ====
Index: perl/pod/perlrun.pod
--- perl/pod/perlrun.pod#11~18783~ Wed Feb 26 11:39:59 2003
+++ perl/pod/perlrun.pod Mon Mar 3 21:39:18 2003
@@ -1099,7 +1099,9 @@
=item PERL_UNICODE
-Equivalent to the B<-C> command-line switch.
+Equivalent to the B<-C> command-line switch. Note that this is not
+a boolean variable-- setting this to C<"1"> is not the right way to
+"enable Unicode" (whatever that would mean).
=item SYS$LOGIN (specific to the VMS port)
==== //depot/maint-5.8/perl/sv.c#31 (text) ====
Index: perl/sv.c
--- perl/sv.c#30~18815~ Sun Mar 2 21:43:25 2003
+++ perl/sv.c Mon Mar 3 21:39:18 2003
@@ -5973,7 +5973,27 @@
(void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
- SvPOK_only(sv); /* Validate pointer */
+
+ if (append) {
+ if (PerlIO_isutf8(fp)) {
+ if (!SvUTF8(sv)) {
+ sv_utf8_upgrade_nomg(sv);
+ sv_pos_u2b(sv,&append,0);
+ }
+ } else if (SvUTF8(sv)) {
+ SV *tsv = NEWSV(0,0);
+ sv_gets(tsv, fp, 0);
+ sv_utf8_upgrade_nomg(tsv);
+ SvCUR_set(sv,append);
+ sv_catsv(sv,tsv);
+ sv_free(tsv);
+ goto return_string_or_null;
+ }
+ }
+
+ SvPOK_only(sv);
+ if (PerlIO_isutf8(fp))
+ SvUTF8_on(sv);
if (PL_curcop == &PL_compiling) {
/* we always read code in line mode */
@@ -6016,7 +6036,7 @@
#endif
SvCUR_set(sv, bytesread += append);
buffer[bytesread] = '\0';
- goto check_utf8_and_return;
+ goto return_string_or_null;
}
else if (RsPARA(PL_rs)) {
rsptr = "\n\n";
@@ -6269,12 +6289,7 @@
}
}
-check_utf8_and_return:
- if (PerlIO_isutf8(fp))
- SvUTF8_on(sv);
- else
- SvUTF8_off(sv);
-
+return_string_or_null:
return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
}
==== //depot/maint-5.8/perl/t/io/utf8.t#2 (xtext) ====
Index: perl/t/io/utf8.t
--- perl/t/io/utf8.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/io/utf8.t Mon Mar 3 21:39:18 2003
@@ -12,7 +12,7 @@
no utf8; # needed for use utf8 not griping about the raw octets
$| = 1;
-print "1..31\n";
+print "1..49\n";
open(F,"+>:utf8",'a');
print F chr(0x100).'�';
@@ -271,6 +271,58 @@
close(F);
print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n";
+}
+
+{
+ open F, ">:bytes","a"; print F "\xde"; close F;
+
+ open F, "<:bytes", "a";
+ my $b = chr 0x100;
+ $b .= <F>;
+ print $b eq chr(0x100).chr(0xde) ? "ok 32" : "not ok 32";
+ print " \#21395 '.= <>' utf8 vs. bytes\n";
+ close F;
+}
+
+{
+ open F, ">:utf8","a"; print F chr 0x100; close F;
+
+ open F, "<:utf8", "a";
+ my $b = "\xde";
+ $b .= <F>;
+ print $b eq chr(0xde).chr(0x100) ? "ok 33" : "not ok 33";
+ print " \#21395 '.= <>' bytes vs. utf8\n";
+ close F;
+}
+
+{
+ my @a = ( [ 0x007F, "bytes" ],
+ [ 0x0080, "bytes" ],
+ [ 0x0080, "utf8" ],
+ [ 0x0100, "utf8" ] );
+ my $t = 34;
+ for my $u (@a) {
+ for my $v (@a) {
+ # print "# @$u - @$v\n";
+ open F, ">a";
+ binmode(F, ":" . $u->[1]);
+ print F chr($u->[0]);
+ close F;
+
+ open F, "<a";
+ binmode(F, ":" . $u->[1]);
+
+ my $s = chr($v->[0]);
+ utf8::upgrade($s) if $v->[1] eq "utf8";
+
+ $s .= <F>;
+ print $s eq chr($v->[0]) . chr($u->[0]) ?
+ "ok $t # rcatline utf8\n" : "not ok $t # rcatline utf8\n";
+ close F;
+ $t++;
+ }
+ }
+ # last test here 47
}
# sysread() and syswrite() tested in lib/open.t since Fnctl is used
==== //depot/maint-5.8/perl/t/uni/write.t#2 (text) ====
Index: perl/t/uni/write.t
--- perl/t/uni/write.t#1~18804~ Sun Mar 2 08:22:35 2003
+++ perl/t/uni/write.t Mon Mar 3 21:39:18 2003
@@ -5,6 +5,10 @@
chdir 't' if -d 't';
@INC = qw(../lib .);
require "test.pl";
+ unless (PerlIO::Layer->find('perlio')){
+ print "1..0 # Skip: PerlIO required\n";
+ exit 0;
+ }
}
plan tests => 6;
End of Patch.
