File Coverage

blib/lib/CSS/DOM.pm

Criterion	Covered	Total	%
statement	96	122	78.6
branch	33	50	66.0
condition	7	11	63.6
subroutine	32	32	100.0
pod	19	19	100.0
total	187	234	79.9

line	stmt	bran	cond	sub	pod	time	code
1							package CSS::DOM;
2
3	23			23		143328	use 5.008002;
	23					87
4
5							$VERSION = '0.16';
6
7							use # to keep CPANTS happy :-)
8	23			23		122	strict;
	23					41
	23					556
9							use # same here
10	23			23		110	warnings;
	23					43
	23					790
11
12							use CSS::DOM::Exception
13	23			23		4872	'SYNTAX_ERR' ,'HIERARCHY_REQUEST_ERR', 'INDEX_SIZE_ERR';
	23					46
	23					2323
14	23			23		176	use CSS::DOM::Constants 'STYLE_RULE';
	23					43
	23					1072
15	23			23		148	use Scalar::Util 'weaken';
	23					46
	23					2662
16
17							require CSS::DOM::RuleList;
18
19	23					3489	use constant 1.03 our $_constants = {
20							ruls => 0,
21							ownr => 1, # owner rule
22							node => 2, # owner node
23							dsbl => 3,
24							hrfe => 4,
25							medi => 5,
26							fetc => 6, # url fetcher
27							prsh => 7, # parent sheet
28							prpp => 8, # property parser
29	23			23		557	};
	23					379
30	23			23		113	{ no strict; delete @CSS::DOM::{_constants => keys %{our $_constants}} }
	23					49
	23					14041
