Skip to content

Commit aeb46ed

Browse files
committed
wip
1 parent e59beb0 commit aeb46ed

File tree

3 files changed

+90
-56
lines changed

3 files changed

+90
-56
lines changed
Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
package MetaCPAN::Web::Test::HTML5::Element;
2+
use strict;
3+
use warnings;
4+
5+
use parent 'HTML::Element';
6+
7+
use MetaCPAN::Web::Test::HTML5::Element::SVG;
8+
use constant SVG_CLASS => 'MetaCPAN::Web::Test::HTML5::Element::SVG';
9+
10+
sub insert_element {
11+
my ($self, $tag, @more) = @_;
12+
local $self->{_element_class} = SVG_CLASS
13+
if $tag eq 'svg';
14+
$self->SUPER::insert_element($tag, @more);
15+
}
16+
17+
sub _valid_name {
18+
my ( $self, $attr ) = @_;
19+
# HTML::Element doesn't allow single character attributes, so fake them
20+
# being longer
21+
$attr .= 'a'
22+
if length($attr) == 1
23+
$self->SUPER::_valid_name($attr);
24+
}
25+
26+
1;

t/lib/MetaCPAN/Web/Test/HTML5/Element/SVG.pm

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,16 +2,22 @@ package MetaCPAN::Web::Test::HTML5::Element::SVG;
22
use strict;
33
use warnings;
44

5-
use parent 'HTML::Element';
5+
use parent 'MetaCPAN::Web::Test::HTML5::Element';
66

77
sub starttag_XML {
88
my $self = shift;
9-
my $is_svg = $self->{_tag} eq 'svg';
10-
local $self->{xmlns} = 'http://www.w3.org/2000/svg' if $is_svg;
11-
local $self->{'xmlns:xlink'} = 'http://www.w3.org/1999/xlink'
12-
if $is_svg;
9+
10+
local $self->{xmlns} = 'http://www.w3.org/2000/svg'
11+
if $self->{_tag} eq 'svg';
12+
my @ns = grep /^xmlns:/, keys %$self;
13+
local @{$self}{@ns};
14+
delete @{$self}{@ns};
1315

1416
return $self->SUPER::starttag_XML(@_);
1517
}
1618

19+
sub element_class {
20+
$_[0]->{_element_class} || __PACKAGE__;
21+
}
22+
1723
1;

t/lib/MetaCPAN/Web/Test/HTML5/TreeBuilder.pm

Lines changed: 53 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,15 @@ use MetaCPAN::Web::Test::HTML5::Element::SVG (); ## no perlimports
88

99
use constant SVG_CLASS => 'MetaCPAN::Web::Test::HTML5::Element::SVG';
1010

