#define to_uni_title_lc Perl_to_uni_title_lc
#define to_uni_lower_lc Perl_to_uni_lower_lc
#define is_utf8_char Perl_is_utf8_char
+#define is_utf8_string Perl_is_utf8_string
#define is_utf8_alnum Perl_is_utf8_alnum
#define is_utf8_alnumc Perl_is_utf8_alnumc
#define is_utf8_idfirst Perl_is_utf8_idfirst
#define to_uni_title_lc(a) Perl_to_uni_title_lc(aTHX_ a)
#define to_uni_lower_lc(a) Perl_to_uni_lower_lc(aTHX_ a)
#define is_utf8_char(a) Perl_is_utf8_char(aTHX_ a)
+#define is_utf8_string(a,b) Perl_is_utf8_string(aTHX_ a,b)
#define is_utf8_alnum(a) Perl_is_utf8_alnum(aTHX_ a)
#define is_utf8_alnumc(a) Perl_is_utf8_alnumc(aTHX_ a)
#define is_utf8_idfirst(a) Perl_is_utf8_idfirst(aTHX_ a)
#define to_uni_lower_lc Perl_to_uni_lower_lc
#define Perl_is_utf8_char CPerlObj::Perl_is_utf8_char
#define is_utf8_char Perl_is_utf8_char
+#define Perl_is_utf8_string CPerlObj::Perl_is_utf8_string
+#define is_utf8_string Perl_is_utf8_string
#define Perl_is_utf8_alnum CPerlObj::Perl_is_utf8_alnum
#define is_utf8_alnum Perl_is_utf8_alnum
#define Perl_is_utf8_alnumc CPerlObj::Perl_is_utf8_alnumc
Ap |U32 |to_uni_title_lc|U32 c
Ap |U32 |to_uni_lower_lc|U32 c
Ap |int |is_utf8_char |U8 *p
+Ap |bool |is_utf8_string |U8 *s|STRLEN len
Ap |bool |is_utf8_alnum |U8 *p
Ap |bool |is_utf8_alnumc |U8 *p
Ap |bool |is_utf8_idfirst|U8 *p
Ap |I32 |utf8_distance |U8 *a|U8 *b
Ap |U8* |utf8_hop |U8 *s|I32 off
Ap |U8* |utf8_to_bytes |U8 *s|STRLEN len
-Ap |U8* |bytes_to_utf8 |U8 *s|STRLEN len
+Ap |U8* |bytes_to_utf8 |U8 *s|STRLEN *len
Ap |UV |utf8_to_uv |U8 *s|I32* retlen
Ap |U8* |uv_to_utf8 |U8 *d|UV uv
p |void |vivify_defelem |SV* sv
# feast like to keep their secret; for wonder makes the words of
# praise louder.'
-# (Quote from Tolkien sugested by Anno Siegel.)
+# (Quote from Tolkien suggested by Anno Siegel.)
#
# See pod text at end of file for documentation.
# See also ext/DynaLoader/README in source tree for other information.
print STDERR "DynaLoader::bootstrap for $module ",
($Is_MacOS
- ? "(auto/$modpname/$modfname.$dl_dlext)\n" :
- "(:auto:$modpname:$modfname.$dl_dlext)\n")
+ ? "(:auto:$modpname:$modfname.$dl_dlext)\n" :
+ "(auto/$modpname/$modfname.$dl_dlext)\n")
if $dl_debug;
foreach (@INC) {
GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
- sv_magic((SV*)gv, (SV*)gv, '*', name, len);
+ sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0);
GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
# fixed for autovivving FHs, tchrist again
+# allow fd numbers to be used, by Frank Tobin
#
# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
#
close $_[0] or croak "$Me: close($_[0]) failed: $!";
}
+sub xfileno {
+ my ($fh) = @_;
+ return $1 if $fh =~ /^=?(\d+)$/; # deal with $fh just being an fd
+ return fileno $fh;
+}
+
+sub fh_is_fd {
+ return $_[0] =~ /^=?\d+$/;
+}
+
my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
sub _open3 {
$dup_err = ($dad_err =~ s/^[<>]&//);
# force unqualified filehandles into caller's package
- $dad_wtr = qualify $dad_wtr, $package;
- $dad_rdr = qualify $dad_rdr, $package;
- $dad_err = qualify $dad_err, $package;
+ $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr);
+ $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr);
+ $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err);
my $kid_rdr = gensym;
my $kid_wtr = gensym;
# If she wants to dup the kid's stderr onto her stdout I need to
# save a copy of her stdout before I put something else there.
if ($dad_rdr ne $dad_err && $dup_err
- && fileno($dad_err) == fileno(STDOUT)) {
+ && xfileno($dad_err) == fileno(STDOUT)) {
my $tmp = gensym;
xopen($tmp, ">&$dad_err");
$dad_err = $tmp;
}
if ($dup_wtr) {
- xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
+ xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
} else {
xclose $dad_wtr;
xopen \*STDIN, "<&=" . fileno $kid_rdr;
}
if ($dup_rdr) {
- xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
+ xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
} else {
xclose $dad_rdr;
xopen \*STDOUT, ">&=" . fileno $kid_wtr;
# I have to use a fileno here because in this one case
# I'm doing a dup but the filehandle might be a reference
# (from the special case above).
- xopen \*STDERR, ">&" . fileno $dad_err
- if fileno(STDERR) != fileno($dad_err);
+ xopen \*STDERR, ">&" . xfileno($dad_err)
+ if fileno(STDERR) != xfileno($dad_err);
} else {
xclose $dad_err;
xopen \*STDERR, ">&=" . fileno $kid_err;
#define Perl_is_utf8_char pPerl->Perl_is_utf8_char
#undef is_utf8_char
#define is_utf8_char Perl_is_utf8_char
+#undef Perl_is_utf8_string
+#define Perl_is_utf8_string pPerl->Perl_is_utf8_string
+#undef is_utf8_string
+#define is_utf8_string Perl_is_utf8_string
#undef Perl_is_utf8_alnum
#define Perl_is_utf8_alnum pPerl->Perl_is_utf8_alnum
#undef is_utf8_alnum
return ((CPerlObj*)pPerl)->Perl_is_utf8_char(p);
}
+#undef Perl_is_utf8_string
+bool
+Perl_is_utf8_string(pTHXo_ U8 *s, STRLEN len)
+{
+ return ((CPerlObj*)pPerl)->Perl_is_utf8_string(s, len);
+}
+
#undef Perl_is_utf8_alnum
bool
Perl_is_utf8_alnum(pTHXo_ U8 *p)
#undef Perl_bytes_to_utf8
U8*
-Perl_bytes_to_utf8(pTHXo_ U8 *s, STRLEN len)
+Perl_bytes_to_utf8(pTHXo_ U8 *s, STRLEN *len)
{
return ((CPerlObj*)pPerl)->Perl_bytes_to_utf8(s, len);
}
=item bytes_to_utf8
Converts a string C<s> of length C<len> from ASCII into UTF8 encoding.
-Returns a pointer to the newly-created string.
+Returns a pointer to the newly-created string, and sets C<len> to
+reflect the new length.
- U8 * bytes_to_utf8(U8 *s, STRLEN len)
+ U8 * bytes_to_utf8(U8 *s, STRLEN *len)
=for hackers
Found in file utf8.c
=for hackers
Found in file sv.h
-=item svtype
+=item SvTYPE
-An enum of flags for Perl types. These are found in the file B<sv.h>
-in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV. See C<svtype>.
+
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
-=item SvTYPE
-
-Returns the type of the SV. See C<svtype>.
+=item svtype
- svtype SvTYPE(SV* sv)
+An enum of flags for Perl types. These are found in the file B<sv.h>
+in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
=for hackers
Found in file sv.h
=for hackers
Found in file handy.h
+=item U8 *s
+
+Returns true if first C<len> bytes of the given string form valid a UTF8
+string, false otherwise.
+
+ bool_utf8_string U8 *s(STRLEN len)
+
+=for hackers
+Found in file utf8.c
+
=item utf8_to_bytes
Converts a string C<s> of length C<len> from UTF8 into ASCII encoding.
Unlike C<bytes_to_utf8>, this over-writes the original string.
+Returns zero on failure after converting as much as possible.
U8 * utf8_to_bytes(U8 *s, STRLEN len)
=item sprintf FORMAT, LIST
-Returns a string formatted by the usual C<printf> conventions of the
-C library function C<sprintf>. See L<sprintf(3)> or L<printf(3)>
-on your system for an explanation of the general principles.
+Returns a string formatted by the usual C<printf> conventions of the C
+library function C<sprintf>. See below for more details
+and see L<sprintf(3)> or L<printf(3)> on your system for an explanation of
+the general principles.
+
+For example:
+
+ # Format number with up to 8 leading zeroes
+ $result = sprintf("%08d", $number);
+
+ # Round number to 3 digits after decimal point
+ $rounded = sprintf("%.3f", $number);
Perl does its own C<sprintf> formatting--it emulates the C
function C<sprintf>, but it doesn't use it (except for floating-point
PERL_CALLCONV U32 Perl_to_uni_title_lc(pTHX_ U32 c);
PERL_CALLCONV U32 Perl_to_uni_lower_lc(pTHX_ U32 c);
PERL_CALLCONV int Perl_is_utf8_char(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len);
PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ U8 *p);
PERL_CALLCONV bool Perl_is_utf8_alnumc(pTHX_ U8 *p);
PERL_CALLCONV bool Perl_is_utf8_idfirst(pTHX_ U8 *p);
PERL_CALLCONV I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b);
PERL_CALLCONV U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off);
PERL_CALLCONV U8* Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN len);
-PERL_CALLCONV U8* Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN len);
+PERL_CALLCONV U8* Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN *len);
PERL_CALLCONV UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen);
PERL_CALLCONV U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv);
PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv);
char *name = GvNAME(sstr);
STRLEN len = GvNAMELEN(sstr);
sv_upgrade(dstr, SVt_PVGV);
- sv_magic(dstr, dstr, '*', name, len);
+ sv_magic(dstr, dstr, '*', Nullch, 0);
GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
GvNAME(dstr) = savepvn(name, len);
GvNAMELEN(dstr) = len;
MG_VIRTUAL = &PL_vtbl_glob
MG_TYPE = \'\\*\'
MG_OBJ = $ADDR
- MG_LEN = 1
- MG_PTR = $ADDR "a"
NAME = "a"
NAMELEN = 1
GvSTASH = $ADDR\\t"main"
return len;
}
+/*
+=for apidoc Am|bool_utf8_string|U8 *s|STRLEN len
+
+Returns true if first C<len> bytes of the given string form valid a UTF8
+string, false otherwise.
+
+=cut
+*/
+
+bool
+Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len)
+{
+ U8* x=s;
+ U8* send=s+len;
+ int c;
+ while (x < send) {
+ c = is_utf8_char(x);
+ x += c;
+ if (!c || x > send)
+ return 0;
+ }
+ return 1;
+}
+
UV
Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen)
{
Converts a string C<s> of length C<len> from UTF8 into ASCII encoding.
Unlike C<bytes_to_utf8>, this over-writes the original string.
+Returns zero on failure after converting as much as possible.
=cut
*/
else {
I32 ulen;
UV uv = utf8_to_uv(s, &ulen);
+ if (uv > 255) {
+ *d = '\0';
+ return 0;
+ }
s += ulen;
*d++ = (U8)uv;
}
}
/*
-=for apidoc Am|U8 *|bytes_to_utf8|U8 *s|STRLEN len
+=for apidoc Am|U8 *|bytes_to_utf8|U8 *s|STRLEN *len
Converts a string C<s> of length C<len> from ASCII into UTF8 encoding.
-Returns a pointer to the newly-created string.
+Returns a pointer to the newly-created string, and sets C<len> to
+reflect the new length.
=cut
*/
U8*
-Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN len)
+Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN *len)
{
dTHR;
U8 *send;
U8 *d;
U8 *dst;
- send = s + len;
+ send = s + (*len);
- Newz(801, d, len * 2 + 1, U8);
+ Newz(801, d, (*len) * 2 + 1, U8);
dst = d;
while (s < send) {
}
}
*d = '\0';
+ *len = d-dst;
return dst;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff