-
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
-static bool ck_sv_defined(SV*);
-static bool ck_sv_is_ref(SV*);
-static bool ck_sv_ref_type(SV*, int);
+#ifndef MGf_COPY
+# define MGf_COPY 0
+#endif
-static bool
-ck_sv_defined(SV* value){
- return SvOK(value) ? 1 : 0;
-}
+#ifndef MGf_DUP
+# define MGf_DUP 0
+#endif
-static bool
-ck_sv_is_ref(SV* value){
- bool retval = 0;
- if( ck_sv_defined(value) && SvROK(value) ){
- retval = 1;
- }
- return retval;
-}
+#ifndef MGf_LOCAL
+# define MGf_LOCAL 0
+#endif
-static bool
-ck_sv_ref_type(SV* value, int sv_type){
- bool retval = 0;
- if( ck_sv_is_ref(value) && SvTYPE( SvRV(value) ) == sv_type){
- retval = 1;
- }
- return retval;
-}
+STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg);
+STATIC MGVTBL export_flag_vtbl = {
+ NULL, /* get */
+ unset_export_flag, /* set */
+ NULL, /* len */
+ NULL, /* clear */
+ NULL, /* free */
+#if MGf_COPY
+ NULL, /* copy */
+#endif
+#if MGf_DUP
+ NULL, /* dup */
+#endif
+#if MGf_LOCAL
+ NULL, /* local */
+#endif
+};
-MODULE = Moose PACKAGE = Moose::Util::TypeConstraints::OptimizedConstraints
-PROTOTYPES: ENABLE
+STATIC bool
+export_flag_is_set (pTHX_ SV *sv)
+{
+ MAGIC *mg, *moremagic;
-#ifdef HEHEHOHOHAHA
-bool
-Undefined(value)
- SV* value
- CODE:
- RETVAL = !ck_sv_defined(value);
- OUTPUT:
- RETVAL
+ if (SvTYPE(SvRV(sv)) != SVt_PVGV) {
+ return 0;
+ }
-bool
-Defined(value)
- SV* value
- CODE:
- RETVAL = ck_sv_defined(value);
- OUTPUT:
- RETVAL
+ for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) {
+ moremagic = mg->mg_moremagic;
-#endif
+ if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) {
+ break;
+ }
+ }
-bool
-Value(value)
- SV* value
- CODE:
- RETVAL = (ck_sv_defined(value) && !ck_sv_is_ref(value)) ? 1 : 0;
- OUTPUT:
- RETVAL
+ return !!mg;
+}
-bool
-Str(value)
- SV* value
- CODE:
- RETVAL = (ck_sv_defined(value) && !ck_sv_is_ref(value)) ? 1 : 0;
- OUTPUT:
- RETVAL
+STATIC int
+unset_export_flag (pTHX_ SV *sv, MAGIC *mymg)
+{
+ MAGIC *mg, *prevmagic = NULL, *moremagic = NULL;
-bool
-Ref(value)
- SV* value
- CODE:
- RETVAL = ck_sv_is_ref(value);
- OUTPUT:
- RETVAL
+ for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
+ moremagic = mg->mg_moremagic;
-bool
-ScalarRef(value)
- SV* value
- CODE:
- RETVAL = 0;
- if(
- SvOK(value) && SvROK(value)
- ){
- int type = SvTYPE(SvRV(value));
- if(
- type == SVt_IV ||
- type == SVt_NV ||
- type == SVt_PV ||
- type == SVt_NULL
- ){
- RETVAL = 1;
- }
+ if (mg == mymg) {
+ break;
+ }
}
- OUTPUT:
- RETVAL
-bool
-ArrayRef(value)
- SV* value
- CODE:
- RETVAL = ck_sv_ref_type(value, SVt_PVAV);
- OUTPUT:
- RETVAL
+ if (!mg) {
+ return 0;
+ }
-bool
-HashRef(value)
- SV* value
- CODE:
- RETVAL = (ck_sv_ref_type(value, SVt_PVHV) && !sv_isobject(value)) ? 1 : 0;
- OUTPUT:
- RETVAL
+ if (prevmagic) {
+ prevmagic->mg_moremagic = moremagic;
+ }
+ else {
+ SvMAGIC_set(sv, moremagic);
+ }
-bool
-CodeRef(value)
- SV* value
- CODE:
- RETVAL = ck_sv_ref_type(value, SVt_PVCV);
- OUTPUT:
- RETVAL
+ mg->mg_moremagic = NULL;
-bool
-GlobRef(value)
- SV* value
- CODE:
- RETVAL = ck_sv_ref_type(value, SVt_PVGV);
- OUTPUT:
- RETVAL
+ Safefree (mg);
-bool
-Object(value)
- SV* value
- PREINIT:
- char *regclass = "Regexp";
- CODE:
- RETVAL = 0;
- if( ck_sv_is_ref(value)
- && sv_isobject(value)
- && !sv_isa(value, regclass)
- ){
- RETVAL = 1;
- }
- OUTPUT:
- RETVAL
+ return 0;
+}
-bool
-RegexpRef(value)
- SV* value
- PREINIT:
- char *regclass = "Regexp";
- CODE:
- RETVAL = 0;
- if( ck_sv_is_ref(value)
- && sv_isobject(value)
- && sv_isa(value, regclass)
- ){
- RETVAL = 1;
- }
- OUTPUT:
- RETVAL
+MODULE = Moose PACKAGE = Moose::Exporter
+void
+_flag_as_reexport (SV *sv)
+ PROTOTYPE: \*
+ CODE:
+ sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0);
+bool
+_export_is_flagged (SV *sv)
+ PROTOTYPE: \*
+ CODE:
+ RETVAL = export_flag_is_set(aTHX_ sv);
+ OUTPUT:
+ RETVAL