line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################# |
2
|
|
|
|
|
|
|
## Name: Tie.pm |
3
|
|
|
|
|
|
|
## Purpose: XML::Smart::Tie - (XML::Smart::Tie::Array & XML::Smart::Tie::Hash) |
4
|
|
|
|
|
|
|
## Author: Graciliano M. P. |
5
|
|
|
|
|
|
|
## Modified by: Harish Madabushi |
6
|
|
|
|
|
|
|
## Created: 28/09/2003 |
7
|
|
|
|
|
|
|
## RCS-ID: |
8
|
|
|
|
|
|
|
## Copyright: (c) 2003 Graciliano M. P. |
9
|
|
|
|
|
|
|
## Licence: This program is free software; you can redistribute it and/or |
10
|
|
|
|
|
|
|
## modify it under the same terms as Perl itself |
11
|
|
|
|
|
|
|
############################################################################# |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
package XML::Smart::Tie ; |
14
|
|
|
|
|
|
|
|
15
|
11
|
|
|
11
|
|
178
|
use 5.006 ; |
|
11
|
|
|
|
|
42
|
|
|
11
|
|
|
|
|
426
|
|
16
|
|
|
|
|
|
|
|
17
|
11
|
|
|
11
|
|
63
|
use strict ; |
|
11
|
|
|
|
|
16
|
|
|
11
|
|
|
|
|
307
|
|
18
|
11
|
|
|
11
|
|
50
|
use warnings ; |
|
11
|
|
|
|
|
17
|
|
|
11
|
|
|
|
|
340
|
|
19
|
|
|
|
|
|
|
|
20
|
11
|
|
|
11
|
|
52
|
use XML::Smart::Shared qw( _unset_sig_warn _reset_sig_warn ) ; |
|
11
|
|
|
|
|
18
|
|
|
11
|
|
|
|
|
662
|
|
21
|
|
|
|
|
|
|
|
22
|
11
|
|
|
11
|
|
57
|
use vars qw($VERSION) ; |
|
11
|
|
|
|
|
17
|
|
|
11
|
|
|
|
|
628
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$VERSION = 0.03 ; |
25
|
|
|
|
|
|
|
###################### |
26
|
|
|
|
|
|
|
# _GENERATE_NULLTREE # |
27
|
|
|
|
|
|
|
###################### |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub _generate_nulltree { |
30
|
|
|
|
|
|
|
|
31
|
11
|
|
|
11
|
|
51
|
no warnings ; |
|
11
|
|
|
|
|
21
|
|
|
11
|
|
|
|
|
20506
|
|
32
|
|
|
|
|
|
|
|
33
|
93
|
|
|
93
|
|
165
|
my $saver = shift ; |
34
|
93
|
|
|
|
|
218
|
my ( $K , $I ) = @_ ; |
35
|
|
|
|
|
|
|
|
36
|
93
|
|
|
|
|
196
|
$saver->{null} = 0 ; |
37
|
|
|
|
|
|
|
|
38
|
93
|
50
|
|
|
|
260
|
if ( !$saver->{keyprev} ) { return ;} |
|
0
|
|
|
|
|
0
|
|
39
|
|
|
|
|
|
|
|
40
|
93
|
|
|
|
|
150
|
my @tree = @{$saver->{keyprev}} ; |
|
93
|
|
|
|
|
322
|
|
41
|
93
|
50
|
|
|
|
259
|
if (!@tree) { return ;} |
|
0
|
|
|
|
|
0
|
|
42
|
|
|
|
|
|
|
|
43
|
93
|
100
|
66
|
|
|
366
|
if ( $I and $I > 0 ) { push(@tree , "[$I]") ;} |
|
3
|
|
|
|
|
11
|
|
44
|
|
|
|
|
|
|
|
45
|
93
|
|
|
|
|
180
|
my $tree = $saver->{tree} ; |
46
|
|
|
|
|
|
|
|
47
|
93
|
|
|
|
|
117
|
my ($keyprev , $iprev , $treeprev , $array , $key , $i) ; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
##print "GEN>> @tree\n" ; |
50
|
|
|
|
|
|
|
|
51
|
93
|
|
|
|
|
181
|
foreach my $tree_i ( @tree ) { |
52
|
|
|
|
|
|
|
#print "*> $tree_i >> $keyprev # $iprev \n" ; |
53
|
|
|
|
|
|
|
#use Data::Dumper ; |
54
|
|
|
|
|
|
|
#print Dumper( [$tree , $treeprev , $array] ) ; |
55
|
|
|
|
|
|
|
#print "=====================\n" ; |
56
|
|
|
|
|
|
|
|
57
|
156
|
50
|
66
|
|
|
520
|
if (ref($tree) ne 'HASH' && ref($tree) ne 'ARRAY') { |
58
|
0
|
|
|
|
|
0
|
my $cont = $$treeprev{$keyprev} ; |
59
|
0
|
|
|
|
|
0
|
$$treeprev{$keyprev} = {} ; |
60
|
0
|
|
|
|
|
0
|
$$treeprev{$keyprev}{CONTENT} = $cont ; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
156
|
100
|
|
|
|
647
|
if ($tree_i =~ /^\[(\d+)\]$/) { |
|
|
100
|
|
|
|
|
|
64
|
21
|
|
|
|
|
51
|
$i = $1 ; |
65
|
21
|
50
|
|
|
|
54
|
if (exists $$treeprev{$keyprev}) { |
66
|
21
|
100
|
|
|
|
75
|
if (ref $$treeprev{$keyprev} ne 'ARRAY') { |
67
|
9
|
|
|
|
|
19
|
my $prev = $$treeprev{$keyprev} ; |
68
|
9
|
|
|
|
|
28
|
$$treeprev{$keyprev} = [$prev] ; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
0
|
|
|
|
|
0
|
else { $$treeprev{$keyprev} = [] ;} |
72
|
|
|
|
|
|
|
|
73
|
21
|
100
|
|
|
|
74
|
if (!exists $$treeprev{$keyprev}[$i]) { $$treeprev{$keyprev}[$i] = {} ;} |
|
6
|
|
|
|
|
17
|
|
74
|
|
|
|
|
|
|
|
75
|
21
|
|
|
|
|
31
|
my $prev = $tree ; |
76
|
21
|
|
|
|
|
877
|
$tree = $$treeprev{$keyprev}[$i] ; |
77
|
21
|
|
|
|
|
34
|
$array = $$treeprev{$keyprev} ; |
78
|
21
|
|
|
|
|
24
|
$treeprev = $prev ; |
79
|
21
|
|
|
|
|
47
|
$iprev = $i ; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
elsif (ref $tree eq 'ARRAY') { |
82
|
3
|
50
|
|
|
|
13
|
if (!exists $$tree[0] ) { $$tree[0] = {} ;} |
|
0
|
|
|
|
|
0
|
|
83
|
3
|
50
|
33
|
|
|
29
|
if ( ref($$tree[0]) eq 'HASH' && !exists $$tree[0]{$tree_i} ) { $$tree[0]{$tree_i} = {} ;} |
|
3
|
|
|
|
|
12
|
|
84
|
|
|
|
|
|
|
|
85
|
3
|
|
|
|
|
6
|
my $prev = $tree ; |
86
|
3
|
|
|
|
|
7
|
$tree = $$prev[0]{$tree_i} ; |
87
|
3
|
|
|
|
|
5
|
$array = undef ; |
88
|
3
|
|
|
|
|
10
|
$treeprev = $$prev[0] ; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
else { |
91
|
132
|
100
|
|
|
|
296
|
if (exists $$tree{$tree_i}) { |
92
|
45
|
50
|
66
|
|
|
205
|
if (ref $$tree{$tree_i} ne 'HASH' && ref $$tree{$tree_i} ne 'ARRAY') { |
93
|
0
|
0
|
|
|
|
0
|
if ( $$tree{$tree_i} ne '' ) { |
94
|
0
|
|
|
|
|
0
|
my $cont = $$tree{$tree_i} ; |
95
|
0
|
|
|
|
|
0
|
$$tree{$tree_i} = {} ; |
96
|
0
|
|
|
|
|
0
|
$$tree{$tree_i}{CONTENT} = $cont ; |
97
|
|
|
|
|
|
|
} |
98
|
0
|
|
|
|
|
0
|
else { $$tree{$tree_i} = {} ;} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
else { |
102
|
87
|
100
|
|
|
|
224
|
if ( $treeprev ) { |
103
|
27
|
100
|
|
|
|
60
|
if ( $array ) { |
104
|
12
|
100
|
|
|
|
34
|
if ( ref($treeprev) eq 'ARRAY' ) { |
105
|
9
|
100
|
66
|
|
|
42
|
push( @{ $$treeprev[$iprev]{'/order'} } , keys_valids($$treeprev[$iprev]) ) if !$$treeprev[$iprev]{'/order'} || !@{ $$treeprev[$iprev]{'/order'} } ; |
|
6
|
|
|
|
|
29
|
|
|
3
|
|
|
|
|
18
|
|
106
|
9
|
|
|
|
|
20
|
push( @{ $$treeprev[$iprev]{'/order'} } , $tree_i) ; |
|
9
|
|
|
|
|
27
|
|
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
else { |
109
|
3
|
100
|
66
|
|
|
21
|
push( @{ $$treeprev{'/order'} } , keys_valids($treeprev) ) if !$$treeprev{'/order'} || !@{ $$treeprev{'/order'} } ; |
|
2
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
5
|
|
110
|
3
|
|
|
|
|
7
|
push( @{ $$treeprev{'/order'} } , $tree_i ) ; |
|
3
|
|
|
|
|
11
|
|
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
else { |
114
|
15
|
50
|
|
|
|
40
|
if ( ref($treeprev) eq 'ARRAY' ) { |
115
|
0
|
0
|
0
|
|
|
0
|
push( @{ $$treeprev[$iprev]{$keyprev}{'/order'} } , keys_valids($$treeprev[$iprev]{$keyprev}) ) if !$$treeprev[$iprev]{$keyprev}{'/order'} || !@{ $$treeprev[$iprev]{$keyprev}{'/order'} } ; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
116
|
0
|
|
|
|
|
0
|
push( @{ $$treeprev[$iprev]{$keyprev}{'/order'} } , $tree_i) ; |
|
0
|
|
|
|
|
0
|
|
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
else { |
119
|
15
|
100
|
66
|
|
|
68
|
push( @{ $$treeprev{$keyprev}{'/order'} } , keys_valids($$treeprev{$keyprev}) ) if !$$treeprev{$keyprev}{'/order'} || !@{ $$treeprev{$keyprev}{'/order'} } ; |
|
9
|
|
|
|
|
49
|
|
|
6
|
|
|
|
|
27
|
|
120
|
15
|
|
|
|
|
125
|
push( @{ $$treeprev{$keyprev}{'/order'} } , $tree_i ) ; |
|
15
|
|
|
|
|
49
|
|
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} |
124
|
87
|
|
|
|
|
276
|
$$tree{$tree_i} = {} ; |
125
|
|
|
|
|
|
|
} |
126
|
132
|
|
|
|
|
221
|
$keyprev = $tree_i ; |
127
|
132
|
|
|
|
|
160
|
$iprev = undef ; |
128
|
132
|
|
|
|
|
170
|
$treeprev = $tree ; |
129
|
132
|
|
|
|
|
197
|
$tree = $$tree{$tree_i} ; |
130
|
132
|
|
|
|
|
146
|
$array = undef ; |
131
|
132
|
|
|
|
|
313
|
$key = $tree_i ; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
93
|
|
|
|
|
211
|
$saver->{point} = $tree ; |
136
|
93
|
|
|
|
|
178
|
$saver->{back} = $treeprev ; |
137
|
93
|
|
|
|
|
298
|
$saver->{array} = $array ; |
138
|
93
|
|
|
|
|
234
|
$saver->{key} = $key ; |
139
|
93
|
|
|
|
|
155
|
$saver->{i} = $i ; |
140
|
|
|
|
|
|
|
|
141
|
93
|
|
|
|
|
149
|
$saver->{null} = 0 ; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
##use Data::Dumper ; print Dumper( $saver->{tree} , $saver->{point} , $saver->{back} , $saver->{array} ); |
144
|
|
|
|
|
|
|
|
145
|
93
|
|
|
|
|
248
|
return( 1 ) ; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub keys_valids { |
149
|
17
|
|
|
17
|
0
|
32
|
my $tree = shift ; |
150
|
17
|
50
|
|
|
|
51
|
return () if ref $tree ne 'HASH' ; |
151
|
17
|
|
|
|
|
25
|
my @keys ; |
152
|
|
|
|
|
|
|
|
153
|
17
|
|
|
|
|
101
|
foreach my $Key (sort keys %$tree ) { |
154
|
21
|
100
|
66
|
|
|
128
|
if ($Key eq '' || $Key eq '/order' || $Key eq '/nodes') { next ;} |
|
17
|
|
66
|
|
|
51
|
|
155
|
4
|
|
|
|
|
10
|
push(@keys , $Key) ; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
17
|
|
|
|
|
72
|
return @keys ; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
################# |
162
|
|
|
|
|
|
|
# _DELETE_XPATH # |
163
|
|
|
|
|
|
|
################# |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _delete_XPATH { |
166
|
186
|
|
|
186
|
|
403
|
my $xpath = delete $_[0]->{XPATH} ; |
167
|
186
|
|
|
|
|
356
|
$$xpath = undef ; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
########################## |
171
|
|
|
|
|
|
|
# XML::SMART::TIE::ARRAY # |
172
|
|
|
|
|
|
|
########################## |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
package XML::Smart::Tie::Array ; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub TIEARRAY { |
177
|
240
|
|
|
240
|
|
2294
|
my $class = shift ; |
178
|
240
|
|
|
|
|
318
|
my $saver = shift ; |
179
|
240
|
|
|
|
|
606
|
my $this = { saver => $saver } ; |
180
|
240
|
|
|
|
|
959
|
bless($this,$class) ; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub FETCH { |
184
|
195
|
|
|
195
|
|
1704
|
my $this = shift ; |
185
|
195
|
|
|
|
|
344
|
my ($i) = @_ ; |
186
|
195
|
|
|
|
|
406
|
my $key = $this->{saver}->{key} ; |
187
|
|
|
|
|
|
|
|
188
|
195
|
100
|
|
|
|
507
|
if ( $this->{saver}->{null} ) { |
189
|
3
|
|
|
|
|
14
|
&XML::Smart::Tie::_generate_nulltree($this->{saver},$key,$i) ; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
195
|
|
|
|
|
409
|
my $point = '' ; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
#print "A-FETCH>> $key , $i >> @{$this->{saver}->{keyprev}} >> [$this->{saver}->{null}]\n" ; |
195
|
|
|
|
|
|
|
|
196
|
195
|
100
|
|
|
|
590
|
if ($this->{saver}->{array}) { |
|
|
50
|
|
|
|
|
|
197
|
132
|
50
|
|
|
|
355
|
if (!exists $this->{saver}->{array}[$i] ) { |
198
|
0
|
|
|
|
|
0
|
return &XML::Smart::clone($this->{saver},"/[$i]") ; |
199
|
|
|
|
|
|
|
} |
200
|
132
|
|
|
|
|
316
|
$point = $this->{saver}->{array}[$i] ; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
elsif (exists $this->{saver}->{back}{$key}) { |
203
|
63
|
50
|
|
|
|
190
|
if (ref $this->{saver}->{back}{$key} eq 'ARRAY') { |
204
|
0
|
|
|
|
|
0
|
$point = $this->{saver}->{back}{$key}[$i] ; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
else { |
207
|
63
|
100
|
|
|
|
183
|
if ($i == 0) { $point = $this->{saver}->{back}{$key} ;} |
|
60
|
|
|
|
|
144
|
|
208
|
3
|
|
|
|
|
17
|
else { return &XML::Smart::clone($this->{saver},"/[$i]") ;} |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
else { |
212
|
0
|
|
|
|
|
0
|
return &XML::Smart::clone($this->{saver},"/[$i]") ; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
192
|
100
|
|
|
|
400
|
if (ref $point) { |
216
|
133
|
|
|
|
|
565
|
return &XML::Smart::clone($this->{saver},$point,undef,undef,undef,$i) ; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
else { |
219
|
59
|
|
|
|
|
214
|
return &XML::Smart::clone($this->{saver}, {},undef,undef,undef,$i,$point) ; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub STORE { |
224
|
42
|
|
|
42
|
|
566
|
my $this = shift ; |
225
|
42
|
|
|
|
|
67
|
my $i = shift ; |
226
|
42
|
|
|
|
|
110
|
my $key = $this->{saver}->{key} ; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
#print "A-STORE>> $key , $i >> @{$this->{saver}->{keyprev}} >> [$this->{saver}->{array}]\n" ; |
229
|
|
|
|
|
|
|
|
230
|
42
|
100
|
|
|
|
173
|
if ( $this->{saver}->{null} ) { |
231
|
18
|
|
|
|
|
54
|
&XML::Smart::Tie::_generate_nulltree($this->{saver},$key,$i) ; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
42
|
|
|
|
|
120
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
235
|
|
|
|
|
|
|
|
236
|
42
|
100
|
|
|
|
228
|
if ($this->{saver}->{array}) { |
|
|
100
|
|
|
|
|
|
237
|
9
|
50
|
33
|
|
|
136
|
if ( !exists $this->{saver}->{array}[$i] && $key !~ /^\/\.CONTENT/ ) { |
238
|
9
|
|
|
|
|
16
|
push( @{$this->{saver}->{back}->{'/order'}} , $key ) ; |
|
9
|
|
|
|
|
37
|
|
239
|
|
|
|
|
|
|
} |
240
|
9
|
|
|
|
|
43
|
return $this->{saver}->{array}[$i] = $_[0] ; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
elsif ($i == 0) { |
243
|
18
|
50
|
|
|
|
72
|
if (ref $this->{saver}->{back}{$key} eq 'ARRAY') { |
244
|
0
|
|
|
|
|
0
|
return $this->{saver}->{back}{$key}[0] = $_[0] ; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
else { |
247
|
18
|
|
|
|
|
92
|
return $this->{saver}->{back}{$key} = $_[0] ; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
else { |
251
|
15
|
50
|
|
|
|
54
|
if ( exists $this->{saver}->{back}{$key}) { |
252
|
15
|
|
|
|
|
43
|
my $k = $this->{saver}->{back}{$key} ; |
253
|
15
|
|
|
|
|
57
|
$this->{saver}->{back}{$key} = [$k] ; |
254
|
|
|
|
|
|
|
} |
255
|
0
|
|
|
|
|
0
|
else { $this->{saver}->{back}{$key} = [] ;} |
256
|
15
|
|
|
|
|
45
|
$this->{saver}->{array} = $this->{saver}->{back}{$key} ; |
257
|
|
|
|
|
|
|
|
258
|
15
|
50
|
33
|
|
|
100
|
if ( !exists $this->{saver}->{array}[$i] && $key !~ /^\/\.CONTENT/ ) { |
259
|
15
|
100
|
|
|
|
62
|
if ( !exists $this->{saver}->{back}->{'/order'} ) { |
260
|
5
|
50
|
33
|
|
|
10
|
my %keys = map { ( $_ eq '/order' || $_ eq '/nodes' ? () : ($_ => 1) ) } keys %{$this->{saver}->{back}} ; |
|
20
|
|
|
|
|
105
|
|
|
5
|
|
|
|
|
22
|
|
261
|
5
|
|
|
|
|
14
|
push( @{$this->{saver}->{back}->{'/order'}} , sort keys %keys ) ; |
|
5
|
|
|
|
|
48
|
|
262
|
|
|
|
|
|
|
} |
263
|
15
|
|
|
|
|
28
|
push( @{$this->{saver}->{back}->{'/order'}} , $key ) ; |
|
15
|
|
|
|
|
51
|
|
264
|
|
|
|
|
|
|
} |
265
|
15
|
|
|
|
|
85
|
return $this->{saver}->{array}[$i] = $_[0] ; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
0
|
return ; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub FETCHSIZE { |
272
|
11
|
|
|
11
|
|
71
|
no warnings ; |
|
11
|
|
|
|
|
49
|
|
|
11
|
|
|
|
|
502298
|
|
273
|
33
|
|
|
33
|
|
400
|
my $this = shift ; |
274
|
33
|
|
|
|
|
50
|
my $i = shift ; |
275
|
33
|
|
|
|
|
77
|
my $key = $this->{saver}->{key} ; |
276
|
|
|
|
|
|
|
|
277
|
33
|
|
|
|
|
125
|
my @call = caller ; |
278
|
|
|
|
|
|
|
|
279
|
33
|
100
|
33
|
|
|
169
|
if ($this->{saver}->{array}) { |
|
|
50
|
|
|
|
|
|
280
|
21
|
|
|
|
|
32
|
return( $#{$this->{saver}->{array}} + 1 ) ; |
|
21
|
|
|
|
|
123
|
|
281
|
|
|
|
|
|
|
} |
282
|
12
|
|
|
|
|
50
|
elsif ($i == 0 && exists $this->{saver}->{back}{$key}) { return 1 ;} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
## Always return 1! Then when the FETCH(0) is made, it returns a NULL object. |
285
|
|
|
|
|
|
|
## This will avoid warnings! |
286
|
0
|
|
|
|
|
0
|
return 1 ; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub EXISTS { |
290
|
0
|
|
|
0
|
|
0
|
my $this = shift ; |
291
|
0
|
|
|
|
|
0
|
my $i = shift ; |
292
|
0
|
|
|
|
|
0
|
my $key = $this->{saver}->{key} ; |
293
|
|
|
|
|
|
|
|
294
|
0
|
0
|
0
|
|
|
0
|
if ($this->{saver}->{array}) { |
|
|
0
|
|
|
|
|
|
295
|
0
|
0
|
|
|
|
0
|
if (exists $this->{saver}->{array}[$i]) { return 1 ;} |
|
0
|
|
|
|
|
0
|
|
296
|
|
|
|
|
|
|
} |
297
|
0
|
|
|
|
|
0
|
elsif ($i == 0 && exists $this->{saver}->{back}{$key}) { return 1 ;} |
298
|
|
|
|
|
|
|
|
299
|
0
|
|
|
|
|
0
|
return ; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub DELETE { |
303
|
3
|
|
|
3
|
|
46
|
my $this = shift ; |
304
|
3
|
|
|
|
|
9
|
my $i = shift ; |
305
|
3
|
|
|
|
|
9
|
my $key = $this->{saver}->{key} ; |
306
|
|
|
|
|
|
|
|
307
|
3
|
|
|
|
|
18
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
308
|
|
|
|
|
|
|
|
309
|
3
|
50
|
33
|
|
|
35
|
if ($this->{saver}->{array}) { |
|
|
50
|
|
|
|
|
|
310
|
0
|
0
|
|
|
|
0
|
if (exists $this->{saver}->{array}[$i]) { |
311
|
0
|
|
|
|
|
0
|
return delete $this->{saver}->{array}[$i] ; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
elsif ($i == 0 && exists $this->{saver}->{back}{$key}) { |
315
|
3
|
|
|
|
|
12
|
my $k = $this->{saver}->{back}{$key} ; |
316
|
3
|
50
|
|
|
|
19
|
delete $this->{saver}->{back}{'/nodes'}{$k} if defined $this->{saver}->{back}{'/nodes'} ; |
317
|
3
|
|
|
|
|
8
|
delete $this->{saver}->{back}{$key} ; |
318
|
3
|
|
|
|
|
11
|
return $k ; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
0
|
return ; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub CLEAR { |
325
|
0
|
|
|
0
|
|
0
|
my $this = shift ; |
326
|
0
|
|
|
|
|
0
|
my $key = $this->{saver}->{key} ; |
327
|
|
|
|
|
|
|
|
328
|
0
|
|
|
|
|
0
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
329
|
|
|
|
|
|
|
|
330
|
0
|
0
|
|
|
|
0
|
if ($this->{saver}->{array}) { |
|
|
0
|
|
|
|
|
|
331
|
0
|
|
|
|
|
0
|
return @{$this->{saver}->{array}} = () ; |
|
0
|
|
|
|
|
0
|
|
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
elsif (exists $this->{saver}->{back}{$key}) { |
334
|
0
|
|
|
|
|
0
|
return $this->{saver}->{back}{$key} = () ; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
0
|
return ; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub PUSH { |
341
|
15
|
|
|
15
|
|
148
|
my $this = shift ; |
342
|
15
|
|
|
|
|
39
|
my $key = $this->{saver}->{key} ; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
##print "PUSH>> $key >> @{$this->{saver}->{keyprev}}\n" ; |
345
|
|
|
|
|
|
|
|
346
|
15
|
|
|
|
|
22
|
my $gen_null ; |
347
|
15
|
100
|
|
|
|
54
|
if ( $this->{saver}->{null} ) { |
348
|
6
|
|
|
|
|
18
|
$gen_null = &XML::Smart::Tie::_generate_nulltree($this->{saver},$key) ; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
15
|
|
|
|
|
41
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
352
|
|
|
|
|
|
|
|
353
|
15
|
100
|
|
|
|
48
|
if ( !$this->{saver}->{array} ) { |
354
|
12
|
50
|
|
|
|
41
|
if (exists $this->{saver}->{back}{$key}) { |
355
|
12
|
50
|
|
|
|
48
|
if ( ref $this->{saver}->{back}{$key} ne 'ARRAY' ) { |
356
|
12
|
|
|
|
|
26
|
my $k = $this->{saver}->{back}{$key} ; |
357
|
12
|
100
|
|
|
|
111
|
$this->{saver}->{back}{$key} = [ ( $gen_null ? () : $k) ] ; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
} |
360
|
0
|
|
|
|
|
0
|
else { $this->{saver}->{back}{$key} = [] ;} |
361
|
12
|
|
|
|
|
35
|
$this->{saver}->{array} = $this->{saver}->{back}{$key} ; |
362
|
12
|
|
|
|
|
33
|
$this->{saver}->{point} = $this->{saver}->{back}{$key}[0] ; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
15
|
|
|
|
|
26
|
return push(@{$this->{saver}->{array}} , @_) ; |
|
15
|
|
|
|
|
62
|
|
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub UNSHIFT { |
369
|
3
|
|
|
3
|
|
35
|
my $this = shift ; |
370
|
3
|
|
|
|
|
9
|
my $key = $this->{saver}->{key} ; |
371
|
|
|
|
|
|
|
|
372
|
3
|
|
|
|
|
6
|
my $gen_null ; |
373
|
3
|
50
|
|
|
|
12
|
if ( $this->{saver}->{null} ) { |
374
|
0
|
|
|
|
|
0
|
$gen_null = &XML::Smart::Tie::_generate_nulltree($this->{saver},$key) ; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
3
|
|
|
|
|
11
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
378
|
|
|
|
|
|
|
|
379
|
3
|
50
|
|
|
|
11
|
if ( !$this->{saver}->{array} ) { |
380
|
0
|
0
|
|
|
|
0
|
if (exists $this->{saver}->{back}{$key}) { |
381
|
0
|
0
|
|
|
|
0
|
if ( ref $this->{saver}->{back}{$key} ne 'ARRAY' ) { |
382
|
0
|
|
|
|
|
0
|
my $k = $this->{saver}->{back}{$key} ; |
383
|
0
|
0
|
|
|
|
0
|
$this->{saver}->{back}{$key} = [ ( $gen_null ? () : $k) ] ; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
0
|
|
|
|
|
0
|
else { $this->{saver}->{back}{$key} = [] ;} |
387
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = $this->{saver}->{back}{$key} ; |
388
|
0
|
|
|
|
|
0
|
$this->{saver}->{point} = $this->{saver}->{back}{$key}[0] ; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
3
|
|
|
|
|
7
|
return unshift(@{$this->{saver}->{array}} , @_ ) ; |
|
3
|
|
|
|
|
15
|
|
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub SPLICE { |
395
|
0
|
|
|
0
|
|
0
|
my $this = shift ; |
396
|
0
|
|
0
|
|
|
0
|
my $offset = shift || 0 ; |
397
|
0
|
|
0
|
|
|
0
|
my $length = shift || $this->FETCHSIZE() - $offset ; |
398
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
0
|
my $key = $this->{saver}->{key} ; |
400
|
|
|
|
|
|
|
|
401
|
0
|
0
|
|
|
|
0
|
if ( $this->{saver}->{null} ) { |
402
|
0
|
|
|
|
|
0
|
&XML::Smart::Tie::_generate_nulltree($this->{saver},$key) ; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
0
|
|
|
|
|
0
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
406
|
|
|
|
|
|
|
|
407
|
0
|
0
|
|
|
|
0
|
if ( !$this->{saver}->{array} ) { |
408
|
0
|
0
|
|
|
|
0
|
if (exists $this->{saver}->{back}{$key}) { |
409
|
0
|
0
|
|
|
|
0
|
if ( ref $this->{saver}->{back}{$key} ne 'ARRAY' ) { |
410
|
0
|
|
|
|
|
0
|
my $k = $this->{saver}->{back}{$key} ; |
411
|
0
|
|
|
|
|
0
|
$this->{saver}->{back}{$key} = [$k] ; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
} |
414
|
0
|
|
|
|
|
0
|
else { $this->{saver}->{back}{$key} = [] ;} |
415
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = $this->{saver}->{back}{$key} ; |
416
|
0
|
|
|
|
|
0
|
$this->{saver}->{point} = $this->{saver}->{back}{$key}[0] ; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
0
|
|
|
|
|
0
|
return splice(@{$this->{saver}->{array}} , $offset , $length , @_) ; |
|
0
|
|
|
|
|
0
|
|
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub POP { |
423
|
6
|
|
|
6
|
|
80
|
my $this = shift ; |
424
|
6
|
|
|
|
|
20
|
my $key = $this->{saver}->{key} ; |
425
|
|
|
|
|
|
|
|
426
|
6
|
|
|
|
|
26
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
427
|
|
|
|
|
|
|
|
428
|
6
|
|
|
|
|
9
|
my $pop ; |
429
|
|
|
|
|
|
|
|
430
|
6
|
100
|
66
|
|
|
46
|
if (!$this->{saver}->{array} && exists $this->{saver}->{back}{$key}) { |
431
|
3
|
50
|
|
|
|
16
|
if ( ref $this->{saver}->{back}{$key} eq 'ARRAY' ) { |
432
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = $this->{saver}->{back}{$key} ; |
433
|
0
|
|
|
|
|
0
|
$this->{saver}->{point} = $this->{saver}->{back}{$key}[0] ; |
434
|
|
|
|
|
|
|
} |
435
|
3
|
|
|
|
|
9
|
else { $pop = delete $this->{saver}->{back}{$key} ;} |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
6
|
100
|
|
|
|
27
|
if ($this->{saver}->{array}) { |
439
|
3
|
|
|
|
|
7
|
$pop = pop( @{$this->{saver}->{array}} ) ; |
|
3
|
|
|
|
|
12
|
|
440
|
|
|
|
|
|
|
|
441
|
3
|
50
|
|
|
|
5
|
if ( $#{$this->{saver}->{array}} == 0 ) { |
|
3
|
50
|
|
|
|
17
|
|
|
3
|
|
|
|
|
197
|
|
442
|
0
|
|
|
|
|
0
|
$this->{saver}->{back}{$key} = $this->{saver}->{array}[0] ; |
443
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = undef ; |
444
|
0
|
|
|
|
|
0
|
$this->{saver}->{i} = undef ; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
elsif ( $#{$this->{saver}->{array}} < 0 ) { |
447
|
0
|
|
|
|
|
0
|
$this->{saver}->{back}{$key} = undef ; |
448
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = undef ; |
449
|
0
|
|
|
|
|
0
|
$this->{saver}->{i} = undef ; |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
6
|
|
|
|
|
23
|
return $pop ; |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub SHIFT { |
457
|
3
|
|
|
3
|
|
43
|
my $this = shift ; |
458
|
3
|
|
|
|
|
10
|
my $key = $this->{saver}->{key} ; |
459
|
|
|
|
|
|
|
|
460
|
3
|
|
|
|
|
13
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
461
|
|
|
|
|
|
|
|
462
|
3
|
|
|
|
|
5
|
my $shift ; |
463
|
|
|
|
|
|
|
|
464
|
3
|
50
|
33
|
|
|
20
|
if (!$this->{saver}->{array} && exists $this->{saver}->{back}{$key}) { |
465
|
0
|
0
|
|
|
|
0
|
if ( ref $this->{saver}->{back}{$key} eq 'ARRAY' ) { |
466
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = $this->{saver}->{back}{$key} ; |
467
|
0
|
|
|
|
|
0
|
$this->{saver}->{point} = $this->{saver}->{back}{$key}[0] ; |
468
|
|
|
|
|
|
|
} |
469
|
0
|
|
|
|
|
0
|
else { $shift = delete $this->{saver}->{back}{$key} ;} |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
3
|
50
|
|
|
|
17
|
if ($this->{saver}->{array}) { |
473
|
3
|
|
|
|
|
7
|
$shift = shift( @{$this->{saver}->{array}} ) ; |
|
3
|
|
|
|
|
9
|
|
474
|
|
|
|
|
|
|
|
475
|
3
|
50
|
|
|
|
8
|
if ( $#{$this->{saver}->{array}} == 0 ) { |
|
3
|
0
|
|
|
|
17
|
|
|
0
|
|
|
|
|
0
|
|
476
|
3
|
|
|
|
|
13
|
$this->{saver}->{back}{$key} = $this->{saver}->{array}[0] ; |
477
|
3
|
|
|
|
|
8
|
$this->{saver}->{array} = undef ; |
478
|
3
|
|
|
|
|
8
|
$this->{saver}->{i} = undef ; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
elsif ( $#{$this->{saver}->{array}} < 0 ) { |
481
|
0
|
|
|
|
|
0
|
$this->{saver}->{back}{$key} = undef ; |
482
|
0
|
|
|
|
|
0
|
$this->{saver}->{array} = undef ; |
483
|
0
|
|
|
|
|
0
|
$this->{saver}->{i} = undef ; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
3
|
|
|
|
|
12
|
return $shift ; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
0
|
|
|
0
|
|
0
|
sub STORESIZE {} |
491
|
0
|
|
|
0
|
|
0
|
sub EXTEND {} |
492
|
|
|
|
|
|
|
|
493
|
0
|
|
|
0
|
|
0
|
sub UNTIE {} |
494
|
0
|
|
|
0
|
|
0
|
sub DESTROY {} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
######################### |
497
|
|
|
|
|
|
|
# XML::SMART::TIE::HASH # |
498
|
|
|
|
|
|
|
######################### |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
package XML::Smart::Tie::Hash ; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub TIEHASH { |
503
|
927
|
|
|
927
|
|
22426
|
my $class = shift ; |
504
|
927
|
|
|
|
|
1404
|
my $saver = shift ; |
505
|
927
|
|
|
|
|
2262
|
my $this = { saver => $saver } ; |
506
|
927
|
|
|
|
|
4060
|
bless($this,$class) ; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub FETCH { |
510
|
1217
|
|
|
1217
|
|
71365
|
my $this = shift ; |
511
|
1217
|
|
|
|
|
1765
|
my ( $key ) = @_ ; |
512
|
1217
|
|
|
|
|
1255
|
my $i ; |
513
|
|
|
|
|
|
|
|
514
|
1217
|
100
|
|
|
|
3375
|
if ( $this->{saver}->{null} ) { |
515
|
15
|
|
|
|
|
62
|
&XML::Smart::Tie::_generate_nulltree($this->{saver},$key,$i) ; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
#print "H-FETCH>> $key >> ". ( $this->{saver}->{keyprev} ? "@{$this->{saver}->{keyprev}}" : '' ) ."\n" ; |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
#print "**FETCH>> $this->{saver}->{point}\n" ; |
521
|
|
|
|
|
|
|
|
522
|
1217
|
|
|
|
|
1519
|
my $point = '' ; |
523
|
1217
|
|
|
|
|
1165
|
my $array ; |
524
|
|
|
|
|
|
|
|
525
|
1217
|
100
|
|
|
|
4949
|
if (0&&ref($this->{saver}->{point}) eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
526
|
|
|
|
|
|
|
$array = $this->{saver}->{point} ; |
527
|
|
|
|
|
|
|
$point = $this->{saver}->{point}[0] ; |
528
|
|
|
|
|
|
|
my $xml = &XML::Smart::clone($this->{saver},$point,undef,$array, undef,0) ; |
529
|
|
|
|
|
|
|
return $xml->{$key} ; |
530
|
|
|
|
|
|
|
} |
531
|
0
|
|
|
|
|
0
|
elsif (ref($this->{saver}->{point}{$key}) eq 'ARRAY') { |
532
|
225
|
|
|
|
|
507
|
$array = $this->{saver}->{point}{$key} ; |
533
|
225
|
|
|
|
|
470
|
$point = $this->{saver}->{point}{$key}[0] ; |
534
|
225
|
|
|
|
|
309
|
$i = 0 ; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
elsif ( exists $this->{saver}->{point}{$key} ) { |
537
|
848
|
|
|
|
|
1739
|
$point = $this->{saver}->{point}{$key} ; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
else { |
540
|
144
|
|
|
|
|
545
|
return &XML::Smart::clone($this->{saver},$key) ; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
1073
|
100
|
|
|
|
1899
|
if (ref $point) { |
544
|
823
|
|
|
|
|
2611
|
return &XML::Smart::clone($this->{saver},$point,undef,$array,$key,$i) ; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
else { |
547
|
250
|
|
|
|
|
952
|
return &XML::Smart::clone($this->{saver},{} ,undef,$array,$key,$i,$point) ; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub FIRSTKEY { |
552
|
40
|
|
|
40
|
|
428
|
my $this = shift ; |
553
|
|
|
|
|
|
|
|
554
|
40
|
50
|
|
|
|
139
|
if (!$this->{saver}->{keyorder}) { $this->_keyorder ;} |
|
40
|
|
|
|
|
124
|
|
555
|
|
|
|
|
|
|
|
556
|
40
|
|
|
|
|
69
|
return( @{$this->{saver}->{keyorder}}[0] ) ; |
|
40
|
|
|
|
|
212
|
|
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub NEXTKEY { |
560
|
46
|
|
|
46
|
|
65
|
my $this = shift ; |
561
|
46
|
|
|
|
|
66
|
my ( $key ) = @_ ; |
562
|
|
|
|
|
|
|
|
563
|
46
|
50
|
|
|
|
143
|
if (!$this->{saver}->{keyorder}) { $this->_keyorder ;} |
|
0
|
|
|
|
|
0
|
|
564
|
|
|
|
|
|
|
|
565
|
46
|
|
|
|
|
53
|
my $found ; |
566
|
46
|
|
|
|
|
61
|
foreach my $key_i ( @{$this->{saver}->{keyorder}} ) { |
|
46
|
|
|
|
|
101
|
|
567
|
91
|
100
|
|
|
|
163
|
if ($found) { return($key_i) ;} |
|
18
|
|
|
|
|
73
|
|
568
|
73
|
100
|
|
|
|
154
|
if ($key eq $key_i) { $found = 1 ;} |
|
46
|
|
|
|
|
87
|
|
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
28
|
|
|
|
|
112
|
return ; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub STORE { |
575
|
114
|
|
|
114
|
|
1616
|
my $this = shift ; |
576
|
114
|
|
|
|
|
205
|
my $key = shift ; |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
##print "H-STORE>> $key >> @{$this->{saver}->{keyprev}} >> [$this->{saver}->{null}]\n" ; |
579
|
|
|
|
|
|
|
|
580
|
114
|
100
|
|
|
|
365
|
if ( $this->{saver}->{null} ) { |
581
|
48
|
|
|
|
|
194
|
&XML::Smart::Tie::_generate_nulltree($this->{saver},$key) ; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
114
|
|
|
|
|
327
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
##my @call = caller ; |
587
|
|
|
|
|
|
|
##print "***STORE>> $this->{saver}->{point} [@call] $_[0]\n" ; |
588
|
|
|
|
|
|
|
|
589
|
114
|
50
|
|
|
|
626
|
if (ref($this->{saver}->{point}) eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
590
|
0
|
|
|
|
|
0
|
return $this->{saver}->{point}[0]{$key} = $_[0] ; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
elsif ( ref($this->{saver}->{point}{$key}) eq 'ARRAY' ) { |
593
|
0
|
|
|
|
|
0
|
return $this->{saver}->{point}{$key}[0] = $_[0] ; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
else { |
596
|
114
|
100
|
66
|
|
|
450
|
if ( defined $this->{saver}->{content} && ( keys %{$this->{saver}->{point}} ) < 1 ) { |
|
26
|
|
|
|
|
308
|
|
597
|
26
|
|
|
|
|
68
|
my $prev_key = $this->{saver}->{key} ; |
598
|
26
|
|
|
|
|
73
|
$this->{saver}->{back}{$prev_key} = {} ; |
599
|
26
|
|
|
|
|
41
|
$this->{saver}->{back}{$prev_key}{CONTENT} = ${$this->{saver}->{content}} ; |
|
26
|
|
|
|
|
102
|
|
600
|
26
|
|
|
|
|
75
|
delete $this->{saver}->{content} ; |
601
|
26
|
|
|
|
|
77
|
$this->{saver}->{point} = $this->{saver}->{back}{$prev_key} ; |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
|
604
|
114
|
100
|
|
|
|
360
|
if ( !exists $this->{saver}->{point}{$key} ) { |
605
|
90
|
100
|
66
|
|
|
519
|
if ($key ne '/order' && $key ne '/nodes') { |
606
|
84
|
100
|
|
|
|
251
|
if (!$this->{saver}->{keyorder}) { $this->_keyorder ;} |
|
72
|
|
|
|
|
236
|
|
607
|
84
|
|
|
|
|
137
|
push(@{$this->{saver}->{keyorder}} , $key) ; |
|
84
|
|
|
|
|
280
|
|
608
|
84
|
|
|
|
|
124
|
push(@{$this->{saver}->{point}{'/order'}} , $key ) ; |
|
84
|
|
|
|
|
280
|
|
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
} |
611
|
114
|
|
|
|
|
580
|
return $this->{saver}->{point}{$key} = $_[0] ; |
612
|
|
|
|
|
|
|
} |
613
|
0
|
|
|
|
|
0
|
return ; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
sub DELETE { |
617
|
0
|
|
|
0
|
|
0
|
my $this = shift ; |
618
|
0
|
|
|
|
|
0
|
my ( $key ) = @_ ; |
619
|
|
|
|
|
|
|
|
620
|
0
|
0
|
|
|
|
0
|
if ( exists $this->{saver}->{point}{$key} ) { |
621
|
0
|
|
|
|
|
0
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
622
|
0
|
|
|
|
|
0
|
$this->{saver}->{keyorder} = undef ; |
623
|
|
|
|
|
|
|
|
624
|
0
|
0
|
|
|
|
0
|
if ( defined $this->{saver}->{point}{'/order'} ) { |
625
|
0
|
|
|
|
|
0
|
my (@order_ok , $set) ; |
626
|
|
|
|
|
|
|
|
627
|
0
|
|
|
|
|
0
|
foreach my $order_i ( @{ $this->{saver}->{point}{'/order'} } ) { |
|
0
|
|
|
|
|
0
|
|
628
|
0
|
0
|
|
|
|
0
|
if ($order_i eq $key) { $set = 1 ;} |
|
0
|
|
|
|
|
0
|
|
629
|
0
|
|
|
|
|
0
|
else { push(@order_ok , $order_i) ;} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
0
|
0
|
|
|
|
0
|
@{ $this->{saver}->{point}{'/order'} } = @order_ok if $set ; |
|
0
|
|
|
|
|
0
|
|
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
0
|
0
|
|
|
|
0
|
delete $this->{saver}->{point}{'/nodes'}{$key} if defined $this->{saver}->{point}{'/nodes'}{$key} ; |
636
|
0
|
|
|
|
|
0
|
return delete $this->{saver}->{point}{$key} ; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
0
|
|
|
|
|
0
|
return ; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub CLEAR { |
643
|
0
|
|
|
0
|
|
0
|
my $this = shift ; |
644
|
0
|
|
|
|
|
0
|
&XML::Smart::Tie::_delete_XPATH($this->{saver}) ; |
645
|
0
|
|
|
|
|
0
|
$this->{saver}->{keyorder} = undef ; |
646
|
0
|
|
|
|
|
0
|
%{$this->{saver}->{point}} = () ; |
|
0
|
|
|
|
|
0
|
|
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub EXISTS { |
650
|
0
|
|
|
0
|
|
0
|
my $this = shift ; |
651
|
0
|
|
|
|
|
0
|
my ( $key ) = @_ ; |
652
|
0
|
0
|
|
|
|
0
|
if ( exists $this->{saver}->{point}{$key} ) { return( 1 ) ;} |
|
0
|
|
|
|
|
0
|
|
653
|
0
|
|
|
|
|
0
|
return ; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
0
|
|
|
0
|
|
0
|
sub UNTIE {} |
657
|
0
|
|
|
0
|
|
0
|
sub DESTROY {} |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
sub _keyorder { |
660
|
112
|
|
|
112
|
|
169
|
my $this = shift ; |
661
|
112
|
|
|
|
|
160
|
my @order ; |
662
|
|
|
|
|
|
|
|
663
|
112
|
100
|
|
|
|
344
|
if ( $this->{saver}->{point}{'/order'} ) { |
664
|
31
|
|
|
|
|
52
|
my %keys ; |
665
|
31
|
|
|
|
|
51
|
foreach my $keys_i ( @{ $this->{saver}->{point}{'/order'} } , sort keys %{ $this->{saver}->{point} } ) { |
|
31
|
|
|
|
|
103
|
|
|
31
|
|
|
|
|
240
|
|
666
|
156
|
100
|
66
|
|
|
855
|
if ($keys_i eq '' || $keys_i eq '/order' || $keys_i eq '/nodes') { next ;} |
|
50
|
|
100
|
|
|
80
|
|
667
|
106
|
100
|
|
|
|
292
|
if ( !$keys{$keys_i} ) { |
668
|
49
|
|
|
|
|
78
|
push(@order , $keys_i) ; |
669
|
49
|
|
|
|
|
103
|
$keys{$keys_i} = 1 ; |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
else { |
674
|
81
|
|
|
|
|
141
|
foreach my $Key ( sort keys %{ $this->{saver}->{point} } ) { |
|
81
|
|
|
|
|
942
|
|
675
|
18
|
100
|
33
|
|
|
165
|
if ($Key eq '' || $Key eq '/order' || $Key eq '/nodes') { next ;} |
|
3
|
|
66
|
|
|
8
|
|
676
|
15
|
|
|
|
|
50
|
push(@order , $Key) ; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
|
680
|
112
|
|
|
|
|
528
|
$this->{saver}->{keyorder} = \@order ; |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
######################### |
684
|
|
|
|
|
|
|
# XML::SMART::TIESCALAR # |
685
|
|
|
|
|
|
|
######################### |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
package XML::Smart::TieScalar ; |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub TIESCALAR { |
690
|
8
|
|
|
8
|
|
15
|
my $class = shift ; |
691
|
8
|
|
|
|
|
33
|
my $this = bless( { p => $_[0] } , __PACKAGE__ ) ; |
692
|
8
|
|
|
|
|
30
|
return $this ; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
sub FETCH { |
696
|
51
|
|
|
51
|
|
64
|
my $this = shift ; |
697
|
51
|
|
|
|
|
57
|
my $wantarray = shift ; |
698
|
|
|
|
|
|
|
|
699
|
51
|
|
|
|
|
50
|
my ($data , @data) ; |
700
|
51
|
|
|
|
|
88
|
foreach my $k_i ( $this->_get_content_keys ) { |
701
|
141
|
100
|
|
|
|
186
|
if ( $wantarray ) { push(@data , $this->{p}{$k_i}) ;} |
|
9
|
|
|
|
|
19
|
|
702
|
132
|
|
|
|
|
235
|
else { $data .= $this->{p}{$k_i} ;} |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
51
|
100
|
|
|
|
118
|
return @data if $wantarray ; |
706
|
48
|
|
|
|
|
256
|
return $data ; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
sub STORE { |
710
|
6
|
|
|
6
|
|
10
|
my $this = shift ; |
711
|
6
|
100
|
|
|
|
18
|
my $i = $#_ > 0 ? shift : undef ; |
712
|
|
|
|
|
|
|
|
713
|
6
|
100
|
|
|
|
54
|
if ( $i =~ /^\d+$/ ) { |
714
|
3
|
|
|
|
|
6
|
my $set ; |
715
|
3
|
|
|
|
|
9
|
foreach my $k_i ( $this->_get_content_keys ) { |
716
|
6
|
100
|
|
|
|
81
|
if ( $k_i =~ /^\/\.CONTENT\/$i$/ ) { |
717
|
3
|
|
|
|
|
7
|
$this->{p}{$k_i} = $_[0] ; |
718
|
3
|
|
|
|
|
6
|
$set = 1 ; |
719
|
3
|
|
|
|
|
6
|
last ; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
3
|
50
|
|
|
|
12
|
if ( !$set ) { |
724
|
0
|
|
|
|
|
0
|
$this->{p}{"/.CONTENT/$i"} = $_[0] ; |
725
|
0
|
|
|
|
|
0
|
push( @{$this->{p}{'/order'}} , "/.CONTENT/$i") ; |
|
0
|
|
|
|
|
0
|
|
726
|
0
|
|
|
|
|
0
|
$this->_cache_keys ; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
|
729
|
3
|
|
|
|
|
11
|
return $this->{p}{CONTENT} ; |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
3
|
|
|
|
|
16
|
untie $this->{p}{CONTENT} ; |
733
|
|
|
|
|
|
|
|
734
|
3
|
|
|
|
|
12
|
foreach my $k_i ( $this->_get_content_keys ) { |
735
|
9
|
|
|
|
|
16
|
delete $this->{p}{$k_i} ; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
3
|
50
|
|
|
|
52
|
if ( $this->{p}{'/order'} ) { |
739
|
3
|
|
|
|
|
8
|
my @order = @{$this->{p}{'/order'}} ; |
|
3
|
|
|
|
|
11
|
|
740
|
3
|
|
|
|
|
4
|
my @order_ok ; |
741
|
3
|
100
|
|
|
|
10
|
foreach my $order_i ( @order ) { push(@order_ok , $order_i) if $order_i !~ /^\/\.CONTENT\/\d+$/ ;} |
|
18
|
|
|
|
|
51
|
|
742
|
3
|
50
|
|
|
|
12
|
if (@order_ok) { $this->{p}{'/order'} = \@order_ok ;} |
|
3
|
|
|
|
|
12
|
|
743
|
0
|
|
|
|
|
0
|
else { delete $this->{p}{'/order'} ;} |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
3
|
|
|
|
|
17
|
$this->{p}{CONTENT} = $_[0] ; |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
3
|
|
|
3
|
|
7
|
sub UNTIE {} |
750
|
0
|
|
|
0
|
|
0
|
sub DESTROY {} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
sub _cache_keys { |
753
|
8
|
|
|
8
|
|
13
|
my $this = shift ; |
754
|
8
|
|
|
|
|
12
|
delete $this->{K} ; |
755
|
8
|
|
|
|
|
29
|
my @keys = $this->_get_content_keys ; |
756
|
8
|
|
|
|
|
39
|
$this->{K} = \@keys ; |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
sub _get_content_keys { |
760
|
65
|
|
|
65
|
|
66
|
my $this = shift ; |
761
|
65
|
100
|
|
|
|
135
|
return @{$this->{K}} if $this->{K} ; |
|
57
|
|
|
|
|
147
|
|
762
|
|
|
|
|
|
|
|
763
|
8
|
|
|
|
|
11
|
my %keys ; |
764
|
8
|
|
|
|
|
10
|
foreach my $Key ( keys %{ $this->{p} } ) { |
|
8
|
|
|
|
|
24
|
|
765
|
60
|
100
|
|
|
|
135
|
if ( $Key =~ /^\/\.CONTENT\/(\d+)$/ ) { $keys{$1} = $Key ;} |
|
20
|
|
|
|
|
53
|
|
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
8
|
|
|
|
|
44
|
my @keys = map { $keys{$_} } sort { $a <=> $b } keys %keys ; |
|
20
|
|
|
|
|
42
|
|
|
15
|
|
|
|
|
69
|
|
769
|
|
|
|
|
|
|
|
770
|
8
|
|
|
|
|
89
|
return @keys ; |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
####### |
774
|
|
|
|
|
|
|
# END # |
775
|
|
|
|
|
|
|
####### |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
1; |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
|