line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
|
|
|
|
|
|
# XML::Maker - A Perl module for generating XML |
3
|
|
|
|
|
|
|
# Copyright (C) 2003 Vadim Trochinsky |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# This program is free software; you can redistribute it |
6
|
|
|
|
|
|
|
# and/or modify it under the terms of the GNU General |
7
|
|
|
|
|
|
|
# Public License as published by# the Free Software |
8
|
|
|
|
|
|
|
# Foundation; either version 2 of the License, or (at your |
9
|
|
|
|
|
|
|
# option) any later version. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# $Revision: 1.3 $ |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
package XML::Maker; |
14
|
1
|
|
|
1
|
|
31382
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
119
|
|
15
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1763
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $VERSION; |
18
|
|
|
|
|
|
|
$VERSION = 0.1; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new { |
21
|
5
|
|
|
5
|
1
|
512
|
my ($proto, $name, %params) = @_; |
22
|
5
|
|
|
|
|
43
|
my $self = {}; |
23
|
5
|
|
|
|
|
12
|
bless ($self, $proto); |
24
|
|
|
|
|
|
|
|
25
|
5
|
|
|
|
|
15
|
$self->name($name); |
26
|
5
|
|
|
|
|
9
|
$self->{separator}=", "; |
27
|
5
|
|
|
|
|
9
|
$self->{text}=""; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
5
|
|
|
|
|
14
|
foreach my $key (keys %params) { |
31
|
2
|
|
|
|
|
8
|
$self->attribute($key, $params{$key}); |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
5
|
|
|
|
|
20
|
return $self; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub separator { |
39
|
0
|
|
|
0
|
1
|
0
|
my ($self, $new); |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
0
|
my $old=$self->{separator}; |
42
|
0
|
0
|
|
|
|
0
|
$self->{separator}=$new if defined $new; |
43
|
0
|
|
|
|
|
0
|
return $old; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub remove { |
47
|
|
|
|
|
|
|
#This makes the tag empty. This is useful for two |
48
|
|
|
|
|
|
|
#purposes: freeing memory, and deleting a subtag. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#NOTE: Tags don't disappear when user's reference goes out |
51
|
|
|
|
|
|
|
#of scope, because the root tag still has one. If you want |
52
|
|
|
|
|
|
|
#it to disappear, you need to call this. |
53
|
0
|
|
|
0
|
1
|
0
|
my ($self)=@_; |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
0
|
$self->name(""); |
56
|
0
|
|
|
|
|
0
|
$self->{subtag}={}; |
57
|
|
|
|
|
|
|
|
58
|
0
|
0
|
|
|
|
0
|
if (defined $self->{parent}) { |
59
|
0
|
|
|
|
|
0
|
$self->{parent}->_remove_child($self); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub _parent { |
64
|
|
|
|
|
|
|
#DO NOT USE. This is only to be used internally. |
65
|
5
|
|
|
5
|
|
6
|
my ($self, $p)=@_; |
66
|
5
|
|
|
|
|
11
|
$self->{parent}=$p; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _curparent { |
70
|
|
|
|
|
|
|
#DO NOT USE. Returns current parent |
71
|
1
|
|
|
1
|
|
3
|
my ($self) = shift; |
72
|
1
|
|
|
|
|
5
|
return $self->{parent}; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub _remove_child { |
76
|
|
|
|
|
|
|
#DO NOT USE. This is only to be used internally. |
77
|
|
|
|
|
|
|
#This function is ineficent for large numbers of children. |
78
|
|
|
|
|
|
|
#If this is too slow, changing the module to use a hash |
79
|
|
|
|
|
|
|
# instead of an array should fix it. |
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
1
|
|
3
|
my ($self, $child)=@_; |
82
|
1
|
|
|
|
|
2
|
my ($tmp, $found, $i); |
83
|
|
|
|
|
|
|
|
84
|
1
|
|
|
|
|
2
|
for ($i=0;$i<=$#{$self->{subtag}};$i++) { |
|
2
|
|
|
|
|
8
|
|
85
|
1
|
50
|
|
|
|
3
|
$self->{subtag}[$i-1]=$self->{subtag}[$i] if $found; |
86
|
1
|
50
|
|
|
|
18
|
$found=1 if $self->{subtag}[$i] == $child; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
1
|
50
|
|
|
|
4
|
unless($found) { |
90
|
0
|
|
|
|
|
0
|
confess("Internal error, can't remove inexistent child"); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
1
|
50
|
|
|
|
4
|
pop(@{$self->{subtag}}) if $found; |
|
1
|
|
|
|
|
2
|
|
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub name { |
97
|
|
|
|
|
|
|
#Gives a name to the tag. |
98
|
5
|
|
|
5
|
1
|
8
|
my ($self, $name)=@_; |
99
|
5
|
|
|
|
|
12
|
my $old = $self->{name}; |
100
|
5
|
50
|
|
|
|
18
|
$self->{name}=$name if defined $name; |
101
|
|
|
|
|
|
|
|
102
|
5
|
|
|
|
|
9
|
return $old; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub attribute { |
106
|
2
|
|
|
2
|
1
|
4
|
my ($self, $key, $value)=@_; |
107
|
2
|
|
|
|
|
3
|
my $old; |
108
|
|
|
|
|
|
|
|
109
|
2
|
50
|
|
|
|
9
|
if (defined $self->{params}->{$key}) { |
110
|
0
|
|
|
|
|
0
|
$old = $self->{params}->{$key}; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
2
|
50
|
|
|
|
6
|
if ( defined $value ) { |
114
|
2
|
|
|
|
|
6
|
$self->{params}->{$key} = _escape_attribute( $value ); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
2
|
|
|
|
|
15
|
return $old; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub del_attribute { |
121
|
0
|
|
|
0
|
1
|
0
|
my ($self, $key)=@_; |
122
|
0
|
|
|
|
|
0
|
my $old; |
123
|
|
|
|
|
|
|
|
124
|
0
|
0
|
|
|
|
0
|
if (defined $self->{params}->{$key}) { |
125
|
0
|
|
|
|
|
0
|
$old = $self->{params}->{$key}; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
0
|
delete $self->{params}->{$key}; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
0
|
return $old; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub merge { |
134
|
|
|
|
|
|
|
#Works like set, except that for already defined |
135
|
|
|
|
|
|
|
#parameters it adds to them instead of replacing. For |
136
|
|
|
|
|
|
|
#example, for a parameter foo="bar", merge({foo => "baz"}) |
137
|
|
|
|
|
|
|
#would change it to foo="bar, baz" |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
0
|
1
|
0
|
my ($self, %params)=@_; |
140
|
0
|
|
|
|
|
0
|
my ($key); |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
0
|
foreach $key (keys %params ) { |
143
|
0
|
0
|
|
|
|
0
|
if ( defined $self->{params} ) { |
144
|
0
|
|
|
|
|
0
|
$self->{params} .= $self->{separator}.$params{$key}; |
145
|
|
|
|
|
|
|
} else { |
146
|
0
|
|
|
|
|
0
|
$self->{params} = $params{$key}; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub make { |
152
|
|
|
|
|
|
|
#Returns a text representation of the tag. |
153
|
|
|
|
|
|
|
#$tabs is the number of tabs to add. If this is not undef, |
154
|
|
|
|
|
|
|
#the tag will be printed with some pretty formatting. |
155
|
|
|
|
|
|
|
|
156
|
4
|
|
|
4
|
1
|
5
|
my ($self, $tabs)=@_; |
157
|
4
|
|
|
|
|
5
|
my ($ret, $key, $tmp, $subt, $i, $newtabs, $newid); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#If the tag has been deleted, nothing to do. |
160
|
4
|
50
|
|
|
|
9
|
return "" if $self->{name} eq ""; |
161
|
|
|
|
|
|
|
|
162
|
4
|
|
|
|
|
5
|
$ret=""; |
163
|
4
|
50
|
|
|
|
8
|
$ret="\t" x $tabs if (defined $tabs); |
164
|
|
|
|
|
|
|
|
165
|
4
|
|
|
|
|
8
|
$ret.="<".$self->{name}; #Begin the tag:
|
166
|
|
|
|
|
|
|
|
167
|
4
|
|
|
|
|
3
|
foreach $key (keys(%{$self->{params}})) { |
|
4
|
|
|
|
|
12
|
|
168
|
|
|
|
|
|
|
#Add a key: key="value" |
169
|
|
|
|
|
|
|
#print "$key\n"; |
170
|
2
|
|
|
|
|
6
|
$ret.=" ${key}=\"$self->{params}->{$key}\""; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
4
|
|
|
|
|
7
|
$tmp=""; |
174
|
4
|
50
|
|
|
|
13
|
if ($self->{text} ne "") { |
|
|
100
|
|
|
|
|
|
175
|
|
|
|
|
|
|
#Assume that if no text is present, |
176
|
|
|
|
|
|
|
# then the tag is of the form |
177
|
0
|
|
|
|
|
0
|
$tmp=$self->{text}; |
178
|
|
|
|
|
|
|
} elsif ($self->{subtag}) { |
179
|
|
|
|
|
|
|
#We've got subtags. We simply call make |
180
|
|
|
|
|
|
|
# for each of them, and add the results |
181
|
3
|
|
|
|
|
3
|
$i=0; $newtabs=$tabs; |
|
3
|
|
|
|
|
570
|
|
182
|
3
|
50
|
|
|
|
7
|
$newtabs++ if defined $newtabs; |
183
|
3
|
50
|
|
|
|
6
|
$tmp.="\n" if defined $tabs; |
184
|
|
|
|
|
|
|
|
185
|
3
|
|
|
|
|
2
|
foreach $subt (@{$self->{subtag}}) { |
|
3
|
|
|
|
|
6
|
|
186
|
3
|
|
|
|
|
12
|
$tmp.=$subt->make($newtabs); |
187
|
|
|
|
|
|
|
} |
188
|
3
|
50
|
|
|
|
6
|
$tmp.="\t" x $tabs if (defined $tabs); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
4
|
100
|
|
|
|
7
|
if ($tmp) { |
192
|
|
|
|
|
|
|
#Add text and close: Text |
193
|
3
|
|
|
|
|
8
|
$ret.=">$tmp".$self->{name}.">"; |
194
|
|
|
|
|
|
|
} else { |
195
|
|
|
|
|
|
|
#Close: /> |
196
|
1
|
|
|
|
|
1
|
$ret.="/>"; |
197
|
|
|
|
|
|
|
} |
198
|
4
|
50
|
|
|
|
8
|
$ret.="\n" if defined $tabs; |
199
|
4
|
|
|
|
|
10
|
return $ret; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub addtext { |
203
|
0
|
|
|
0
|
1
|
0
|
my ($self, $text)=@_; |
204
|
0
|
0
|
|
|
|
0
|
_error_exclusive() if defined $self->{subtag}; |
205
|
0
|
|
|
|
|
0
|
$self->{text} .= _escape_text( $text ); |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub text { |
209
|
1
|
|
|
1
|
1
|
3
|
my ($self, $text)=@_; |
210
|
1
|
|
|
|
|
2
|
my $old = $self->{text}; |
211
|
|
|
|
|
|
|
|
212
|
1
|
50
|
|
|
|
7
|
_error_exclusive() if defined $self->{subtag}; |
213
|
0
|
0
|
|
|
|
0
|
$self->{text} = _escape_text( $text ) if defined $text; |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
0
|
return $old; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub subtag { |
219
|
2
|
|
|
2
|
1
|
7
|
my ($self,$name, %params)=@_; |
220
|
2
|
|
|
|
|
3
|
my ($subt); |
221
|
2
|
50
|
|
|
|
9
|
_error_exclusive() if $self->{text}; |
222
|
2
|
|
|
|
|
10
|
$subt=XML::Maker->new($name, %params); |
223
|
2
|
|
|
|
|
7
|
$subt->_parent($self); |
224
|
2
|
|
|
|
|
3
|
push (@{$self->{subtag}},$subt); |
|
2
|
|
|
|
|
7
|
|
225
|
2
|
|
|
|
|
7
|
return $subt; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub attach { |
229
|
2
|
|
|
2
|
1
|
9
|
my ($self, $subt)=@_; |
230
|
|
|
|
|
|
|
|
231
|
2
|
50
|
|
|
|
8
|
_error_exclusive() if $self->{text}; |
232
|
2
|
|
|
|
|
6
|
$subt->_parent($self); |
233
|
2
|
|
|
|
|
3
|
push (@{$self->{subtag}},$subt); |
|
2
|
|
|
|
|
5
|
|
234
|
2
|
|
|
|
|
5
|
return $subt; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub detach { |
238
|
1
|
|
|
1
|
1
|
2
|
my ($self, $subt) = @_; |
239
|
|
|
|
|
|
|
|
240
|
1
|
50
|
|
|
|
5
|
if ($subt->_curparent() == $self) { |
241
|
1
|
|
|
|
|
4
|
$self->_remove_child( $subt ); |
242
|
1
|
|
|
|
|
5
|
$subt->_parent( undef ); |
243
|
|
|
|
|
|
|
} else { |
244
|
0
|
|
|
|
|
0
|
confess("I can't detach a child that isn't mine"); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub count_children { |
250
|
6
|
|
|
6
|
1
|
21
|
my $self = shift; |
251
|
6
|
100
|
|
|
|
24
|
return 0 unless $self->{subtag}; |
252
|
5
|
|
|
|
|
5
|
return scalar @{$self->{subtag}}; |
|
5
|
|
|
|
|
24
|
|
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub _error_exclusive { |
256
|
|
|
|
|
|
|
#This is just to avoid having 3 copies of the same message. |
257
|
1
|
|
|
1
|
|
256
|
confess("text and subtag/attach are mutually exclusive"); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub _escape_text { |
261
|
|
|
|
|
|
|
#Replaces unacceptable symbols in text |
262
|
0
|
|
|
0
|
|
0
|
my ($text)=@_; |
263
|
|
|
|
|
|
|
|
264
|
0
|
0
|
|
|
|
0
|
if ($text =~ /[\&\<\>]/) { |
265
|
0
|
|
|
|
|
0
|
$text =~ s/\&/\&\;/g; |
266
|
0
|
|
|
|
|
0
|
$text =~ s/\\<\;/g; |
267
|
0
|
|
|
|
|
0
|
$text =~ s/\>/\>\;/g; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
0
|
return $text; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub _escape_attribute { |
274
|
|
|
|
|
|
|
#Replaces unacceptable symbols in attributes |
275
|
2
|
|
|
2
|
|
3
|
my ($text) = @_; |
276
|
|
|
|
|
|
|
|
277
|
2
|
50
|
|
|
|
8
|
if ($text =~ /[\&\<\>\"]/) { |
278
|
0
|
|
|
|
|
0
|
$text =~ s/\&/\&\;/g; |
279
|
0
|
|
|
|
|
0
|
$text =~ s/\\<\;/g; |
280
|
0
|
|
|
|
|
0
|
$text =~ s/\>/\>\;/g; |
281
|
0
|
|
|
|
|
0
|
$text =~ s/\"/\"\;/g; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
2
|
|
|
|
|
7
|
return $text; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
1; |
289
|
|
|
|
|
|
|
=head1 NAME |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
XML::Maker - OO Module for generating XML |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head1 SYNOPSIS |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
#/usr/bin/perl -w |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
use XML::Maker; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
my $root = new XML::Maker("root"); |
300
|
|
|
|
|
|
|
my $person = $root->subtag("person", name => 'Vadim', |
301
|
|
|
|
|
|
|
age => 22); |
302
|
|
|
|
|
|
|
my $info = $person->subtag("info"); |
303
|
|
|
|
|
|
|
$info->text("Perl programmer"); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
print $root->make(0); |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head1 FEATURES |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
* Easy and compact generation of XML |
312
|
|
|
|
|
|
|
* A function receiving an object can't change the parent. |
313
|
|
|
|
|
|
|
* It's impossible to make more than one root element |
314
|
|
|
|
|
|
|
* It's impossible to leave an element unclosed |
315
|
|
|
|
|
|
|
* Can print indented XML |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=head1 DESCRIPTION |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
This module has been written to provide easy and safe |
320
|
|
|
|
|
|
|
generation of XML. Unlike other modules, this one does not |
321
|
|
|
|
|
|
|
produce output as soon as it can, but only when calling the |
322
|
|
|
|
|
|
|
make() function. This is intentionally done to make sure |
323
|
|
|
|
|
|
|
that it will always output well formatted XML. |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
One disadvantage of using this module is that everything is |
326
|
|
|
|
|
|
|
kept in memory until you destroy the object. If your program |
327
|
|
|
|
|
|
|
needs to generate a large amount of XML you should use |
328
|
|
|
|
|
|
|
another module, for example see L. |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Another intended feature is safety. If you pass a XML::Maker |
331
|
|
|
|
|
|
|
object to a function it will be able to do whatever it wants |
332
|
|
|
|
|
|
|
with it, but will not have access to its parent. This should |
333
|
|
|
|
|
|
|
make it easier to find which part of the program is |
334
|
|
|
|
|
|
|
generating bad output, but again, may not suit your needs. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
For ease of use, XML closing tags are generated |
337
|
|
|
|
|
|
|
automatically. If the resulting XML element contains a CDATA |
338
|
|
|
|
|
|
|
area, then the output will contain opening and closing tags: |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
text |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
However, if there is no text, then an empty tag will be |
343
|
|
|
|
|
|
|
generated: |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
Due to the design of this module, child objects will not go |
348
|
|
|
|
|
|
|
out of scope as you might expect, see L"remove()"> for an |
349
|
|
|
|
|
|
|
explanation of this. |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head1 GET/SET METHODS |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
All the methods in this package that modify values provide |
354
|
|
|
|
|
|
|
"get" and "set" functions at the same time. If passed a |
355
|
|
|
|
|
|
|
value other than undef they will set the value to the passed |
356
|
|
|
|
|
|
|
one.They will also return the old value of the parameter. |
357
|
|
|
|
|
|
|
For example: |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Set separator to |, and save the old one |
360
|
|
|
|
|
|
|
my $old_separator = $obj->separator("|"); |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
# (code) |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
# Restore old separator |
365
|
|
|
|
|
|
|
$obj->separator( $old_separator ); |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=head1 METHODS |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=head2 new(C<$name>, [C<%attributes>]) |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
Create a new XML::Maker object. It is mandatory to pass a |
372
|
|
|
|
|
|
|
C<$name> argument to indicate the name of this tag. C |
373
|
|
|
|
|
|
|
isnormally used to create the root element. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
Optionally, you can pass a hash containing the attribute |
376
|
|
|
|
|
|
|
names and values. The order in which they will be generated |
377
|
|
|
|
|
|
|
in the resulting XML is undefined. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=head2 make([C<$tabs>]) |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
Build a text representation of the object in the form of a |
382
|
|
|
|
|
|
|
XML tree.The process will start at the object this is called |
383
|
|
|
|
|
|
|
on, and extend to all of its children. |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
If C<$tabs> is defined, then the output will be indented, |
386
|
|
|
|
|
|
|
starting with the specified number of tabs. You probably |
387
|
|
|
|
|
|
|
want to use 0 here. |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=head2 subtag(C<$name>, [C<%attributes>]) |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Create a child XML::Maker object. It works exactly the same |
392
|
|
|
|
|
|
|
as new(), except that the new object will be linked to its |
393
|
|
|
|
|
|
|
parent, instead of being independent. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
Creating a new object with new, and then using attach() on |
396
|
|
|
|
|
|
|
it has the same effect. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=head2 attach(C<$tag>) |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
Attach a XML::Maker object to another. The object attached |
401
|
|
|
|
|
|
|
will become a child of the object being attached to. If the |
402
|
|
|
|
|
|
|
child was a child of a XML::Maker object, then it will stop |
403
|
|
|
|
|
|
|
being the child of that object. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head2 detach(C<$tag>) |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Detach a XML::Maker object. This only works if the object |
408
|
|
|
|
|
|
|
being detached is a child of the object this method is |
409
|
|
|
|
|
|
|
called on. The child object will then become independent |
410
|
|
|
|
|
|
|
from its parent. |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=head2 remove() |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Empties the XML::Maker object, and calls to the parent to |
415
|
|
|
|
|
|
|
remove its internal reference. This is done to completely |
416
|
|
|
|
|
|
|
destroy a child object. For example, suppose this code: |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
my $root = new XML::Maker('root'); |
419
|
|
|
|
|
|
|
add_info( $root ); |
420
|
|
|
|
|
|
|
print $root->make(); |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub add_info { |
423
|
|
|
|
|
|
|
my $obj = shift; |
424
|
|
|
|
|
|
|
my $tag = $obj->subtag('info', 'foo' => 'bar'); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
Here, even though C<$tag> goes out of scope, it I
|
428
|
|
|
|
|
|
|
disappear>, because C<$root> has an internal reference to |
429
|
|
|
|
|
|
|
it. In order to make it vanish you need to call |
430
|
|
|
|
|
|
|
C<$tag-Eremove()>, or C<$obj-Edetach($tag )> inside |
431
|
|
|
|
|
|
|
the C function. In the second case, $tag |
432
|
|
|
|
|
|
|
will continue to exist until it goes out of scope. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=head2 separator([C<$value>]) |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
Gets/sets the separator. The separator is used by the |
437
|
|
|
|
|
|
|
Cmethod, and by default is ", ". |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=head2 name([C<$name>]) |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Gets/sets the name of the element. |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=head2 attribute(C<$name>, [C<$value>]) |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Gets/sets an attribute of the element. This can't be used to |
446
|
|
|
|
|
|
|
remove an attribute, use the L"del_attribute()"> method |
447
|
|
|
|
|
|
|
for that. |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=head2 del_attribute(C<$name>) |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
Removes an attribute. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=head2 merge(C<$name>, C<$value>) |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
Appends the separator, then string to an attribute. For |
456
|
|
|
|
|
|
|
example: |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
$obj->attribute('meta', 'foo'); # Sets 'meta' to 'foo' |
459
|
|
|
|
|
|
|
$obj->merge('meta', 'bar'); # 'meta' is now 'foo, bar' |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=head2 text([C<$text>]) |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
Gets/sets the text of the current element. If you want to |
464
|
|
|
|
|
|
|
remove the text simply pass an empty string ("") |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=head2 addtext(C<$text>) |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
Adds a string to the text of the element. |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=head2 count_children() |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
Returns the number of children this object has. Only counts |
473
|
|
|
|
|
|
|
how many children this specific object has, that is, it does |
474
|
|
|
|
|
|
|
not count recursively. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
A recursive count is not yet implemented. |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=head1 NOTES |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
This module is not yet complete. Many XML features are |
481
|
|
|
|
|
|
|
missing, for example: |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
* Namespaces |
484
|
|
|
|
|
|
|
* DOCTYPE declarations |
485
|
|
|
|
|
|
|
* XML type declarations |
486
|
|
|
|
|
|
|
* Comments |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
I'm interested in feedback about this module, and comments |
489
|
|
|
|
|
|
|
about new features,improvements or bug reports are welcome. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=head1 AUTHOR |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
Vadim Trochinsky (vadim_t at teleline dot es) |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=head1 SEE ALSO |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
L |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=head1 COPYRIGHT |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
XML::Maker - A Perl module for generating XML |
502
|
|
|
|
|
|
|
Copyright (C) 2003 Vadim Trochinsky |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
This program is free software; you can redistribute it |
505
|
|
|
|
|
|
|
and/or modify it under the terms of the GNU General Public |
506
|
|
|
|
|
|
|
License as published by the Free Software Foundation; either |
507
|
|
|
|
|
|
|
version 2 of the License, or(at your option) any later |
508
|
|
|
|
|
|
|
version. |