#endif /* USE_ITHREADS */
static void
-Perl_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
- const char *msg)
+S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
+ const char *msg)
{
- SV *sv = sv_newmortal();
+ SV *sv = sv_newmortal(), *esv = sv_newmortal();
if (!(flags & HVhek_FREEKEY)) {
sv_setpvn(sv, key, klen);
}
if (flags & HVhek_UTF8) {
SvUTF8_on(sv);
}
- Perl_croak(aTHX_ msg, sv);
+ Perl_sv_setpvf(aTHX_ esv, "Attempt to %s a restricted hash", msg);
+ Perl_croak(aTHX_ SvPVX(esv), sv);
}
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
if (env) {
sv = newSVpvn(env,len);
SvTAINTED_on(sv);
- if (key != keysave)
+ if (flags & HVhek_FREEKEY)
Safefree(key);
return hv_store(hv,key,klen,sv,hash);
}
}
#endif
if (!entry && SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ flags, key, klen,
- "Attempt to access disallowed key '%"SVf"' in a fixed hash"
- );
+ S_hv_notallowed(aTHX_ flags, key, klen,
+ "access disallowed key '%"SVf"' in"
+ );
}
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
}
#endif
if (!entry && SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ flags, key, klen,
- "Attempt to access disallowed key '%"SVf"' in a fixed hash"
- );
+ S_hv_notallowed(aTHX_ flags, key, klen,
+ "access disallowed key '%"SVf"' in"
+ );
}
if (flags & HVhek_FREEKEY)
Safefree(key);
const char *keysave = key;
int flags = 0;
+ if (klen < 0) {
+ klen = -klen;
+ is_utf8 = TRUE;
+ }
+
if (is_utf8) {
STRLEN tmplen = klen;
/* Just casting the &klen to (STRLEN) won't work well
}
SV**
-S_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
+Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
register U32 hash, int flags)
{
register XPVHV* xhv;
xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
else
SvREFCNT_dec(HeVAL(entry));
- HeVAL(entry) = val;
+ if (flags & HVhek_PLACEHOLD) {
+ /* We have been requested to insert a placeholder. Currently
+ only Storable is allowed to do this. */
+ xhv->xhv_placeholders++;
+ HeVAL(entry) = &PL_sv_undef;
+ } else
+ HeVAL(entry) = val;
if (HeKFLAGS(entry) != flags) {
/* We match if HVhek_UTF8 bit in our flags and hash key's match.
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ flags, key, klen,
- "Attempt to access disallowed key '%"SVf"' to a fixed hash"
- );
+ S_hv_notallowed(aTHX_ flags, key, klen,
+ "access disallowed key '%"SVf"' to"
+ );
}
entry = new_HE();
HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
else /* gotta do the real thing */
HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
- HeVAL(entry) = val;
+ if (flags & HVhek_PLACEHOLD) {
+ /* We have been requested to insert a placeholder. Currently
+ only Storable is allowed to do this. */
+ xhv->xhv_placeholders++;
+ HeVAL(entry) = &PL_sv_undef;
+ } else
+ HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ flags, key, klen,
- "Attempt to access disallowed key '%"SVf"' to a fixed hash"
- );
+ S_hv_notallowed(aTHX_ flags, key, klen,
+ "access disallowed key '%"SVf"' to"
+ );
}
entry = new_HE();
}
}
else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
- Perl_hv_notallowed(aTHX_ k_flags, key, klen,
- "Attempt to delete readonly key '%"SVf"' from a fixed hash"
- );
+ S_hv_notallowed(aTHX_ k_flags, key, klen,
+ "delete readonly key '%"SVf"' from"
+ );
}
if (flags & G_DISCARD)
return sv;
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ k_flags, key, klen,
- "Attempt to access disallowed key '%"SVf"' from a fixed hash"
- );
+ S_hv_notallowed(aTHX_ k_flags, key, klen,
+ "access disallowed key '%"SVf"' from"
+ );
}
if (k_flags & HVhek_FREEKEY)
return Nullsv;
}
else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
- Perl_hv_notallowed(aTHX_ k_flags, key, klen,
- "Attempt to delete readonly key '%"SVf"' from a fixed hash"
- );
+ S_hv_notallowed(aTHX_ k_flags, key, klen,
+ "delete readonly key '%"SVf"' from"
+ );
}
if (flags & G_DISCARD)
return sv;
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ k_flags, key, klen,
- "Attempt to delete disallowed key '%"SVf"' from a fixed hash"
- );
+ S_hv_notallowed(aTHX_ k_flags, key, klen,
+ "delete disallowed key '%"SVf"' from"
+ );
}
if (k_flags & HVhek_FREEKEY)
HvMAX(hv) = hv_max;
hv_iterinit(ohv);
- while ((entry = hv_iternext(ohv))) {
+ while ((entry = hv_iternext_flags(ohv, 0))) {
hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
newSVsv(HeVAL(entry)), HeHASH(entry),
HeKFLAGS(entry));
return;
if(SvREADONLY(hv)) {
- Perl_croak(aTHX_ "Attempt to clear a fixed hash");
+ Perl_croak(aTHX_ "Attempt to clear a restricted hash");
}
xhv = (XPVHV*)SvANY(hv);
hash buckets that happen to be in use. If you still need that esoteric
value, you can get it through the macro C<HvFILL(tb)>.
+
=cut
*/
/* used to be xhv->xhv_fill before 5.004_65 */
return XHvTOTALKEYS(xhv);
}
-
/*
=for apidoc hv_iternext
Returns entries from a hash iterator. See C<hv_iterinit>.
+You may call C<hv_delete> or C<hv_delete_ent> on the hash entry that the
+iterator currently points to, without losing your place or invalidating your
+iterator. Note that in this case the current entry is deleted from the hash
+with your iterator holding the last reference to it. Your iterator is flagged
+to free the entry on the next call to C<hv_iternext>, so you must not discard
+your iterator immediately else the entry will leak - call C<hv_iternext> to
+trigger the resource deallocation.
+
=cut
*/
HE *
Perl_hv_iternext(pTHX_ HV *hv)
{
+ return hv_iternext_flags(hv, 0);
+}
+
+/*
+=for apidoc hv_iternext_flags
+
+Returns entries from a hash iterator. See C<hv_iterinit> and C<hv_iternext>.
+The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
+set the placeholders keys (for restricted hashes) will be returned in addition
+to normal keys. By default placeholders are automatically skipped over.
+Currently a placeholder is implemented with a value that is literally
+<&Perl_sv_undef> (a regular C<undef> value is a normal read-write SV for which
+C<!SvOK> is false). Note that the implementation of placeholders and
+restricted hashes may change, and the implementation currently is
+insufficiently abstracted for any change to be tidy.
+
+=cut
+*/
+
+HE *
+Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
+{
register XPVHV* xhv;
register HE *entry;
HE *oldentry;
if (entry)
{
entry = HeNEXT(entry);
- /*
- * Skip past any placeholders -- don't want to include them in
- * any iteration.
- */
- while (entry && HeVAL(entry) == &PL_sv_undef) {
- entry = HeNEXT(entry);
+ if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
+ /*
+ * Skip past any placeholders -- don't want to include them in
+ * any iteration.
+ */
+ while (entry && HeVAL(entry) == &PL_sv_undef) {
+ entry = HeNEXT(entry);
+ }
}
}
while (!entry) {
/* entry = (HvARRAY(hv))[HvRITER(hv)]; */
entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
- /* if we have an entry, but it's a placeholder, don't count it */
- if (entry && HeVAL(entry) == &PL_sv_undef)
- entry = 0;
-
+ if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
+ /* if we have an entry, but it's a placeholder, don't count it */
+ if (entry && HeVAL(entry) == &PL_sv_undef)
+ entry = 0;
+ }
}
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
Andreas would like keys he put in as utf8 to come back as utf8
*/
STRLEN utf8_len = HEK_LEN(hek);
- U8 *as_utf8 = bytes_to_utf8 (HEK_KEY(hek), &utf8_len);
+ U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
- sv = newSVpvn (as_utf8, utf8_len);
+ sv = newSVpvn ((char*)as_utf8, utf8_len);
SvUTF8_on (sv);
} else {
sv = newSVpvn_share(HEK_KEY(hek),
Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
{
HE *he;
- if ( (he = hv_iternext(hv)) == NULL)
+ if ( (he = hv_iternext_flags(hv, 0)) == NULL)
return NULL;
*key = hv_iterkey(he, retlen);
return hv_iterval(hv, he);
projects / p5sagit/p5-mst-13.2.git / blobdiff