#define savesvpv(s) savepv(SvPV_nolen(s))
#endif
+#ifndef GvCV_set
+#define GvCV_set(gv, cv) (GvCV(gv) = (CV*)(cv))
+#endif
+
+#ifndef SVT_SCALAR
+#define SVT_SCALAR(svt) (svt <= SVt_PVLV)
+#endif
+
+#ifndef SVT_ARRAY
+#define SVT_ARRAY(svt) (svt == SVt_PVAV)
+#endif
+
+#ifndef SVT_HASH
+#define SVT_HASH(svt) (svt == SVt_PVHV)
+#endif
+
+#ifndef SVT_CODE
+#define SVT_CODE(svt) (svt == SVt_PVCV)
+#endif
+
+#ifndef SVT_IO
+#define SVT_IO(svt) (svt == SVt_PVIO)
+#endif
+
+#ifndef SVT_FORMAT
+#define SVT_FORMAT(svt) (svt == SVt_PVFM)
+#endif
+
/* HACK: scalar slots are always populated on perl < 5.10, so treat undef
* as nonexistent. this is consistent with the previous behavior of the pure
* perl version of this module (since this is the behavior that perl sees
} while (0)
#define GvSetCV(g,v) do { \
SvREFCNT_dec(GvCV(g)); \
- if ((GvCV(g) = (CV*)(v))) { \
+ if ((GvCV_set(g, v))) { \
GvIMPORTED_CV_on(g); \
GvASSUMECV_on(g); \
} \
static U32 name_hash, namespace_hash, type_hash;
static SV *name_key, *namespace_key, *type_key;
-const char *vartype_to_string(vartype_t type)
+static const char *vartype_to_string(vartype_t type)
{
switch (type) {
case VAR_SCALAR:
}
}
-I32 vartype_to_svtype(vartype_t type)
+static I32 vartype_to_svtype(vartype_t type)
{
switch (type) {
case VAR_SCALAR:
}
}
-vartype_t string_to_vartype(char *vartype)
+static vartype_t string_to_vartype(char *vartype)
{
if (strEQ(vartype, "SCALAR")) {
return VAR_SCALAR;
}
}
-void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
+static void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
{
char *varpv;
}
}
-void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
+static void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
{
HE *val;
varspec->type = string_to_vartype(SvPV_nolen(HeVAL(val)));
}
-int _valid_for_type(SV *value, vartype_t type)
+static void _check_varspec_is_valid(varspec_t *varspec)
+{
+ if (strstr(SvPV_nolen(varspec->name), "::")) {
+ croak("Variable names may not contain ::");
+ }
+}
+
+static int _valid_for_type(SV *value, vartype_t type)
{
svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;
switch (type) {
case VAR_SCALAR:
- return sv_type == SVt_NULL ||
- sv_type == SVt_IV ||
- sv_type == SVt_NV ||
- sv_type == SVt_PV ||
- sv_type == SVt_RV;
+ /* XXX is a glob a scalar? assigning a glob to the scalar slot seems
+ * to work here, but in pure perl i'm pretty sure it goes to the EGV
+ * slot, which seems more correct to me. just disable it for now
+ * i guess */
+ return SVT_SCALAR(sv_type) && sv_type != SVt_PVGV;
case VAR_ARRAY:
- return sv_type == SVt_PVAV;
+ return SVT_ARRAY(sv_type);
case VAR_HASH:
- return sv_type == SVt_PVHV;
+ return SVT_HASH(sv_type);
case VAR_CODE:
- return sv_type == SVt_PVCV;
+ return SVT_CODE(sv_type);
case VAR_IO:
- return sv_type == SVt_PVIO;
+ return SVT_IO(sv_type);
default:
return 0;
}
}
-HV *_get_namespace(SV *self)
+static HV *_get_namespace(SV *self)
{
dSP;
SV *ret;
return (HV*)SvRV(ret);
}
-SV *_get_name(SV *self)
+static SV *_get_name(SV *self)
{
dSP;
SV *ret;
return ret;
}
-void _expand_glob(SV *self, SV *varname)
+static void _expand_glob(SV *self, SV *varname)
{
SV *name;
SvREFCNT_dec(name);
}
-SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
+static SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
{
HV *namespace;
HE *entry;
SV *package_name
PREINIT:
HV *instance;
- HV *namespace;
- SV *nsref;
CODE:
if (!SvPOK(package_name))
croak("The constructor argument must be the name of a package");
SvREFCNT_dec(instance);
croak("Couldn't initialize the 'name' key, hv_store failed");
}
- namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
- nsref = newRV_inc((SV*)namespace);
- if (!hv_store(instance, "namespace", 9, nsref, 0)) {
- SvREFCNT_dec(nsref);
- SvREFCNT_dec(instance);
- croak("Couldn't initialize the 'namespace' key, hv_store failed");
- }
RETVAL = sv_bless(newRV_noinc((SV*)instance), gv_stashsv(class, 0));
OUTPUT:
SV *self
PREINIT:
HE *slot;
+ SV *package_name;
CODE:
if (!sv_isobject(self))
croak("Can't call namespace as a class method");
+#if PERL_VERSION < 10
+ package_name = _get_name(self);
+ RETVAL = newRV_inc((SV*)gv_stashpv(SvPV_nolen(package_name), GV_ADD));
+#else
slot = hv_fetch_ent((HV*)SvRV(self), namespace_key, 0, namespace_hash);
- RETVAL = slot ? SvREFCNT_inc_simple_NN(HeVAL(slot)) : &PL_sv_undef;
+ if (slot) {
+ RETVAL = SvREFCNT_inc_simple_NN(HeVAL(slot));
+ }
+ else {
+ HV *namespace;
+ SV *nsref;
+
+ package_name = _get_name(self);
+ namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
+ nsref = newRV_inc((SV*)namespace);
+ sv_rvweaken(nsref);
+ if (!hv_store((HV*)SvRV(self), "namespace", 9, nsref, 0)) {
+ SvREFCNT_dec(nsref);
+ SvREFCNT_dec(self);
+ croak("Couldn't initialize the 'namespace' key, hv_store failed");
+ }
+ RETVAL = SvREFCNT_inc_simple_NN(nsref);
+ }
+#endif
OUTPUT:
RETVAL
int i;
char *filename = NULL;
I32 first_line_num = -1, last_line_num = -1;
- STRLEN namelen;
SV *dbval;
HV *dbsub;