| Subject: | [PATCH] Allow globrefs as return value in ExternEnt handler |
The attached patch allows refs to globs to be returned from an ExternEnt
handler. So the most natural form in recent perls can be used:
sub extern_ent_handler {
my(...) = @_;
open(my $fh, "...") or die $!;
return $fh;
}
As a side effect, it is also possible to return \*FOO.
The patch includes this change, additional test cases in astress.t and
a minor warning fix in encoding.t.
Regards,
Slaven
--- ./Expat/Expat.xs.orig 2004-09-28 12:26:50.000000000 +0200
+++ ./Expat/Expat.xs 2004-09-28 12:27:33.000000000 +0200
@@ -2196,6 +2196,10 @@ XML_Do_External_Parse(parser, result)
if (SvROK(result) && SvOBJECT(SvRV(result))) {
RETVAL = parse_stream(parser, result);
}
+ else if (SvROK(result) && isGV(SvRV(result))) {
+ RETVAL = parse_stream(parser,
+ sv_2mortal(newRV((SV*) GvIOp(SvRV(result)))));
+ }
else if (isGV(result)) {
RETVAL = parse_stream(parser,
sv_2mortal(newRV((SV*) GvIOp(result))));
--- ./t/astress.t.orig 2003-07-27 13:13:51.000000000 +0200
+++ ./t/astress.t 2004-09-28 12:49:09.000000000 +0200
@@ -6,7 +6,7 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN {print "1..27\n";}
+BEGIN {print "1..31\n";}
END {print "not ok 1\n" unless $loaded;}
use XML::Parser;
$loaded = 1;
@@ -41,6 +41,14 @@ open(ZOE, '>zoe.ent');
print ZOE "'cute'";
close(ZOE);
+open(PAUL, '>paul.ent');
+print PAUL "'Paul'";
+close(PAUL);
+
+open(PAULA, '>paula.ent');
+print PAULA "'Paula'";
+close(PAULA);
+
# XML string for tests
my $xmlstring =<<"End_of_XML;";
@@ -50,10 +58,13 @@ my $xmlstring =<<"End_of_XML;";
<!ENTITY zinger PUBLIC "xyz" "abc" NDATA bar>
<!ENTITY fran SYSTEM "fran-def">
<!ENTITY zoe SYSTEM "zoe.ent">
+ <!ENTITY paul SYSTEM "paul.ent">
+ <!ENTITY paula SYSTEM "paula.ent">
]>
<foo>
First line in foo
<boom>Fran is &fran; and Zoe is &zoe;</boom>
+ <boom2>&paul; & &paula;</boom2>
<bar id="jack" stomp="jill">
<?line-noise *&*&^&<< ?>
1st line in bar
@@ -79,6 +90,11 @@ sub ch
$tests[17]++ if $str =~ /pretty/;
$tests[18]++ if $str =~ /cute/;
}
+ elsif ($p->in_element('boom2'))
+ {
+ $tests[30]++ if $str =~ /\bPaul\b/;
+ $tests[31]++ if $str =~ /\bPaula\b/;
+ }
}
sub st
@@ -105,7 +121,7 @@ sub eh
{
$tests[8]++;
my @old = $p->setHandlers('Char', \&newch);
- $tests[19]++ if $p->current_line == 17;
+ $tests[19]++ if $p->current_line == 20;
$tests[20]++ if $p->current_column == 20;
$tests[23]++ if ($old[0] eq 'Char' and $old[1] == \&ch);
}
@@ -176,6 +192,26 @@ sub extent
open(FOO, $sys) or die "Couldn't open $sys";
return *FOO;
}
+ elsif ($sys eq 'paul.ent')
+ {
+ $tests[28]++;
+
+ open(FOO, $sys) or die "Couldn't open $sys";
+ return \*FOO;
+ }
+ elsif ($sys eq 'paula.ent')
+ {
+ $tests[29]++;
+
+ my $fh;
+ if ($] >= 5.006) {
+ open($fh, $sys) or die "Couldn't open $sys";
+ return $fh;
+ } else { # fallback, older perls do not understand open($fh, ...)
+ open(FOO, $sys) or die "Couldn't open $sys";
+ return *FOO;
+ }
+ }
}
eval {
@@ -213,6 +249,9 @@ else
}
unlink('zoe.ent') if (-f 'zoe.ent');
+unlink('paul.ent') if (-f 'paul.ent');
+unlink('paula.ent') if (-f 'paula.ent');
+
for (4 .. 23)
{
@@ -262,3 +301,8 @@ if(defined(*{$xmlstring})) {
}
print "ok 27\n";
+for (28 .. 31)
+{
+ print "not " unless $tests[$_];
+ print "ok $_\n";
+}
--- ./t/encoding.t.orig 2004-09-28 12:46:57.000000000 +0200
+++ ./t/encoding.t 2004-09-28 12:47:05.000000000 +0200
@@ -91,9 +91,9 @@ sub get_attr {
%attr = @list;
}
-my $p = new XML::Parser(Handlers => {Start => \&get_attr});
+my $p2 = new XML::Parser(Handlers => {Start => \&get_attr});
-eval{ $p->parse($docstring) };
+eval{ $p2->parse($docstring) };
if($@) {
print "not "; # couldn't load the map