File Coverage

blib/lib/SGML/Element.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             #
2             # Copyright (C) 1997 Ken MacLeod
3             # See the file COPYING for distribution terms.
4             #
5             # $Id: Element.pm,v 1.2 1998/01/18 00:21:13 ken Exp $
6             #
7              
8              
9             package SGML::Element;
10              
11 1     1   9 use strict;
  1         1  
  1         50  
12 1     1   18605 use Class::Visitor;
  0            
  0            
13              
14             visitor_class 'SGML::Element', 'Class::Visitor::Base',
15             [
16             'contents' => '@', # [0]
17             'gi' => '$', # [1]
18             'attributes' => '@', # [2]
19             ];
20              
21             =head1 NAME
22              
23             SGML::Element - an element of an SGML, XML, or HTML document
24              
25             =head1 SYNOPSIS
26              
27             $element->gi;
28             $element->name;
29             $element->attr ($attr[, $value]);
30             $element->attr_as_string ($attr[, $context, ...]);
31             $element->attributes [($attributes)];
32             $element->contents [($contents)];
33              
34             $element->as_string([$context, ...]);
35              
36             $element->iter;
37              
38             $element->accept($visitor, ...);
39             $element->accept_gi($visitor, ...);
40             $element->children_accept($visitor, ...);
41             $element->children_accept_gi($visitor, ...);
42              
43             =head1 DESCRIPTION
44              
45             An C represents an element in an SGML or XML document.
46             An Element contains a generic identifier, or name, for the element,
47             the elements attributes and the ordered contents of the element.
48              
49             C<$element-Egi> and C<$element-Ename> are synonyms, they
50             return the generic identifier of the element.
51              
52             C<$element-Eattr> returns the value of an attribute, if a second
53             argument is given then that value is assigned to the attribute and
54             returned. The value of an attribute may be an array of scalar or
55             C objects, an C, or an array of
56             C or C objects. C returns
57             C for implied attributes.
58              
59             C<$element-Eattr_as_string> returns the value of an attribute as a
60             string, possibly modified by C<$context>. (XXX undefined results if
61             the attribute is not cdata/sdata.)
62              
63             C<$element-Eattributes> returns a reference to a hash containing
64             the attributes of the element, or undef if there are no attributes
65             defined for for this element. The keys of the hash are the attribute
66             names and the values are as defined above.
67             C<$element-Eattributes($attributes)> assigns the attributes from
68             the hash C<$attributes>. No hash entries are made for implied
69             attributes.
70              
71             C<$element-Econtents> returns a reference to an array containing
72             the children of the element. The contents of the element may contain
73             other elements, scalars, C, C, C,
74             C, or C objects.
75             C<$element-Econtents($contents)> assigns the contents from the
76             array C<$contents>.
77              
78             C<$element-Eas_string> returns the entire hierarchy of this
79             element as a string, possibly modified by C<$context>. See
80             L and L for more detail. (XXX does not expand
81             entities.)
82              
83             C<$element-Eiter> returns an iterator for the element, see
84             C for details.
85              
86             C<$element-Eaccept($visitor[, ...])> issues a call back to
87             Svisit_SGML_Element($element[, ...])>>. See examples
88             C and C for more information.
89              
90             C<$element-Eaccept_gi($visitor[, ...])> issues a call back to
91             Svisit_gi_I($element[, ...])>> where I is the
92             generic identifier of this element. C maps strange
93             characters in the GI to underscore (`_') [XXX more specific].
94              
95             C and C call C and
96             C, respectively, on each object in the element's content.
97              
98             Element handles scalars internally for C,
99             C, and C. For C
100             and C (both), Element calls back with
101             Svisit_scalar($scalar[, ...])>>.
102              
103             For C, Element will use the string unless
104             C<$context-E{cdata_mapper}> is defined, in which case it returns the
105             result of calling the C subroutine with the scalar and
106             the remaining arguments. The actual implementation is:
107              
108             &{$context->{cdata_mapper}} ($scalar, @_);
109              
110             =head1 AUTHOR
111              
112             Ken MacLeod, ken@bitsko.slc.ut.us
113              
114             =head1 SEE ALSO
115              
116             perl(1), SGML::Grove(3), Text::EntityMap(3), SGML::SData(3),
117             SGML::PI(3), Class::Visitor(3).
118              
119             =cut
120              
121             sub name {
122             gi(@_);
123             }
124              
125             sub attr {
126             my $self = shift;
127             my $attr = shift;
128              
129             if (@_) {
130             my $value = shift;
131             if (ref ($value) eq 'ARRAY') {
132             return $self->[2]->{$attr} = $value;
133             } else {
134             return $self->[2]->{$attr} = [$value];
135             }
136             } else {
137             if (!defined $self->[2]) {
138             return undef;
139             } else {
140             return $self->[2]->{$attr};
141             }
142             }
143             }
144              
145             # $element->attr_as_string($attr[, $context]);
146             sub attr_as_string {
147             my $self = shift;
148             my $attr = shift;
149              
150             my $attributes = $self->[2];
151             return "" if (!defined $attributes);
152              
153             my $value = $attributes->{$attr};
154             return "" if (!defined($value));
155             return $value if (!ref ($value)); # return tokens
156              
157             my ($ii, @string);
158             for ($ii = 0; $ii <= $#{$value}; $ii ++) {
159             my $child = $value->[$ii];
160             if (!ref ($child)) {
161             my $context = shift;
162             if (defined ($context->{'cdata_mapper'})) {
163             push (@string, &{$context->{'cdata_mapper'}}($child, @_));
164             } else {
165             push (@string, $child);
166             }
167             } else {
168             push (@string, $child->as_string(@_));
169             }
170             }
171             return (join ("", @string));
172             }
173              
174             # $element->as_string($context);
175             sub as_string {
176             my $self = shift;
177             my $context = shift;
178              
179             my @string;
180             my $ii;
181             for ($ii = 0; $ii <= $#{$self->[0]}; $ii ++) {
182             my $child = $self->[0][$ii];
183             if (!ref ($child)) {
184             if (defined ($context->{'cdata_mapper'})) {
185             push (@string, &{$context->{'cdata_mapper'}}($child, @_));
186             } else {
187             push (@string, $child);
188             }
189             } else {
190             push (@string, $child->as_string($context, @_));
191             }
192             }
193             return (join ("", @string));
194             }
195              
196             sub accept_gi {
197             my $self = shift;
198             my $visitor = shift;
199              
200             my $gi = $self->gi;
201              
202             # convert all non-word characters to `_' (matched in
203             # SpecBuilder.pm)
204             $gi =~ s/\W/_/g;
205             my $alias = "visit_gi_" . $gi;
206             $visitor->$alias ($self, @_);
207             }
208              
209             sub children_accept_gi {
210             my $self = shift;
211             my $visitor = shift;
212              
213             my $ii;
214             for ($ii = 0; $ii <= $#{$self->[0]}; $ii ++) {
215             my $child = $self->[0][$ii];
216             if (!ref ($child)) {
217             $visitor->visit_scalar ($child, @_);
218             } else {
219             $child->accept_gi ($visitor, @_);
220             }
221             }
222             }
223              
224             1;