Change 20615 by [EMAIL PROTECTED] on 2003/08/11 12:23:17
Integrate:
[ 20611]
Typo fix from Boris Zentner.
[ 20612]
VC6 warning: result still unsigned.
[ 20614]
Allow via layer to affect the PERLIO_F_UTF8 flag.
Affected files ...
... //depot/maint-5.8/perl/ext/PerlIO/via/via.pm#3 integrate
... //depot/maint-5.8/perl/ext/PerlIO/via/via.xs#7 integrate
... //depot/maint-5.8/perl/pod/perlfaq5.pod#6 integrate
... //depot/maint-5.8/perl/regexec.c#26 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/PerlIO/via/via.pm#3 (text) ====
Index: perl/ext/PerlIO/via/via.pm
--- perl/ext/PerlIO/via/via.pm#2~18911~ Mon Mar 10 23:02:41 2003
+++ perl/ext/PerlIO/via/via.pm Mon Aug 11 05:23:17 2003
@@ -1,5 +1,5 @@
package PerlIO::via;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
use XSLoader ();
XSLoader::load 'PerlIO::via';
1;
@@ -57,7 +57,7 @@
It refers to the layer below. I<$fh> is not passed if the layer
is at the bottom of the stack, for this reason and to maintain
some level of "compatibility" with TIEHANDLE classes it is passed last.
-
+
=over 4
=item $class->PUSHED([$mode[,$fh]])
@@ -66,19 +66,33 @@
TIEHANDLE.) The arguments are an optional mode string ("r", "w",
"w+", ...) and a filehandle for the PerlIO layer below. Mandatory.
-When layer is pushed as part of an C<open> call, C<PUSHED> will be called
+When layer is pushed as part of an C<open> call, C<PUSHED> will be called
I<before> the actual open occurs whether than be via C<OPEN>, C<SYSOPEN>,
-C<FDOPEN> or by letting lower layer do the open.
+C<FDOPEN> or by letting lower layer do the open.
=item $obj->POPPED([$fh])
Optional - layer is about to be removed.
+=item $obj->UTF8($bellowFlag,[$fh])
+
+Optional - if present it will be called immediately after PUSHED has
+returned. It should return true value if the layer expects data to be
+UTF-8 encoded. If it returns true result is as if caller had done
+
+ ":via(YourClass):utf8"
+
+If not present of it it returns false, then stream is left with
+flag clear.
+The I<$bellowFlag> argument will be true if there is a layer below
+and that layer was expecting UTF-8.
+
+
=item $obj->OPEN($path,$mode[,$fh])
Optional - if not present lower layer does open.
If present called for normal opens after layer is pushed.
-This function is subject to change as there is no easy way
+This function is subject to change as there is no easy way
to get lower layer to do open and then regain control.
=item $obj->BINMODE([,$fh])
@@ -90,17 +104,17 @@
=item $obj->FDOPEN($fd[,$fh])
Optional - if not present lower layer does open.
-If present called for opens which pass a numeric file
-descriptor after layer is pushed.
-This function is subject to change as there is no easy way
+If present called for opens which pass a numeric file
+descriptor after layer is pushed.
+This function is subject to change as there is no easy way
to get lower layer to do open and then regain control.
=item $obj->SYSOPEN($path,$imode,$perm,[,$fh])
Optional - if not present lower layer does open.
-If present called for sysopen style opens which pass a numeric mode
+If present called for sysopen style opens which pass a numeric mode
and permissions after layer is pushed.
-This function is subject to change as there is no easy way
+This function is subject to change as there is no easy way
to get lower layer to do open and then regain control.
=item $obj->FILENO($fh)
==== //depot/maint-5.8/perl/ext/PerlIO/via/via.xs#7 (text) ====
Index: perl/ext/PerlIO/via/via.xs
--- perl/ext/PerlIO/via/via.xs#6~18665~ Thu Feb 6 01:34:12 2003
+++ perl/ext/PerlIO/via/via.xs Mon Aug 11 05:23:17 2003
@@ -35,6 +35,7 @@
CV *mERROR;
CV *mEOF;
CV *BINMODE;
+ CV *UTF8;
} PerlIOVia;
#define MYMethod(x) #x,&s->x
@@ -163,6 +164,15 @@
}
else {
goto push_failed;
+ }
+ modesv = (*PerlIONext(f) && (PerlIOBase(PerlIONext(f))->flags &
PERLIO_F_UTF8))
+ ? &PL_sv_yes : &PL_sv_no;
+ result = PerlIOVia_method(aTHX_ f, MYMethod(UTF8), G_SCALAR, modesv,
Nullsv);
+ if (result && SvTRUE(result)) {
+ PerlIOBase(f)->flags |= ~PERLIO_F_UTF8;
+ }
+ else {
+ PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
}
if (PerlIOVia_fetchmethod(aTHX_ s, MYMethod(FILL)) ==
(CV *) - 1)
==== //depot/maint-5.8/perl/pod/perlfaq5.pod#6 (text) ====
Index: perl/pod/perlfaq5.pod
--- perl/pod/perlfaq5.pod#5~18617~ Sat Feb 1 12:05:08 2003
+++ perl/pod/perlfaq5.pod Mon Aug 11 05:23:17 2003
@@ -549,7 +549,7 @@
atomic test-and-set instruction. In theory, this "ought" to work:
sysopen(FH, "file.lock", O_WRONLY|O_EXCL|O_CREAT)
- or die "can't open file.lock: $!":
+ or die "can't open file.lock: $!";
except that lamentably, file creation (and deletion) is not atomic
over NFS, so this won't work (at least, not every time) over the net.
==== //depot/maint-5.8/perl/regexec.c#26 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#25~20569~ Fri Aug 8 14:07:09 2003
+++ perl/regexec.c Mon Aug 11 05:23:17 2003
@@ -1043,7 +1043,7 @@
c1 = *(U8*)m;
c2 = PL_fold_locale[c1];
do_exactf:
- e = HOP3c(strend, -lnc, s);
+ e = HOP3c(strend, -((I32)lnc), s);
if (norun && e < s)
e = s; /* Due to minlen logic of intuit() */
End of Patch.