Gisle Aas <[EMAIL PROTECTED]> writes:
> For HTML::Parser we should go the route of making _hparser_xs_pstate
> it's own object with it's own destructor, so it can clean up itself
> and make %$self = () safe for HTML::Parser subclasses. Perhaps some
> tricks with perl's internal magic can work. I will look into that.
This patch use ~-magic to make deallocation happen when the IV that
points to the struct p_state goes away. This should make %$self = ()
acceptable to use for HTML::Element again.
Regards,
Gisle
Index: Parser.xs
===================================================================
RCS file: /home/cvs/aas/perl/mods/html-parser/Parser.xs,v
retrieving revision 2.81
diff -u -p -u -r2.81 Parser.xs
--- Parser.xs 1999/12/09 19:07:33 2.81
+++ Parser.xs 1999/12/17 14:08:30
@@ -91,8 +91,18 @@ check_handler(SV* h)
static PSTATE*
-get_pstate(SV* sv) /* used by XS typemap */
+get_pstate_iv(SV* sv)
{
+ PSTATE* p = (PSTATE*)SvIV(sv);
+ if (p->signature != P_SIGNATURE)
+ croak("Bad signature in parser state object at %p", p);
+ return p;
+}
+
+
+static PSTATE*
+get_pstate_hv(SV* sv) /* used by XS typemap */
+{
HV* hv;
SV** svp;
@@ -101,19 +111,42 @@ get_pstate(SV* sv)
croak("Not a reference to a hash");
hv = (HV*)sv;
svp = hv_fetch(hv, "_hparser_xs_state", 17, 0);
- if (svp) {
- PSTATE* p = (PSTATE*)SvIV(*svp);
-#ifdef P_MAGIC
- if (p->magic != P_MAGIC)
- croak("Bad magic in parser state object at %p", p);
+ if (svp)
+ return get_pstate_iv(*svp);
+ croak("Can't find '_hparser_xs_state' element in HTML::Parser hash");
+ return 0;
+}
+
+
+static void
+free_pstate(PSTATE* pstate)
+{
+ int i;
+ SvREFCNT_dec(pstate->buf);
+#ifdef MARKED_SECTION
+ SvREFCNT_dec(pstate->ms_stack);
#endif
- return p;
+ SvREFCNT_dec(pstate->bool_attr_val);
+ for (i = 0; i < EVENT_COUNT; i++) {
+ SvREFCNT_dec(pstate->handlers[i].cb);
+ SvREFCNT_dec(pstate->handlers[i].argspec);
}
- croak("Can't find '_hparser_xs_state' element in HTML::Parser hash");
+ pstate->signature = 0;
+ Safefree(pstate);
+}
+
+
+static int
+magic_free_pstate(SV *sv, MAGIC *mg)
+{
+ free_pstate(get_pstate_iv(sv));
return 0;
}
+MGVTBL vtbl_free_pstate = {0, 0, 0, 0, magic_free_pstate};
+
+
/*
* XS interface definition.
@@ -130,6 +163,8 @@ _alloc_pstate(self)
PSTATE* pstate;
SV* sv;
HV* hv;
+ MAGIC* mg;
+
CODE:
sv = SvRV(self);
if (!sv || SvTYPE(sv) != SVt_PVHV)
@@ -137,39 +172,23 @@ _alloc_pstate(self)
hv = (HV*)sv;
Newz(56, pstate, 1, PSTATE);
-#ifdef P_MAGIC
- pstate->magic = P_MAGIC;
-#endif
+ pstate->signature = P_SIGNATURE;
+
sv = newSViv((IV)pstate);
+ sv_magic(sv, 0, '~', 0, 0);
+ mg = mg_find(sv, '~');
+ assert(mg);
+ mg->mg_virtual = &vtbl_free_pstate;
SvREADONLY_on(sv);
hv_store(hv, "_hparser_xs_state", 17, sv, 0);
-void
-DESTROY(pstate)
- PSTATE* pstate
- PREINIT:
- int i;
- CODE:
- SvREFCNT_dec(pstate->buf);
-#ifdef MARKED_SECTION
- SvREFCNT_dec(pstate->ms_stack);
-#endif
- SvREFCNT_dec(pstate->bool_attr_val);
- for (i = 0; i < EVENT_COUNT; i++) {
- SvREFCNT_dec(pstate->handlers[i].cb);
- SvREFCNT_dec(pstate->handlers[i].argspec);
- }
-
- Safefree(pstate);
-
-
SV*
parse(self, chunk)
SV* self;
SV* chunk
PREINIT:
- PSTATE* p_state = get_pstate(self);
+ PSTATE* p_state = get_pstate_hv(self);
CODE:
if (p_state->parsing)
croak("Parse loop not allowed");
@@ -185,7 +204,7 @@ SV*
eof(self)
SV* self;
PREINIT:
- PSTATE* p_state = get_pstate(self);
+ PSTATE* p_state = get_pstate_hv(self);
CODE:
if (p_state->parsing)
p_state->eof = 1;
Index: hparser.h
===================================================================
RCS file: /home/cvs/aas/perl/mods/html-parser/hparser.h,v
retrieving revision 2.7
diff -u -p -u -r2.7 hparser.h
--- hparser.h 1999/12/14 09:40:13 2.7
+++ hparser.h 1999/12/17 13:49:54
@@ -33,7 +33,7 @@ enum marked_section_t {
#endif /* MARKED_SECTION */
-#define P_MAGIC 0x16091964 /* used to tag struct p_state for safer cast */
+#define P_SIGNATURE 0x16091964 /* tag struct p_state for safer cast */
enum event_id {
E_DECLARATION = 0,
@@ -65,7 +65,7 @@ struct p_handler {
};
struct p_state {
- U32 magic;
+ U32 signature;
SV* buf;
STRLEN chunk_offset;
bool parsing;
Index: typemap
===================================================================
RCS file: /home/cvs/aas/perl/mods/html-parser/typemap,v
retrieving revision 2.1
diff -u -p -u -r2.1 typemap
--- typemap 1999/11/08 14:09:26 2.1
+++ typemap 1999/12/17 13:44:04
@@ -2,4 +2,4 @@ PSTATE* T_PSTATE
INPUT
T_PSTATE
- $var = get_pstate($arg)
+ $var = get_pstate_hv($arg)
Index: t/magic.t
===================================================================
RCS file: /home/cvs/aas/perl/mods/html-parser/t/magic.t,v
retrieving revision 1.3
diff -u -p -u -r1.3 magic.t
--- t/magic.t 1999/12/09 15:24:50 1.3
+++ t/magic.t 1999/12/17 14:05:10
@@ -1,4 +1,4 @@
-# Check that the magic at the top of struct p_state works and that we
+# Check that the magic signature at the top of struct p_state works and that we
# catch modifications to _hparser_xs_state gracefully
print "1..4\n";
@@ -17,7 +17,8 @@ print "not " unless $@ && $@ =~ /^Modifi
print "ok 1\n";
-my $x = delete $p->{_hparser_xs_state};
+my $x = \$p->{_hparser_xs_state};
+delete $p->{_hparser_xs_state};
eval {
$p->xml_mode(1);
@@ -25,15 +26,15 @@ eval {
print "not " unless $@ && $@ =~ /^Can't find '_hparser_xs_state'/;
print "ok 2\n";
-$p->{_hparser_xs_state} = $x + 16;
+$p->{_hparser_xs_state} = $$x + 16;
eval {
$p->xml_mode(1);
};
-print "not " unless $@ && $@ =~ /^Bad magic in parser state object/;
+print "not " unless $@ && $@ =~ /^Bad signature in parser state object/;
print "ok 3\n";
-$p->{_hparser_xs_state} = $x;
+$p->{_hparser_xs_state} = $$x;
print "not " unless $p->xml_mode(0);
print "ok 4\n";
