File Coverage

blib/lib/CSS/DOM.pm

Criterion	Covered	Total	%
statement	98	122	80.3
branch	33	50	66.0
condition	7	11	63.6
subroutine	32	32	100.0
pod	19	19	100.0
total	189	234	80.7

line	stmt	bran	cond	sub	pod	time	code
1							package CSS::DOM;
2
3	23			23		319557	use 5.008002;
	23					99
4
5							$VERSION = '0.17';
6
7							use # to keep CPANTS happy :-)
8	23			23		95	strict;
	23					37
	23					425
9							use # same here
10	23			23		94	warnings;
	23					39
	23					659
11
12							use CSS::DOM::Exception
13	23			23		3042	'SYNTAX_ERR' ,'HIERARCHY_REQUEST_ERR', 'INDEX_SIZE_ERR';
	23					35
	23					1223
14	23			23		130	use CSS::DOM::Constants 'STYLE_RULE';
	23					29
	23					781
15	23			23		97	use Scalar::Util 'weaken';
	23					29
	23					1547
16
17							require CSS::DOM::RuleList;
18
19	23					2155	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		122	};
	23					363
30	23			23		118	{ no strict; delete @CSS::DOM::{_constants => keys %{our $_constants}} }
	23					39
	23					10699
31
32
33							# NON-DOM METHODS
34
35							# classy method
36							sub new {
37	101			101	1	9996	my $self = bless[],shift;
38	101					206	my %args = @_;
39	101	100				239	if(defined(my $arg = delete $args{url_fetcher})) {
40	9					23	$self->[fetc] = $arg;
41							}
42	101					195	$self->[prpp] = delete $args{property_parser};
43	101					243	$self;
44							}
45
46							# objectionable methods
47							sub url_fetcher {
48	30			30	1	42	my $old = (my$ self = shift)->[fetc];
49	30	100				54	$ self -> [ fetc ] = shift if @ _ ;
50	30					45	$old
51							}
52	87			87	1	227	sub property_parser { shift->[prpp] }
53
54
55							# FUNCTIONS
56
57							sub parse {
58	65			65	1	22516	require CSS::DOM::Parser;
59	65					229	goto &CSS::DOM::Parser::parse;
60							}
61
62							sub compute_style {
63	1			1	1	4	my %args = @_;
64							# ~~~ for now we just ignore medium/height/width/ppi. We need to
65							# support those, too.
66
67	1					5	require CSS::DOM::Style;
68	1					3	my $style = new CSS::DOM::Style;
69
70	1					2	my $elem = delete $args{element};
71	1					2	my $pseudo = delete $args{pseudo};
72	1	50				2	$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	1					0	my @important_spec;
105	1					0	my @sheets;
106	1	50				2	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				5	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				9	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					3	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		136	no warnings 'uninitialized';
	23					69
	23					2767
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					8	my $sty = $elem->style;
156	1					11	for(0..$sty->length-1) {
157	1					2	my $p = $sty->item($_);
158	1	50				11	my $spec = (
159							$sty->getPropertyPriority($p)
160							=~
161							/^important\z/i
162							? "\4" : "\3"
163							) . "\1\0\0\0";
164	23			23		140	no warnings 'uninitialized';
	23					40
	23					6640
165							$spec ge $specificity{$p} and
166							$style->setProperty(
167							$p, $sty->getPropertyValue($p)
168							),
169	1	50				4	$specificity{$p} = $spec;
170							}
171
172	1					5	return $style;
173							}
174
175
176							# DOM STUFF:
177
178							# StyleSheet interface:
179
180	1			1	1	4	sub type { 'text/css' }
181							sub disabled {
182	4			4	1	8	my $old = (my $self = shift) ->[dsbl];
183	4	100				11	@_ and $self->[dsbl] = shift;
184	4					9	$old
185							};
186	5	100		5	1	28	sub ownerNode { defined $_[0][node]?$_[0][node]:() }
187	3			3	1	511	sub set_ownerNode { weaken($_[0]->[node] = $_[1]) }
188	2	100		2	1	498	sub parentStyleSheet { shift->[prsh]\|\|() }
189	9			9		32	sub _set_parentStyleSheet { weaken($_[0]->[prsh] = $_[1]) }
190	1			1	1	6	sub href { shift->[hrfe] }
191	1			1	1	472	sub set_href { $_[0]->[hrfe] = $_[1] }
192	23			23		142	sub title { no warnings 'uninitialized';
	23					61
	23					9544
193	1		50	1	1	6	''.(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	816	wantarray ? @{$_[0]->[medi]\|\|return} :
	1	100				7
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	13	shift->[ownr] \|\| ()
209							}
210							sub _set_ownerRule {
211	10			10		37	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	2417	? @{shift->[ruls]\|\|return}
	10	100				67
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	1793	my ($self, $rule_string, $index) = @_;
228
229	136					966	require CSS::DOM::Parser;
230	136					174	my ($at,$rule);
231							{
232	136					147	local *@;
	136					278
233	136					350	$rule = CSS::DOM::Parser::parse_statement(
234							$rule_string,$self
235							);
236	136					296	$at = $@
237							}
238	136	100				247	$at and die new CSS::DOM::Exception SYNTAX_ERR, $at;
239
240							# $rule->_set_parentStyleSheet($self);
241
242	130					239	my $list = $self->cssRules; # cssRules takes care of \|\|=
243	130					279	splice @$list, $index, 0, $rule;
244
245	130	100				416	$index < 0 ? $#$list + $index :
		100
246							$index <= $#$list ? $index :
247							$#$list
248							}
249
250							sub deleteRule {
251	2			2	1	8	my ($self,$index) = @_;
252	2					3	my $list = $self->[ruls];
253	2	100				10	$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					2	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	1717	my($feature,$v) = (lc $_[1], $_[2]);
271							exists $features{$feature} and
272	24	50	66			254	!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.17
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