31
32
33							# NON-DOM METHODS
34
35							# classy method
36							sub new {
37	101			101	1	10735	my $self = bless[],shift;
38	101					320	my %args = @_;
39	101	100				385	if(defined(my $arg = delete $args{url_fetcher})) {
40	9					31	$self->[fetc] = $arg;
41							}
42	101					290	$self->[prpp] = delete $args{property_parser};
43	101					416	$self;
44							}
45
46							# objectionable methods
47							sub url_fetcher {
48	30			30	1	64	my $old = (my$ self = shift)->[fetc];
49	30	100				84	$ self -> [ fetc ] = shift if @ _ ;
50	30					91	$old
51							}
52	87			87	1	391	sub property_parser { shift->[prpp] }
53
54
55							# FUNCTIONS
56
57							sub parse {
58	65			65	1	29541	require CSS::DOM::Parser;
59	65					332	goto &CSS::DOM::Parser::parse;
60							}
61
62							sub compute_style {
63	1			1	1	9	my %args = @_;
64							# ~~~ for now we just ignore medium/height/width/ppi. We need to
65							# support those, too.
66
67	1					7	require CSS::DOM::Style;
68	1					5	my $style = new CSS::DOM::Style;
69
70	1					3	my $elem = delete $args{element};
71	1					2	my $pseudo = delete $args{pseudo};
72	1	50				5	$pseudo && $pseudo =~ s/^::?//;
73
74							# The specificity returned by the style rule is a three-character
75							# string representing the number of id, attr, and elem selector
76							# components (e.g., li.red.level gives "\0\2\1"). We prefix that
77							# with two more chars, to make:
78							# XXXXX
79							# \|\|\|\|`-- element
80							# \|\|\|`-- attribute
81							# \|\|`-- id
82							# \|`-- style attribute
83							# `-- style sheet
84
85							# ‘Style attribute’ is \1 or \0, indicating whether the CSS proper-
86							# ties originate from a style attribute. ‘Style sheet’ is
87							# as follows:
88							# "\0") user agent normal declarations
89							# "\1") user normal declarations
90							# "\2") author normal "
91							# "\3") user agent !important declarations
92							# "\4") author !important "
93							# "\5") user " "
94
95							# The individual properties are sorted according to this scheme.
96
97
98							# ~~~ This isn’t the most efficient algorithm. Perhaps we can cache
99							# some of this.
100
101	1					2	my %specificity; # per property
102
103							my @normal_spec;
104	0					0	my @important_spec;
105	0					0	my @sheets;
106	1	50				3	if(defined $args{ua_sheet}) {
107	0					0	push @normal_spec, chr 0;
108	0					0	push @important_spec, chr 3;
109	0					0	push @sheets, delete $args{ua_sheet};
110							}
111	1	50				4	if(defined $args{user_sheet}) {
112	0					0	push @normal_spec, chr 1;
113	0					0	push @important_spec, chr 5;
114	0					0	push @sheets, delete $args{user_sheet};
115							}
116	1	50				4	if(defined $args{author_sheets}) {
117	0					0	my $s = delete $args{author_sheets};
118	0					0	push @normal_spec, (chr 2) x @$s;
119	0					0	push @important_spec, (chr 4) x @$s;
120	0					0	push @sheets, @$s;
121							}
122	1					5	while(@sheets) {
123	0					0	my $n = shift @normal_spec;
124	0					0	my $i = shift @important_spec;
125	0					0	my $s = shift @sheets;
126	0					0	my @rules = $s->cssRules;
127	0					0	while(@rules) {
128	0					0	my $r = shift @rules;
129	0					0	my $type = $r->type;
130	0	0				0	if($type == STYLE_RULE) {
131							next unless
132	0	0				0	my $specificity = $r->_selector_matches(
133							$elem, $pseudo
134							);
135	0					0	my $sty = $r->style;
136	0					0	for(0..$sty->length-1) {
137	0					0	my $p = $sty->item($_);
138	0	0				0	my $spec = (
139							$sty->getPropertyPriority($p)
140							=~
141							/^important\z/i
142							? $i : $n
143							) . "\0$specificity";
144	23			23		168	no warnings 'uninitialized';
	23					45
	23					3786
145							$spec ge $specificity{$p} and
146							$style->setProperty(
147							$p, $sty->getPropertyValue($p)
148							),
149	0	0				0	$specificity{$p} = $spec;
150							}
151							}
152							}
153							}
154
155	1					23	my $sty = $elem->style;
156	1					15	for(0..$sty->length-1) {
157	1					5	my $p = $sty->item($_);
158	1	50				5	my $spec = (
159							$sty->getPropertyPriority($p)
160							=~
161							/^important\z/i
162							? "\4" : "\3"
163							) . "\1\0\0\0";
164	23			23		120	no warnings 'uninitialized';
	23					56
	23					8353
165							$spec ge $specificity{$p} and
166							$style->setProperty(
167							$p, $sty->getPropertyValue($p)
168							),
169	1	50				9	$specificity{$p} = $spec;
170							}
171
172	1					8	return $style;
173							}
174
175
176							# DOM STUFF:
177
178							# StyleSheet interface:
179
180	1			1	1	5	sub type { 'text/css' }
181							sub disabled {
182	4			4	1	9	my $old = (my $self = shift) ->[dsbl];
183	4	100				14	@_ and $self->[dsbl] = shift;
184	4					17	$old
185							};
186	5	100		5	1	63	sub ownerNode { defined $_[0][node]?$_[0][node]:() }
187	3			3	1	398	sub set_ownerNode { weaken($_[0]->[node] = $_[1]) }
188	2	100		2	1	556	sub parentStyleSheet { shift->[prsh]\|\|() }
189	9			9		38	sub _set_parentStyleSheet { weaken($_[0]->[prsh] = $_[1]) }
190	1			1	1	7	sub href { shift->[hrfe] }
191	1			1	1	437	sub set_href { $_[0]->[hrfe] = $_[1] }
192	23			23		127	sub title { no warnings 'uninitialized';
	23					65
	23					11785
193	1		50	1	1	7	''.(shift->ownerNode \|\| return)->attr('title') }
194
195							# If you find a bug in here, Media.pm’s method probably also needs fixing.
196							sub media {
197	3	50	66	3	1	1011	wantarray ? @{$_[0]->[medi]\|\|return} :
	1	100				10
198							($_[0]->[medi] \|\|= (
199							require CSS::DOM::MediaList,
200							CSS::DOM::MediaList->new
201							))
202							}
203
204
205							# CSSStyleSheet interface:
206
207							sub ownerRule {
208	3	100		3	1	22	shift->[ownr] \|\| ()
209							}
210							sub _set_ownerRule {
211	10			10		45	weaken($_[0]->[ownr] = $_[1]);
212							}
213
214							# If you find a bug in the following three methods, Media.pm’s methods
215							# probably also need fixing.
216							sub cssRules {
217							wantarray
218	405	50	66	405	1	3408	? @{shift->[ruls]\|\|return}
	10	100				80
219							: (shift->[ruls]\|\|=new CSS::DOM::RuleList);
220							}
221
222							sub insertRule { # This is supposed to raise an HIERARCHY_REQUEST_ERR if
223							# the rule cannot be inserted at the specified index;
224							# e.g., if an @import rule is inserted after a stan-
225							# dard rule. But we don’t do that, in order to maintain
226							# future compatibility.
227	136			136	1	1947	my ($self, $rule_string, $index) = @_;
228
229	136					1336	require CSS::DOM::Parser;
230	136					212	my ($at,$rule);
231							{
232	136					192	local *@;
	136					375
233	136					428	$rule = CSS::DOM::Parser::parse_statement(
234							$rule_string,$self
235							);
236	136					356	$at = $@
237							}
238	136	100				370	$at and die new CSS::DOM::Exception SYNTAX_ERR, $at;
239
240							# $rule->_set_parentStyleSheet($self);
241
242	130					337	my $list = $self->cssRules; # cssRules takes care of \|\|=
243	130					300	splice @$list, $index, 0, $rule;
244
245	130	100				658	$index < 0 ? $#$list + $index :
		100
246							$index <= $#$list ? $index :
247							$#$list
248							}
249
250							sub deleteRule {
251	2			2	1	20	my ($self,$index) = @_;
252	2					4	my $list = $self->[ruls];
253	2	100				14	$index > $#$list and die CSS::DOM::Exception->new(
254							INDEX_SIZE_ERR,
255							"The index passed to deleteRule ($index) is too large"
256							);
257	1					3	splice @$list, $index, 1;
258							return # nothing;
259	1					7	}
260
261
262
263							my %features = (
264							stylesheets => { '2.0' => 1 },
265							# css => { '2.0' => 1 },
266							css2 => { '2.0' => 1 },
267							);
268
269							sub hasFeature {
270	24			24	1	896	my($feature,$v) = (lc $_[1], $_[2]);
271							exists $features{$feature} and
272	24	50	66			206	!defined $v \|\| exists $features{$feature}{$v};
273							}
274
275							!()__END__()!
276
277							=encoding utf8
278
279							=head1 NAME
280
281							CSS::DOM - Document Object Model for Cascading Style Sheets
282
283							=head1 VERSION
284
285							Version 0.16
286
287							This is an alpha version. The API is still subject to change. Many features
288							have not been implemented yet (but patches would be welcome :-).
289
290							The interface for feeding CSS code to CSS::DOM changed incompatibly in
291							version 0.03.
292
293							=for comment
294							This is an alpha version. If you could please test it and report any bugs
295							(via e-mail), I would be grateful.
296
297							=head1 SYNOPSIS
298
299							use CSS::DOM;
300
301							my $sheet = CSS::DOM::parse( $css_source );
302
303							use CSS::DOM::Style;
304							my $style = CSS::DOM::Style::parse(
305							'background: red; font-size: large'
306							);
307
308							my $other_sheet = new CSS::DOM; # empty
309							$other_sheet->insertRule(
310							'a{ text-decoration: none }',
311							$other_sheet->cssRules->length,
312							);
313							# etc.
314
315							# access DOM properties
316							$other_sheet->cssRules->[0]->selectorText('p'); # change it
317							$style->fontSize; # returns 'large'
318							$style->fontSize('small'); # change it
319
320							=head1 DESCRIPTION
321
322							This set of modules provides the CSS-specific interfaces described in the
323							W3C DOM
324							recommendation.
325
326							The CSS::DOM class itself implements the StyleSheet and CSSStyleSheet DOM
327							interfaces.
328
329							This set of modules has two modes:
330
331							=over
332
333							=item 1
334
335							It can validate property values,
336							ignoring those that are invalid (just like a real web browser), and support shorthand
337							properties. This means you can set font to '13px/15px My Font' and have the
338							font-size, line-height, and font-family properties (among others) set automatically. Also, C will assign 'green'
339							to the color
340							property, 'kakariki' not being a recognised color value.
341
342							=item 2
343
344							It can
345							blithely accept all property assignments as being valid. In the case of
346							C, 'kakariki' will be assigned, since it overrides the previous
347							assignment.
348
349							=back
350
351							These two modes are controlled by the C option to the
352							constructors.
353
354							=head1 CONSTRUCTORS
355
356							=over 4
357
358							=item CSS::DOM::parse( $string )
359
360							This method parses the C<$string> and returns a style sheet object. If you
361							just have a CSS style declaration, e.g., from an HTML C