}
else if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
- if (SvIOKp(sv) &&
+ if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) {
+ SvNOK_on(sv);
+ }
+ else if (SvIOKp(sv) &&
(!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
{
SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
char *
Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
{
+ return sv_2pv_flags(sv, lp, SV_GMAGIC);
+}
+
+char *
+Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
+{
register char *s;
int olderrno;
SV *tsv;
return "";
}
if (SvGMAGICAL(sv)) {
- mg_get(sv);
+ if (flags & SV_GMAGIC)
+ mg_get(sv);
if (SvPOKp(sv)) {
*lp = SvCUR(sv);
return SvPVX(sv);
STRLEN
Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
{
+ return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
+}
+
+/*
+=for apidoc sv_utf8_upgrade_flags
+
+Convert the PV of an SV to its UTF8-encoded form.
+Forces the SV to string form it it is not already.
+Always sets the SvUTF8 flag to avoid future validity checks even
+if all the bytes have hibit clear. If C<flags> has C<SV_GMAGIC> bit set,
+will C<mg_get> on C<sv> if appropriate, else not. C<sv_utf8_upgrade> and
+C<sv_utf8_upgrade_nomg> are implemented in terms of this function.
+
+=cut
+*/
+
+STRLEN
+Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
+{
U8 *s, *t, *e;
int hibit = 0;
if (!SvPOK(sv)) {
STRLEN len = 0;
- (void) sv_2pv(sv,&len);
+ (void) sv_2pv_flags(sv,&len, flags);
if (!SvPOK(sv))
return len;
}
=cut
*/
+/* sv_setsv() is aliased to Perl_sv_setsv_macro; this function provided
+ for binary compatibility only
+*/
void
Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
{
+ sv_setsv_flags(dstr, sstr, SV_GMAGIC);
+}
+
+/*
+=for apidoc sv_setsv_flags
+
+Copies the contents of the source SV C<ssv> into the destination SV C<dsv>.
+The source SV may be destroyed if it is mortal. Does not handle 'set'
+magic. If C<flags> has C<SV_GMAGIC> bit set, will C<mg_get> on C<ssv> if
+appropriate, else not. C<sv_setsv> and C<sv_setsv_nomg> are implemented
+in terms of this function.
+
+=cut
+*/
+
+void
+Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
+{
register U32 sflags;
register int dtype;
register int stype;
/* FALL THROUGH */
default:
- if (SvGMAGICAL(sstr)) {
+ if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
mg_get(sstr);
if (SvTYPE(sstr) != stype) {
stype = SvTYPE(sstr);
=cut
*/
+/* sv_catpvn() is aliased to Perl_sv_catpvn_macro; this function provided
+ for binary compatibility only
+*/
void
-Perl_sv_catpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
+Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
{
- STRLEN tlen;
- char *junk;
+ sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
+}
- junk = SvPV_force(sv, tlen);
- SvGROW(sv, tlen + len + 1);
- if (ptr == junk)
- ptr = SvPVX(sv);
- Move(ptr,SvPVX(sv)+tlen,len,char);
- SvCUR(sv) += len;
- *SvEND(sv) = '\0';
- (void)SvPOK_only_UTF8(sv); /* validate pointer */
- SvTAINT(sv);
+/*
+=for apidoc sv_catpvn_flags
+
+Concatenates the string onto the end of the string which is in the SV. The
+C<len> indicates number of bytes to copy. If the SV has the UTF8
+status set, then the bytes appended should be valid UTF8.
+If C<flags> has C<SV_GMAGIC> bit set, will C<mg_get> on C<dsv> if
+appropriate, else not. C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
+in terms of this function.
+
+=cut
+*/
+
+void
+Perl_sv_catpvn_flags(pTHX_ register SV *dsv, register const char *sstr, register STRLEN slen, I32 flags)
+{
+ STRLEN dlen;
+ char *dstr;
+
+ dstr = SvPV_force_flags(dsv, dlen, flags);
+ SvGROW(dsv, dlen + slen + 1);
+ if (sstr == dstr)
+ sstr = SvPVX(dsv);
+ Move(sstr, SvPVX(dsv) + dlen, slen, char);
+ SvCUR(dsv) += slen;
+ *SvEND(dsv) = '\0';
+ (void)SvPOK_only_UTF8(dsv); /* validate pointer */
+ SvTAINT(dsv);
}
/*
=cut */
+/* sv_catsv() is aliased to Perl_sv_catsv_macro; this function provided
+ for binary compatibility only
+*/
void
-Perl_sv_catsv(pTHX_ SV *dsv, register SV *ssv)
+Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
+{
+ sv_catsv_flags(dstr, sstr, SV_GMAGIC);
+}
+
+/*
+=for apidoc sv_catsv_flags
+
+Concatenates the string from SV C<ssv> onto the end of the string in
+SV C<dsv>. Modifies C<dsv> but not C<ssv>. If C<flags> has C<SV_GMAGIC>
+bit set, will C<mg_get> on the SVs if appropriate, else not. C<sv_catsv>
+and C<sv_catsv_nomg> are implemented in terms of this function.
+
+=cut */
+
+void
+Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
{
char *spv;
STRLEN slen;
if (!ssv)
return;
if ((spv = SvPV(ssv, slen))) {
- bool dutf8 = DO_UTF8(dsv);
bool sutf8 = DO_UTF8(ssv);
+ bool dutf8;
- if (dutf8 == sutf8)
- sv_catpvn(dsv,spv,slen);
- else {
+ if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
+ mg_get(dsv);
+ dutf8 = DO_UTF8(dsv);
+
+ if (dutf8 != sutf8) {
if (dutf8) {
/* Not modifying source SV, so taking a temporary copy. */
- SV* csv = sv_2mortal(newSVsv(ssv));
- char *cpv;
- STRLEN clen;
+ SV* csv = sv_2mortal(newSVpvn(spv, slen));
sv_utf8_upgrade(csv);
- cpv = SvPV(csv,clen);
- sv_catpvn(dsv,cpv,clen);
- }
- else {
- sv_utf8_upgrade(dsv);
- sv_catpvn(dsv,spv,slen);
- SvUTF8_on(dsv); /* If dsv has no wide characters. */
+ spv = SvPV(csv, slen);
}
+ else
+ sv_utf8_upgrade_nomg(dsv);
}
+ sv_catpvn_nomg(dsv, spv, slen);
}
}
}
if (!SvMAGIC(sv)) {
SvMAGICAL_off(sv);
- SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+ SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
}
return 0;
char *
Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
{
+ return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
+}
+
+/*
+=for apidoc sv_pvn_force_flags
+
+Get a sensible string out of the SV somehow.
+If C<flags> has C<SV_GMAGIC> bit set, will C<mg_get> on C<sv> if
+appropriate, else not. C<sv_pvn_force> and C<sv_pvn_force_nomg> are
+implemented in terms of this function.
+
+=cut
+*/
+
+char *
+Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
char *s;
if (SvTHINKFIRST(sv) && !SvROK(sv))
PL_op_name[PL_op->op_type]);
}
else
- s = sv_2pv(sv, lp);
+ s = sv_2pv_flags(sv, lp, flags);
if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */
STRLEN len = *lp;
break;
case SVt_RV:
SvANY(dstr) = new_XRV();
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ SvRV(dstr) = SvRV(sstr) && SvWEAKREF(SvRV(sstr))
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
break;
case SVt_PV:
SvANY(dstr) = new_XPV();
SvLEN(dstr) = SvLEN(sstr);
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvIVX(dstr) = SvIVX(sstr);
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvNVX(dstr) = SvNVX(sstr);
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
if (SvROK(sstr))
SvRV(dstr) = SvWEAKREF(SvRV(sstr))
- ? sv_dup_inc(SvRV(sstr))
- : sv_dup(SvRV(sstr));
+ ? sv_dup(SvRV(sstr))
+ : sv_dup_inc(SvRV(sstr));
else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else