Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package SVG::DOM; |
2 | use strict; | |
3 | ||
4 | use vars qw($VERSION); | |
5 | $VERSION = "1.01"; | |
6 | #29.01.03 RO added setAttributes and setAttribute | |
7 | ||
8 | # this module extends SVG::Element | |
9 | package SVG::Element; | |
10 | ||
11 | #----------------- | |
12 | # sub getFirstChild | |
13 | ||
14 | sub getFirstChild ($) { | |
15 | my $self=shift; | |
16 | ||
17 | if (my @children=$self->getChildren) { | |
18 | return $children[0]; | |
19 | } | |
20 | return undef; | |
21 | } | |
22 | ||
23 | #----------------- | |
24 | # sub getChildIndex | |
25 | # return the array index of this element in the parent | |
26 | # or the passed list (if there is one). | |
27 | ||
28 | sub getChildIndex ($;@) { | |
29 | my ($self,@children)=@_; | |
30 | ||
31 | unless (@children) { | |
32 | my $parent=$self->getParent(); | |
33 | @children=$parent->getChildren(); | |
34 | return undef unless @children; | |
35 | } | |
36 | ||
37 | for my $index (0..$#children) { | |
38 | return $index if $children[$index]==$self; | |
39 | } | |
40 | ||
41 | return undef; | |
42 | } | |
43 | ||
44 | #----------------- | |
45 | # sub getChildAtIndex | |
46 | # return the element at the specified index | |
47 | # (the index can be negative) | |
48 | ||
49 | sub getChildAtIndex ($$;@) { | |
50 | my ($self,$index,@children)=@_; | |
51 | ||
52 | unless (@children) { | |
53 | my $parent=$self->getParent(); | |
54 | @children=$parent->getChildren(); | |
55 | return undef unless @children; | |
56 | } | |
57 | ||
58 | return $children[$index]; | |
59 | } | |
60 | ||
61 | #----------------- | |
62 | # sub getNextSibling | |
63 | ||
64 | sub getNextSibling ($) { | |
65 | my $self=shift; | |
66 | ||
67 | if (my $parent=$self->getParent) { | |
68 | my @children=$parent->getChildren(); | |
69 | my $index=$self->getChildIndex(@children); | |
70 | if (defined $index and scalar(@children)>$index) { | |
71 | return $children[$index+1]; | |
72 | } | |
73 | } | |
74 | ||
75 | return undef; | |
76 | } | |
77 | ||
78 | ||
79 | #----------------- | |
80 | # sub getPreviousSibling | |
81 | ||
82 | sub getPreviousSibling ($) { | |
83 | my $self=shift; | |
84 | ||
85 | if (my $parent=$self->getParent) { | |
86 | my @children=$parent->getChildren(); | |
87 | my $index=$self->getChildIndex(@children); | |
88 | if ($index) { | |
89 | return $children[$index-1]; | |
90 | } | |
91 | } | |
92 | ||
93 | return undef; | |
94 | } | |
95 | ||
96 | #----------------- | |
97 | # sub getLastChild | |
98 | ||
99 | sub getLastChild ($) { | |
100 | my $self=shift; | |
101 | ||
102 | if (my @children=$self->getChildren) { | |
103 | return $children[-1]; | |
104 | } | |
105 | ||
106 | return undef; | |
107 | } | |
108 | ||
109 | #----------------- | |
110 | # sub getChildren | |
111 | ||
112 | sub getChildren ($) { | |
113 | my $self=shift; | |
114 | ||
115 | if ($self->{-childs}) { | |
116 | if (wantarray) { | |
117 | return @{$self->{-childs}}; | |
118 | } | |
119 | return $self->{-childs}; | |
120 | } | |
121 | ||
122 | return wantarray?():undef; | |
123 | } | |
124 | *getChildElements=\&getChildren; | |
125 | *getChildNodes=\&getChildren; | |
126 | ||
127 | #----------------- | |
128 | ||
129 | sub hasChildren ($) { | |
130 | my $self=shift; | |
131 | ||
132 | if (exists $self->{-childs}) { | |
133 | if (scalar @{$self->{-childs}}) { | |
134 | return 1; | |
135 | } | |
136 | } | |
137 | ||
138 | return 0; | |
139 | } | |
140 | *hasChildElements=\&hasChildren; | |
141 | *hasChildNodes=\&hasChildren; | |
142 | ||
143 | #----------------- | |
144 | # sub getParent / getParentElement | |
145 | # return the ref of the parent of the current node | |
146 | ||
147 | sub getParent ($) { | |
148 | my $self=shift; | |
149 | ||
150 | if ($self->{-parent}) { | |
151 | return $self->{-parent}; | |
152 | } | |
153 | ||
154 | return undef; | |
155 | } | |
156 | *getParentElement=\&getParent; | |
157 | *getParentNode=\&getParent; | |
158 | ||
159 | #----------------- | |
160 | # sub getParents / getParentElements | |
161 | ||
162 | sub getParents { | |
163 | my $self=shift; | |
164 | ||
165 | my $parent=$self->{-parent}; | |
166 | return undef unless $parent; | |
167 | ||
168 | my @parents; | |
169 | while ($parent) { | |
170 | push @parents,$parent; | |
171 | $parent=$parent->{-parent}; | |
172 | } | |
173 | ||
174 | return @parents; | |
175 | } | |
176 | *getParentElements=\&getParents; | |
177 | *getParentNodes=\&getParents; | |
178 | *getAncestors=\&getParents; | |
179 | ||
180 | #----------------- | |
181 | # sub isAncestor | |
182 | ||
183 | sub isAncestor ($$) { | |
184 | my ($self,$descendant)=@_; | |
185 | ||
186 | my @parents=$descendant->getParents(); | |
187 | foreach my $parent (@parents) { | |
188 | return 1 if $parent==$self; | |
189 | } | |
190 | ||
191 | return 0; | |
192 | } | |
193 | ||
194 | #----------------- | |
195 | # sub isDescendant | |
196 | ||
197 | sub isDescendant ($$) { | |
198 | my ($self,$ancestor)=@_; | |
199 | ||
200 | my @parents=$self->getParents(); | |
201 | foreach my $parent (@parents) { | |
202 | return 1 if $parent==$ancestor; | |
203 | } | |
204 | ||
205 | return 0; | |
206 | } | |
207 | ||
208 | #----------------- | |
209 | # sub getSiblings | |
210 | ||
211 | sub getSiblings ($) { | |
212 | my $self=shift; | |
213 | ||
214 | if (my $parent=$self->getParent) { | |
215 | return $parent->getChildren(); | |
216 | } | |
217 | ||
218 | return wantarray?():undef; | |
219 | } | |
220 | ||
221 | #----------------- | |
222 | # sub hasSiblings | |
223 | ||
224 | sub hasSiblings ($) { | |
225 | my $self=shift; | |
226 | ||
227 | if (my $parent=$self->getParent) { | |
228 | my $siblings=scalar($parent->getChildren); | |
229 | return 1 if $siblings>=2; | |
230 | } | |
231 | ||
232 | return undef; | |
233 | } | |
234 | ||
235 | #----------------- | |
236 | # sub getElementName / getType | |
237 | ||
238 | sub getElementName ($) { | |
239 | my $self=shift; | |
240 | ||
241 | if (exists $self->{-name}) { | |
242 | return $self->{-name}; | |
243 | } | |
244 | ||
245 | return undef; | |
246 | } | |
247 | *getType=\&getElementName; | |
248 | *getElementType=\&getElementName; | |
249 | *getTagName=\&getElementName; | |
250 | *getTagType=\&getElementName; | |
251 | *getNodeName=\&getElementName; | |
252 | *getNodeType=\&getElementName; | |
253 | ||
254 | #----------------- | |
255 | # sub getElements | |
256 | # get all elements of the specified type | |
257 | # if none is specified, get all elements in document. | |
258 | ||
259 | sub getElements ($;$) { | |
260 | my ($self,$element)=@_; | |
261 | ||
262 | return undef unless exists $self->{-docref}; | |
263 | return undef unless exists $self->{-docref}->{-elist}; | |
264 | ||
265 | my $elist=$self->{-docref}->{-elist}; | |
266 | if (defined $element) { | |
267 | if (exists $elist->{$element}) { | |
268 | return wantarray?@{$elist->{$element}}: | |
269 | $elist->{$element}; | |
270 | } | |
271 | return wantarray?():undef; | |
272 | } else { | |
273 | my @elements; | |
274 | foreach my $element_type (keys %$elist) { | |
275 | push @elements,@{$elist->{$element_type}}; | |
276 | } | |
277 | return wantarray?@elements:\@elements; | |
278 | } | |
279 | } | |
280 | ||
281 | # forces the use of the second argument for element name | |
282 | sub getElementsByName ($$) { | |
283 | return shift->getElements(shift); | |
284 | } | |
285 | *getElementsByType=\&getElementsByName; | |
286 | ||
287 | #----------------- | |
288 | sub getElementNames ($) { | |
289 | my $self=shift; | |
290 | ||
291 | my @types=keys %{$self->{-docref}->{-elist}}; | |
292 | ||
293 | return wantarray?@types:\@types; | |
294 | } | |
295 | *getElementTypes=\&getElementNames; | |
296 | ||
297 | #----------------- | |
298 | # sub getElementID | |
299 | ||
300 | sub getElementID ($) { | |
301 | my $self=shift; | |
302 | ||
303 | if (exists $self->{id}) { | |
304 | return $self->{id}; | |
305 | } | |
306 | ||
307 | return undef; | |
308 | } | |
309 | ||
310 | #----------------- | |
311 | # sub getElementByID / getElementbyID | |
312 | ||
313 | sub getElementByID ($$) { | |
314 | my ($self,$id)=@_; | |
315 | ||
316 | return undef unless defined($id); | |
317 | my $idlist=$self->{-docref}->{-idlist}; | |
318 | if (exists $idlist->{$id}) { | |
319 | return $idlist->{$id}; | |
320 | } | |
321 | ||
322 | return undef; | |
323 | } | |
324 | *getElementbyID=\&getElementByID; | |
325 | ||
326 | #----------------- | |
327 | # sub getAttribute | |
328 | # see also SVG::attrib() | |
329 | ||
330 | sub getAttribute ($$) { | |
331 | my ($self,$attr)=@_; | |
332 | ||
333 | if (exists $self->{$attr}) { | |
334 | return $self->{$attr}; | |
335 | } | |
336 | ||
337 | return undef; | |
338 | } | |
339 | ||
340 | #----------------- | |
341 | # sub getAttributes | |
342 | ||
343 | sub getAttributes ($) { | |
344 | my $self=shift; | |
345 | ||
346 | my $out = {}; | |
347 | foreach my $i (keys %$self) { | |
348 | $out->{$i} = $self->{$i} unless $i =~ /^-/; | |
349 | } | |
350 | ||
351 | return wantarray?%{$out}:$out; | |
352 | } | |
353 | ||
354 | ||
355 | #----------------- | |
356 | # sub setAttribute | |
357 | ||
358 | sub setAttributes ($$) { | |
359 | my ($self,$attr) = @_; | |
360 | foreach my $i (keys %$attr) { | |
361 | $self->attrib($i,$attr->{$i}); | |
362 | } | |
363 | } | |
364 | ||
365 | #----------------- | |
366 | # sub setAttribute | |
367 | ||
368 | sub setAttribute ($$;$) { | |
369 | my ($self,$att,$val) = @_; | |
370 | $self->attrib($att,$val); | |
371 | } | |
372 | #----------------- | |
373 | # sub getCDATA / getCdata / getData | |
374 | ||
375 | sub getCDATA ($) { | |
376 | my $self=shift; | |
377 | ||
378 | if (exists $self->{-cdata}) { | |
379 | return $self->{-cdata}; | |
380 | } | |
381 | ||
382 | return undef; | |
383 | } | |
384 | *getCdata=\&getCDATA; | |
385 | *getData=\&getCDATA; | |
386 | ||
387 | #------------------------------------------------------------------------------- | |
388 | ||
389 | =pod | |
390 | ||
391 | =head1 NAME | |
392 | ||
393 | SVG::DOM - A library of DOM (Document Object Model) methods for SVG objects. | |
394 | ||
395 | =head1 SUMMARY | |
396 | ||
397 | SVG::DOM provides a selection of methods for accessing and manipulating SVG | |
398 | elements through DOM-like methods such as getElements, getChildren, getNextSibling | |
399 | and so on. | |
400 | ||
401 | Currently only methods that provide read operations are supported. Methods to | |
402 | manipulate SVG elements will be added in a future release. | |
403 | ||
404 | =head1 SYNOPSIS | |
405 | ||
406 | my $svg=new SVG(id=>"svg_dom_synopsis", width=>"100", height=>"100"); | |
407 | my %attributes=$svg->getAttributes; | |
408 | ||
409 | my $group=$svg->group(id=>"group_1"); | |
410 | my $name=$group->getElementName; | |
411 | my $id=$group->getElementID; | |
412 | ||
413 | $group->circle(id=>"circle_1", cx=>20, cy=>20, r=>5, fill=>"red"); | |
414 | my $rect=$group->rect(id=>"rect_1", x=>10, y=>10, width=>20, height=>30); | |
415 | my $width=$rect->getAttribute("width"); | |
416 | ||
417 | my $has_children=$group->hasChildren(); | |
418 | my @children=$group->getChildren(); | |
419 | ||
420 | my $kid=$group->getFirstChild(); | |
421 | do { | |
422 | print $kid->xmlify(); | |
423 | } while ($kid=$kid->getNextSibling); | |
424 | ||
425 | my @ancestors=$rect->getParents(); | |
426 | my $is_ancestor=$group->isAncestor($rect); | |
427 | my $is_descendant=$rect->isDescendant($svg); | |
428 | ||
429 | my @rectangles=$svg->getElements("rect"); | |
430 | my $allelements_arrayref=$svg->getElements(); | |
431 | ||
432 | ...and so on... | |
433 | ||
434 | =head1 METHODS | |
435 | ||
436 | =head2 @elements = $obj->getElements($element_name) | |
437 | ||
438 | Return a list of all elements with the specified name (i.e. type) in the document. If | |
439 | no element name is provided, returns a list of all elements in the document. | |
440 | In scalar context returns an array reference. | |
441 | ||
442 | =head2 @children = $obj->getChildren() | |
443 | ||
444 | Return a list of all children defined on the current node, or undef if there are no children. | |
445 | In scalar context returns an array reference. | |
446 | ||
447 | Alias: getChildElements(), getChildNodes() | |
448 | ||
449 | =head2 @children = $obj->hasChildren() | |
450 | ||
451 | Return 1 if the current node has children, or 0 if there are no children. | |
452 | ||
453 | Alias: hasChildElements, hasChildNodes() | |
454 | ||
455 | =head2 $ref = $obj->getFirstChild() | |
456 | ||
457 | Return the first child element of the current node, or undef if there are no children. | |
458 | ||
459 | =head2 $ref = $obj->getLastChild() | |
460 | ||
461 | Return the last child element of the current node, or undef if there are no children. | |
462 | ||
463 | =head2 $ref = $obj->getSiblings() | |
464 | ||
465 | Return a list of all children defined on the parent node, containing the current node. | |
466 | ||
467 | =head2 $ref = $obj->getNextSibling() | |
468 | ||
469 | Return the next child element of the parent node, or undef if this is the last child. | |
470 | ||
471 | =head2 $ref = $obj->getPreviousSibling() | |
472 | ||
473 | Return the previous child element of the parent node, or undef if this is the first child. | |
474 | ||
475 | =head2 $index = $obj->getChildIndex() | |
476 | ||
477 | Return the place of this element in the parent node's list of children, starting from 0. | |
478 | ||
479 | =head2 $element = $obj->getChildAtIndex($index) | |
480 | ||
481 | Returns the child element at the specified index in the parent node's list of children. | |
482 | ||
483 | =head2 $ref = $obj->getParentElement() | |
484 | ||
485 | Return the parent of the current node. | |
486 | ||
487 | Alias: getParent() | |
488 | ||
489 | =head2 @refs = $obj->getParentElements() | |
490 | ||
491 | Return a list of the parents of the current node, starting from the immediate parent. The | |
492 | last member of the list should be the document element. | |
493 | ||
494 | Alias: getParents() | |
495 | ||
496 | =head2 $name = $obj->getElementName() | |
497 | ||
498 | Return a string containing the name (i.e. the type, not the ID) of an element. | |
499 | ||
500 | Alias: getType(), getTagName(), getNodeName() | |
501 | ||
502 | =head2 $ref = $svg->getElementByID($id) | |
503 | ||
504 | Alias: getElementbyID() | |
505 | ||
506 | Return a reference to the element which has ID $id, or undef if no element with this ID exists. | |
507 | ||
508 | =head2 $id = $obj->getElementID() | |
509 | ||
510 | Return a string containing the ID of the current node, or undef if it has no ID. | |
511 | ||
512 | =head2 $ref = $obj->getAttributes() | |
513 | ||
514 | Return a hash reference of attribute names and values for the current node. | |
515 | ||
516 | =head2 $value = $obj->getAttribute($name); | |
517 | ||
518 | Return the string value attribute value for an attribute of name $name. | |
519 | ||
520 | =head2 $ref = $obj->setAttributes({name1=>$value1,name2=>undef,name3=>$value3}) | |
521 | ||
522 | Set a set of attributes. If $value is undef, deletes the attribute. | |
523 | ||
524 | =head2 $value = $obj->setAttribute($name,$value); | |
525 | ||
526 | Set attribute $name to $value. If $value is undef, deletes the attribute. | |
527 | ||
528 | =head2 $cdata = $obj->getCDATA() | |
529 | ||
530 | Return the cannonical data (i.e. textual content) of the current node. | |
531 | ||
532 | Alias: getCdata(), getData() | |
533 | ||
534 | =head2 $boolean = $obj->isAncestor($element) | |
535 | ||
536 | Returns 1 if the current node is an ancestor of the specified element, otherwise 0. | |
537 | ||
538 | =head2 $boolean = $obj->isDescendant($element) | |
539 | ||
540 | Returns 1 if the current node is a descendant of the specified element, otherwise 0. | |
541 | ||
542 | =head1 AUTHOR | |
543 | ||
544 | Ronan Oger, ronan@roasp.com | |
545 | ||
546 | =head1 SEE ALSO | |
547 | ||
548 | perl(1), L<SVG>, L<SVG::XML>, L<SVG::Element>, L<SVG::Parser>, L<SVG::Manual> | |
549 | ||
550 | <http://www.roasp.com/> | |
551 | ||
552 | <http://www.perlsvg.com/> | |
553 | ||
554 | <http://www.roitsystems.com/> | |
555 | ||
556 | <http://www.w3c.org/Graphics/SVG/> | |
557 | ||
558 | =cut | |
559 | ||
560 | 1; | |
561 |