line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SVG::Extension; |
2
|
25
|
|
|
25
|
|
177
|
use strict; |
|
25
|
|
|
|
|
46
|
|
|
25
|
|
|
|
|
762
|
|
3
|
25
|
|
|
25
|
|
126
|
use warnings; |
|
25
|
|
|
|
|
47
|
|
|
25
|
|
|
|
|
1133
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '2.85'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 NAME |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
SVG::Extension - additional methods |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=cut |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# although DTD declarations are not elements, we use the same API so we can |
14
|
|
|
|
|
|
|
# manipulate the internal DTD subset using the same methods available for |
15
|
|
|
|
|
|
|
# elements. At this state, all extensions are the same object class, but |
16
|
|
|
|
|
|
|
# may be subclassed in the future to e.g. SVG::Extension::ELEMENT. Use |
17
|
|
|
|
|
|
|
# e.g. isElementDecl() to determine types; this API will be retained |
18
|
|
|
|
|
|
|
# irrespective. |
19
|
|
|
|
|
|
|
|
20
|
25
|
|
|
25
|
|
166
|
use parent qw/SVG::Element/; |
|
25
|
|
|
|
|
81
|
|
|
25
|
|
|
|
|
402
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# DTD declarations handled in this module |
23
|
25
|
|
|
25
|
|
1868
|
use constant ELEMENT => 'ELEMENT'; |
|
25
|
|
|
|
|
75
|
|
|
25
|
|
|
|
|
2904
|
|
24
|
25
|
|
|
25
|
|
182
|
use constant ATTLIST => 'ATTLIST'; |
|
25
|
|
|
|
|
60
|
|
|
25
|
|
|
|
|
1363
|
|
25
|
25
|
|
|
25
|
|
162
|
use constant NOTATION => 'NOTATION'; |
|
25
|
|
|
|
|
72
|
|
|
25
|
|
|
|
|
1306
|
|
26
|
25
|
|
|
25
|
|
154
|
use constant ENTITY => 'ENTITY'; |
|
25
|
|
|
|
|
43
|
|
|
25
|
|
|
|
|
53214
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our @TYPES = ( ELEMENT, ATTLIST, NOTATION, ENTITY ); |
29
|
|
|
|
|
|
|
our %TYPES = map { $_ => 1 } @TYPES; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#----------------- |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub new { |
34
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::new(@_); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub internal_subset { |
38
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
39
|
|
|
|
|
|
|
|
40
|
0
|
|
|
|
|
|
my $document = $self->{-docref}; |
41
|
0
|
0
|
|
|
|
|
unless ( exists $document->{-internal} ) { |
42
|
0
|
|
|
|
|
|
$document->{-internal} = new SVG::Extension('internal'); |
43
|
0
|
|
|
|
|
|
$document->{-internal}{-docref} = $document; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
return $document->{-internal}; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head2 extension |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
return the element object |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=cut |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub extension { |
56
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
57
|
0
|
|
0
|
|
|
|
my $class = ref($self) || $self; |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
return bless $self->SUPER::element(@_), $class; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
#----------------- |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 element_decl |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
generate an element declaration in the DTD |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub element_decl { |
71
|
0
|
|
|
0
|
1
|
|
my ( $self, %attrs ) = @_; |
72
|
0
|
|
|
|
|
|
my $subset = $self->internal_subset(); |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
return $subset->extension( 'ELEMENT', %attrs ); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head2 attribute_decl |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
return generate an attribute list for an element |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=cut |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub attribute_decl { |
84
|
0
|
|
|
0
|
1
|
|
my ( $element_decl, %attrs ) = @_; |
85
|
|
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
|
unless ( $element_decl->getElementType eq 'ELEMENT' ) { |
87
|
0
|
|
|
|
|
|
$element_decl->error( |
88
|
|
|
|
|
|
|
$element_decl => 'is not an ELEMENT declaration' ); |
89
|
0
|
|
|
|
|
|
return; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
return $element_decl->extension( 'ATTLIST', %attrs ); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 attlist_decl |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=cut |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub attlist_decl { |
100
|
0
|
|
|
0
|
1
|
|
my ( $self, %attrs ) = @_; |
101
|
0
|
|
|
|
|
|
my $subset = $self->internal_subset(); |
102
|
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
my $element_decl = $subset->getElementDeclByName( $attrs{name} ); |
104
|
0
|
0
|
|
|
|
|
unless ($element_decl) { |
105
|
0
|
|
|
|
|
|
$subset->error( "ATTLIST declaration '$attrs{attr}'" => |
106
|
|
|
|
|
|
|
"ELEMENT declaration '$attrs{name}' does not exist" ); |
107
|
0
|
|
|
|
|
|
return; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
return $element_decl->attribute_decl(%attrs); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 notation_decl(%attrs) |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
return an extension object of type NOTATION |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=cut |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub notation_decl { |
120
|
0
|
|
|
0
|
1
|
|
my ( $self, %attrs ) = @_; |
121
|
0
|
|
|
|
|
|
my $subset = $self->internal_subset(); |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
return $subset->extension( 'NOTATION', %attrs ); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 entity_decl(%attrs) |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
return an extension object of type 'ENTITY' |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=cut |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub entity_decl { |
133
|
0
|
|
|
0
|
1
|
|
my ( $self, %attrs ) = @_; |
134
|
0
|
|
|
|
|
|
my $subset = $self->internal_subset(); |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
return $subset->extension( 'ENTITY', %attrs ); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
#----------------- |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# this interim version of xmlify handles the vanilla extension |
142
|
|
|
|
|
|
|
# format of one parent 'internal' element containing a list of |
143
|
|
|
|
|
|
|
# extension elements. A hierarchical model will follow in time |
144
|
|
|
|
|
|
|
# with the same render API. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 xmilfy |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub xmlify { |
151
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
152
|
0
|
|
|
|
|
|
my $decl = q{}; |
153
|
|
|
|
|
|
|
|
154
|
0
|
0
|
|
|
|
|
if ( $self->{-name} ne 'internal' ) { |
155
|
0
|
|
|
|
|
|
$decl = '
|
156
|
0
|
|
|
|
|
|
SWITCH: foreach ( $self->{-name} ) { |
157
|
0
|
0
|
|
|
|
|
/^ELEMENT$/ and do { |
158
|
0
|
|
|
|
|
|
$decl .= "ELEMENT $self->{name}"; |
159
|
|
|
|
|
|
|
|
160
|
0
|
0
|
|
|
|
|
$decl .= q{ } . $self->{model} if exists $self->{model}; |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
last SWITCH; |
163
|
|
|
|
|
|
|
}; |
164
|
0
|
0
|
|
|
|
|
/^ATTLIST$/ and do { |
165
|
0
|
|
|
|
|
|
$decl .= "ATTLIST $self->{name} $self->{attr}"; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
$decl |
168
|
|
|
|
|
|
|
.= " $self->{type} " |
169
|
|
|
|
|
|
|
. ( $self->{fixed} ? '#FIXED ' : q{} ) |
170
|
0
|
0
|
|
|
|
|
. $self->{default}; |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
last SWITCH; |
173
|
|
|
|
|
|
|
}; |
174
|
0
|
0
|
|
|
|
|
/^NOTATION$/ and do { |
175
|
0
|
|
|
|
|
|
$decl .= "NOTATION $self->{name}"; |
176
|
|
|
|
|
|
|
|
177
|
0
|
0
|
|
|
|
|
$decl .= q{ } . $self->{base} if exists $self->{base}; |
178
|
0
|
0
|
|
|
|
|
if ( exists $self->{pubid} ) { |
|
|
0
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
$decl .= "PUBLIC $self->{pubid} "; |
180
|
0
|
0
|
|
|
|
|
$decl .= q{ } . $self->{sysid} if exists $self->{sysid}; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
elsif ( exists $self->{sysid} ) { |
183
|
|
|
|
|
|
|
$decl .= ' SYSTEM ' . $self->{sysid} |
184
|
0
|
0
|
|
|
|
|
if exists $self->{sysid}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
last SWITCH; |
188
|
|
|
|
|
|
|
}; |
189
|
0
|
0
|
|
|
|
|
/^ENTITY$/ and do { |
190
|
|
|
|
|
|
|
$decl |
191
|
|
|
|
|
|
|
.= 'ENTITY ' |
192
|
|
|
|
|
|
|
. ( $self->{isp} ? '% ' : q{} ) |
193
|
0
|
0
|
|
|
|
|
. $self->{name}; |
194
|
|
|
|
|
|
|
|
195
|
0
|
0
|
|
|
|
|
if ( exists $self->{value} ) { |
|
|
0
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
$decl .= ' "' . $self->{value} . '"'; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
elsif ( exists $self->{pubid} ) { |
199
|
0
|
|
|
|
|
|
$decl .= "PUBLIC $self->{pubid} "; |
200
|
0
|
0
|
|
|
|
|
$decl .= q{ } . $self->{sysid} if exists $self->{sysid}; |
201
|
0
|
0
|
|
|
|
|
$decl .= q{ } . $self->{ndata} if $self->{ndata}; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
else { |
204
|
|
|
|
|
|
|
$decl .= ' SYSTEM ' . $self->{sysid} |
205
|
0
|
0
|
|
|
|
|
if exists $self->{sysid}; |
206
|
0
|
0
|
|
|
|
|
$decl .= q{ } . $self->{ndata} if $self->{ndata}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
last SWITCH; |
210
|
0
|
|
|
|
|
|
DEFAULT: |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# we don't know what this is, but the underlying parser allowed it |
213
|
|
|
|
|
|
|
$decl .= "$self->{-name} $self->{name}"; |
214
|
|
|
|
|
|
|
}; |
215
|
|
|
|
|
|
|
} |
216
|
0
|
|
|
|
|
|
$decl .= '>' . $self->{-docref}{-elsep}; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
|
my $result = q{}; |
220
|
0
|
0
|
|
|
|
|
if ( $self->hasChildren ) { |
221
|
0
|
|
|
|
|
|
$self->{-docref}->{-level}++; |
222
|
0
|
|
|
|
|
|
foreach my $child ( $self->getChildren ) { |
223
|
|
|
|
|
|
|
$result |
224
|
|
|
|
|
|
|
.= ( $self->{-docref}{-indent} x $self->{-docref}->{-level} ) |
225
|
0
|
|
|
|
|
|
. $child->render(); |
226
|
|
|
|
|
|
|
} |
227
|
0
|
|
|
|
|
|
$self->{-docref}->{-level}--; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
|
return $decl . $result; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
#some aliases for xmilfy |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head2 render |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
alias for xmlify |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head2 to_xml |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
alias for xmlify |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=head2 serialise |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
alias for xmlify |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head2 serialise |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
alias for xmlify |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=cut |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
*render = \&xmlify; |
254
|
|
|
|
|
|
|
*to_xml = \&xmlify; |
255
|
|
|
|
|
|
|
*serialise = \&xmlify; |
256
|
|
|
|
|
|
|
*serialize = \&xmlify; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
#----------------- |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head2 getDeclName |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Simply an alias for the general method for SVG::Extension objects |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head2 getExtensionName |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
alias to getDeclName |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=cut |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# simply an alias for the general method for SVG::Extension objects |
271
|
|
|
|
|
|
|
sub getDeclName { |
272
|
0
|
|
|
0
|
1
|
|
return shift->SUPER::getElementName(); |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
*getExtensionName = \&getDeclName; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head2 getDeclNames |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
return list of existing decl types by extracting it from the overall list |
279
|
|
|
|
|
|
|
of existing element types |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub getDeclNames { |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head2 getExtensionNames |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
alias to getDeclNames |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# return list of existing decl types by extracting it from the overall list |
290
|
|
|
|
|
|
|
# of existing element types |
291
|
|
|
|
|
|
|
sub getDeclNames { |
292
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
293
|
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
|
return grep { exists $TYPES{$_} } $self->SUPER::getElementNames(); |
|
0
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
*getExtensionNames = \&getDeclNames; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
#----------------- |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# we can have only one element decl of a given name... |
301
|
|
|
|
|
|
|
sub getElementDeclByName { |
302
|
0
|
|
|
0
|
0
|
|
my ( $self, $name ) = @_; |
303
|
0
|
|
|
|
|
|
my $subset = $self->internal_subset(); |
304
|
|
|
|
|
|
|
|
305
|
0
|
|
|
|
|
|
my @element_decls = $subset->getElementsByName('ELEMENT'); |
306
|
0
|
|
|
|
|
|
foreach my $element_decl (@element_decls) { |
307
|
0
|
0
|
|
|
|
|
return $element_decl if $element_decl->{name} eq $name; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
|
return; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# ...but we can have multiple attributes. Note that this searches the master list |
314
|
|
|
|
|
|
|
# which is not what you are likely to want in most cases. See getAttributeDeclByName |
315
|
|
|
|
|
|
|
# (no 's') below, to search for an attribute decl on a particular element decl. |
316
|
|
|
|
|
|
|
# You can use the result of this method along with getParent to find the list of |
317
|
|
|
|
|
|
|
# all element decls that define a given attribute. |
318
|
|
|
|
|
|
|
sub getAttributeDeclsByName { |
319
|
0
|
|
|
0
|
0
|
|
my ( $self, $name ) = @_; |
320
|
0
|
|
|
|
|
|
my $subset = $self->internal_subset(); |
321
|
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
my @element_decls = $subset->getElementsByName('ELEMENT'); |
323
|
0
|
|
|
|
|
|
foreach my $element_decl (@element_decls) { |
324
|
0
|
0
|
|
|
|
|
return $element_decl if $element_decl->{name} eq $name; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
return; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
#----------------- |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
sub getElementDecls { |
333
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getElements('ELEMENT'); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub getNotations { |
337
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getElements('NOTATION'); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
*getNotationDecls = \&getNotations; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub getEntities { |
342
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getElements('ENTITY'); |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
*getEntityDecls = \&getEntities; |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub getAttributeDecls { |
347
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getElements('ATTLIST'); |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
#----------------- |
351
|
|
|
|
|
|
|
# until/unless we subclass these, use the name. After (if) we |
352
|
|
|
|
|
|
|
# subclass, will use the object class. |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub isElementDecl { |
355
|
0
|
0
|
|
0
|
0
|
|
return ( shift->getElementName eq ELEMENT ) ? 1 : 0; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub isNotation { |
359
|
0
|
0
|
|
0
|
0
|
|
return ( shift->getElementName eq NOTATION ) ? 1 : 0; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub isEntity { |
363
|
0
|
0
|
|
0
|
0
|
|
return ( shift->getElementName eq ENTITY ) ? 1 : 0; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub isAttributeDecl { |
367
|
0
|
0
|
|
0
|
0
|
|
return ( shift->getElementName eq ATTLIST ) ? 1 : 0; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
#----------------- |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# the Decl 'name' is an attribute, the name is e.g. 'ELEMENT' |
373
|
|
|
|
|
|
|
# use getElementName if you want the actual decl type |
374
|
|
|
|
|
|
|
sub getElementDeclName { |
375
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
376
|
|
|
|
|
|
|
|
377
|
0
|
0
|
|
|
|
|
if ( exists $self->{name} ) { |
378
|
0
|
|
|
|
|
|
return $self->{name}; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
return; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# identical to the above; will be smarter as and when we subclass |
385
|
|
|
|
|
|
|
# as above, the name is ATTLIST, the 'name' is a property of the decl |
386
|
|
|
|
|
|
|
sub getAttributeDeclName { |
387
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
388
|
|
|
|
|
|
|
|
389
|
0
|
0
|
|
|
|
|
if ( exists $self->{name} ) { |
390
|
0
|
|
|
|
|
|
return $self->{name}; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
|
|
|
|
return; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# unlike other 'By' methods, attribute searches work from their parent element |
397
|
|
|
|
|
|
|
# del only. Multiple element decls with the same attribute name is more than |
398
|
|
|
|
|
|
|
# likely, so searching the master ATTLIST is not very useful. If you really want |
399
|
|
|
|
|
|
|
# to do that, use getAttributeDeclsByName (with an 's') above. |
400
|
|
|
|
|
|
|
sub getAttributeDeclByName { |
401
|
0
|
|
|
0
|
0
|
|
my ( $self, $name ) = @_; |
402
|
|
|
|
|
|
|
|
403
|
0
|
|
|
|
|
|
my @attribute_decls = $self->getElementAttributeDecls(); |
404
|
0
|
|
|
|
|
|
foreach my $attribute_decl (@attribute_decls) { |
405
|
0
|
0
|
|
|
|
|
return $attribute_decl if $attribute_decl->{name} eq $name; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
return; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# as this is element specific, we allow a 'ElementAttribute' name too, |
412
|
|
|
|
|
|
|
# for those that like consistency at the price of brevity. Not that |
413
|
|
|
|
|
|
|
# the shorter name is all that brief to start with... |
414
|
|
|
|
|
|
|
*getElementAttributeDeclByName = \&getAttributeDeclByName; |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# ...and for those who live their brevity: |
417
|
|
|
|
|
|
|
*getAttributeDecl = \&getAttributeDeclByName; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub hasAttributeDecl { |
420
|
0
|
0
|
|
0
|
0
|
|
return ( shift->getElementDeclByName(shift) ) ? 1 : 0; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
#----------------- |
424
|
|
|
|
|
|
|
# directly map to Child/Siblings: we presume this is being called from an |
425
|
|
|
|
|
|
|
# element decl. You can use 'getChildIndex', 'getChildAtIndex' etc. as well |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub getElementAttributeAtIndex { |
428
|
0
|
|
|
0
|
0
|
|
my ( $self, $index, @children ) = @_; |
429
|
|
|
|
|
|
|
|
430
|
0
|
|
|
|
|
|
return $self->SUPER::getChildAtIndex( $index, @children ); |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub getElementAttributeIndex { |
434
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getChildIndex(@_); |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub getFirstAttributeDecl { |
438
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getFirstChild(); |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sub getNextAttributeDecl { |
442
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getNextSibling(); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub getLastAttributeDecl { |
446
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getLastChild(); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub getPreviousAttributeDecl { |
450
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getPreviousSibling(); |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub getElementAttributeDecls { |
454
|
0
|
|
|
0
|
0
|
|
return shift->SUPER::getChildren(); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
# These methods are slated for inclusion in a future release of SVG.pm. They |
460
|
|
|
|
|
|
|
# will allow programmatic advance determination of the validity of various DOM |
461
|
|
|
|
|
|
|
# manipulations. If you are in a hurry for this feature, get in touch! |
462
|
|
|
|
|
|
|
# |
463
|
|
|
|
|
|
|
# example: |
464
|
|
|
|
|
|
|
# if ($svg_object->allowsElement("symbol")) { ... } |
465
|
|
|
|
|
|
|
# |
466
|
|
|
|
|
|
|
#package SVG::Element; |
467
|
|
|
|
|
|
|
# |
468
|
|
|
|
|
|
|
#sub allowedElements {} |
469
|
|
|
|
|
|
|
#sub allowedAttributes {} |
470
|
|
|
|
|
|
|
# |
471
|
|
|
|
|
|
|
#sub allowsElement {} |
472
|
|
|
|
|
|
|
#sub allowsAttribute {} |
473
|
|
|
|
|
|
|
# |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
1; |