11+
use MetaCPAN::Web::Test::HTML5::Element::MathML;
12+
use constant MATHML_CLASS => 'MetaCPAN::Web::Test::HTML5::Element::MathML';
13+
14+
my @html5_elements = qw(
15+
article audio aside bdi datalist canvas details dialog embed figcaption
16+
figure footer header main mark menuitem meter nav output progress rp rt
17+
ruby section source summary svg time track video wbr
18+
);
19+
1120
my @svg_elements = qw(
1221
a altGlyph altGlyphDef altGlyphItem animate animateColor animateMotion
1322
animateTransform audio canvas circle clipPath color-profile cursor defs desc
@@ -23,65 +32,58 @@ my @svg_elements = qw(
2332
switch symbol text textPath title tref tspan unknown use video view vkern
2433
);
2534

35+
my @mathml_elements = qw(
36+
annotation-xml annotation maction maligngroup malignmark math menclose
37+
merror mfenced mfrac mglyph mi mlabeledtr mlongdiv mmultiscripts mn mo
38+
mover mpadded mphantom mroot mrow ms mscarries mscarry msgroup msline
39+
mspace msqrt msrow mstack mstyle msub msubsup msup mtable mtd mtext mtr
40+
munder munderover semantics
41+
);
42+
2643
sub start {
2744
my $self = shift;
2845
my $e;
29-
my $pos = $self->{'_pos'} || $self;
30-
if ( !$pos->isa(SVG_CLASS) ) {
31-
local $HTML::TreeBuilder::isBodyElement{article} = 1;
32-
local $HTML::TreeBuilder::isBodyElement{audio} = 1;
33-
local $HTML::TreeBuilder::isBodyElement{aside} = 1;
34-
local $HTML::TreeBuilder::isBodyElement{bdi} = 1;
35-
local $HTML::TreeBuilder::isBodyElement{datalist} = 1;
36-
local $HTML::TreeBuilder::isBodyElement{canvas} = 1;
37-
local $HTML::TreeBuilder::isBodyElement{details} = 1;
38-
local $HTML::TreeBuilder::isBodyElement{dialog} = 1;
39-
local $HTML::TreeBuilder::isBodyElement{embed} = 1;
40-
local $HTML::TreeBuilder::isBodyElement{figcaption} = 1;
41-
local $HTML::TreeBuilder::isBodyElement{figure} = 1;
42-
local $HTML::TreeBuilder::isBodyElement{footer} = 1;
43-
local $HTML::TreeBuilder::isBodyElement{header} = 1;
44-
local $HTML::TreeBuilder::isBodyElement{main} = 1;
45-
local $HTML::TreeBuilder::isBodyElement{mark} = 1;
46-
local $HTML::TreeBuilder::isBodyElement{menuitem} = 1;
47-
local $HTML::TreeBuilder::isBodyElement{meter} = 1;
48-
local $HTML::TreeBuilder::isBodyElement{nav} = 1;
49-
local $HTML::TreeBuilder::isBodyElement{output} = 1;
50-
local $HTML::TreeBuilder::isBodyElement{progress} = 1;
51-
local $HTML::TreeBuilder::isBodyElement{rp} = 1;
52-
local $HTML::TreeBuilder::isBodyElement{rt} = 1;
53-
local $HTML::TreeBuilder::isBodyElement{ruby} = 1;
54-
local $HTML::TreeBuilder::isBodyElement{section} = 1;
55-
local $HTML::TreeBuilder::isBodyElement{source} = 1;
56-
local $HTML::TreeBuilder::isBodyElement{summary} = 1;
57-
local $HTML::TreeBuilder::isBodyElement{svg} = 1;
58-
local $HTML::TreeBuilder::isBodyElement{template} = 1;
59-
local $HTML::TreeBuilder::isBodyElement{time} = 1;
60-
local $HTML::TreeBuilder::isBodyElement{track} = 1;
61-
local $HTML::TreeBuilder::isBodyElement{video} = 1;
62-
local $HTML::TreeBuilder::isBodyElement{wbr} = 1;
63-
$e = $self->SUPER::start(@_);
46+
my $pos = $self->pos;
47+
48+
my $type = 'html';
6449

65-
if ( $e->tag eq 'svg' ) {
66-
bless $e, SVG_CLASS;
50+
if ( $pos->isa(SVG_CLASS) ) {
51+
$type = 'svg';
52+
}
53+
elsif ( $pos->isa(MATHML_CLASS) ) {
54+
$type = 'mathml';
55+
if ( $pos->tag eq 'annotation-xml') {
56+
if (my $encoding = $pos->attr('encoding')) {
57+
if ($encoding eq 'SVG1.1' || $encoding eq 'image/svg+xml') {
58+
$type = 'svg';
59+
}
60+
elsif ($encoding eq 'text/html') {
61+
$type = 'html';
62+
}
63+
}
6764
}
6865
}
69-
else {
70-
local %HTML::TreeBuilder::isHeadElement = ();
71-
local %HTML::TreeBuilder::isHeadOrBodyElement = ();
72-
local %HTML::TreeBuilder::isBodyElement = map +( $_ => 1 ),
73-
@svg_elements;
74-
$e = $self->SUPER::start(@_);
75-
bless $e, SVG_CLASS;
66+
67+
local %HTML::TreeBuilder::isHeadElement
68+
= %HTML::TreeBuilder::isHeadElement;
69+
local %HTML::TreeBuilder::isHeadOrBodyElement
70+
= %HTML::TreeBuilder::isHeadOrBodyElement;
71+
local %HTML::TreeBuilder::isBodyElement
72+
= %HTML::TreeBuilder::isBodyElement,
73+
map +( $_ => 1 ), @html_elements;
74+
75+
if ($type eq 'svg') {
76+
%HTML::TreeBuilder::isHeadElement = ();
77+
%HTML::TreeBuilder::isHeadOrBodyElement = ();
78+
%HTML::TreeBuilder::isBodyElement = map +( $_ => 1 ), @svg_elements;
79+
}
80+
elsif ($type eq 'mathml') {
81+
%HTML::TreeBuilder::isHeadElement = ();
82+
%HTML::TreeBuilder::isHeadOrBodyElement = ();
83+
%HTML::TreeBuilder::isBodyElement = map +( $_ => 1 ), @mathml_elements;
7684
}
77-
return $e;
78-
}
7985

80-
sub _valid_name {
81-
my ( $self, $attr ) = @_;
82-
$attr =~ s/^xlink://;
83-
return 1 if $attr =~ /\A[krxyz]\z/;
84-
$self->SUPER::_valid_name($attr);
86+
return $self->SUPER::start(@_);
8587
}
8688

8789
1;

0 commit comments

Comments
 (0)