line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
|
|
|
|
|
|
# 4AIDCLW - XML::Merge.pm created by Pip Stuart |
3
|
|
|
|
|
|
|
# to intelligently merge XML documents as parsed XML::XPath objects. |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Plan: |
6
|
|
|
|
|
|
|
# if same-named root nodes, |
7
|
|
|
|
|
|
|
# merge straight |
8
|
|
|
|
|
|
|
# elsif root of 2nd exists in 1st, |
9
|
|
|
|
|
|
|
# merge at first match |
10
|
|
|
|
|
|
|
# else |
11
|
|
|
|
|
|
|
# append 2nd root as new last child of 1st root |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# XML::Merge new(filename => 'fnam'[, ]) |
14
|
|
|
|
|
|
|
# inherits XML::Tidy which inherits XML::XPath. |
15
|
|
|
|
|
|
|
# Merge creates an object with a merge() member which creates another |
16
|
|
|
|
|
|
|
# XPath object && combines the result back into the main object. |
17
|
|
|
|
|
|
|
# optn: |
18
|
|
|
|
|
|
|
# merge below specified context |
19
|
|
|
|
|
|
|
# id attributes: 'id', 'name', && 'handle' (default) |
20
|
|
|
|
|
|
|
# join comments of same context (leave separate default) |
21
|
|
|
|
|
|
|
# source-file-stamp merged comments |
22
|
|
|
|
|
|
|
# time-stamp merged comments |
23
|
|
|
|
|
|
|
# pt-stamp merged comments |
24
|
|
|
|
|
|
|
# conflict rules: |
25
|
|
|
|
|
|
|
# main wins (default) |
26
|
|
|
|
|
|
|
# last-in wins (aka. clobber) |
27
|
|
|
|
|
|
|
# newer modification date wins |
28
|
|
|
|
|
|
|
# warn (croak conflict) |
29
|
|
|
|
|
|
|
# test (don't merge anything, just return true if no conflicts) |
30
|
|
|
|
|
|
|
# members: |
31
|
|
|
|
|
|
|
# merge() (can accept tmp override optz) |
32
|
|
|
|
|
|
|
# unmerge() |
33
|
|
|
|
|
|
|
# |
34
|
|
|
|
|
|
|
# option to rename some XPath to something else so like simple example |
35
|
|
|
|
|
|
|
# is taking merge-file's root node element && pretending it is |
36
|
|
|
|
|
|
|
# named the same as the main-file's root node element so that the |
37
|
|
|
|
|
|
|
# two can merge in place even though their root node elements had |
38
|
|
|
|
|
|
|
# different names. This would clobber the name of the merge-file |
39
|
|
|
|
|
|
|
# element with the main-file one but it would be a useful option. |
40
|
|
|
|
|
|
|
# |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 NAME |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
XML::Merge - flexibly merge XML documents |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 VERSION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
This documentation refers to version 1.2.565EgGd of |
49
|
|
|
|
|
|
|
XML::Merge, which was released on Sun Jun 5 14:42:16:39 2005. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 SYNOPSIS |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
use XML::Merge; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# create new XML::Merge object from MainFile.xml |
56
|
|
|
|
|
|
|
my $merge_obj = XML::Merge->new('filename' => 'MainFile.xml'); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Merge File2Add.xml into MainFile.xml |
59
|
|
|
|
|
|
|
$merge_obj->merge( 'filename' => 'File2Add.xml'); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Tidy up the indenting that resulted from the merge |
62
|
|
|
|
|
|
|
$merge_obj->tidy(); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Write out changes back to MainFile.xml |
65
|
|
|
|
|
|
|
$merge_obj->write(); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 DESCRIPTION |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
This module inherits from L which in turn inherits from |
70
|
|
|
|
|
|
|
L. This ensures that Merge objects' indenting can be |
71
|
|
|
|
|
|
|
tidied up after any merge operation since such modification usually |
72
|
|
|
|
|
|
|
spells the ruination of indentation. Polymorphism allows Merge |
73
|
|
|
|
|
|
|
objects to be utilized as normal XML::XPath objects as well. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
The merging behavior is setup to combine separate XML documents |
76
|
|
|
|
|
|
|
according to certain rules && configurable options. If both |
77
|
|
|
|
|
|
|
documents have root nodes which are elements of the same name, the |
78
|
|
|
|
|
|
|
documents are merged directly. Otherwise, one is merged as a child |
79
|
|
|
|
|
|
|
of the other. An optional XPath location can be specified as the |
80
|
|
|
|
|
|
|
place to perform the merge. If no location is specified, the merge |
81
|
|
|
|
|
|
|
is attempted at the first matching element or is appended as the new |
82
|
|
|
|
|
|
|
last child of the other root if no match is found. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 2DO |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=over 2 |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=item - mk namespaces && attz stay in order after merge() |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=item - mk txt apnd merg optn |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item - handle comment joins && stamping && options |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item - support modification-time _cres |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=item - add _ignr ignore list of merg xplc's to not merge (pre-prune()) |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item - support _idea options where several attz together are single id |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=item - What else does Merge need? |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=back |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 USAGE |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head2 new() |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
This is the standard Merge object constructor. It can take the |
109
|
|
|
|
|
|
|
same parameters as an L object constructor to initialize |
110
|
|
|
|
|
|
|
the primary XML document object (the object which subsequent XML |
111
|
|
|
|
|
|
|
documents will be merged into). These parameters can be any one of: |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
'filename' => 'SomeFile.xml' |
114
|
|
|
|
|
|
|
'xml' => $variable_which_holds_a_bunch_of_XML_data |
115
|
|
|
|
|
|
|
'ioref' => $file_InputOutput_reference |
116
|
|
|
|
|
|
|
'context' => $existing_node_at_specified_context_to_become_new_obj |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Merge's new() can also accept merge-option parameters to |
119
|
|
|
|
|
|
|
override the default merge behavior. These include: |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
'conflict_resolution_method' => 'main', # main file wins |
122
|
|
|
|
|
|
|
'conflict_resolution_method' => 'merg', # merge file wins |
123
|
|
|
|
|
|
|
# 'last-in_wins' is an alias for 'merg' |
124
|
|
|
|
|
|
|
'conflict_resolution_method' => 'warn', # croak conflicts |
125
|
|
|
|
|
|
|
'conflict_resolution_method' => 'test', # just test, 0 if conflict |
126
|
|
|
|
|
|
|
# this option is not implemented yet, please say if you need it |
127
|
|
|
|
|
|
|
'comment_join_method' => 'none', |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head2 merge() |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
The merge() member function can accept the same L |
132
|
|
|
|
|
|
|
constructor options as new() but this time they are for the |
133
|
|
|
|
|
|
|
temporary file which will be merged into the main object. |
134
|
|
|
|
|
|
|
Merge-options from new() can also be specified && they will only |
135
|
|
|
|
|
|
|
impact one particular invokation of merge(). The specified document |
136
|
|
|
|
|
|
|
will be merged into the primary XML document object according to |
137
|
|
|
|
|
|
|
the following default merge rules: |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
0. If both documents share the same root element name, they are |
140
|
|
|
|
|
|
|
merged directly. |
141
|
|
|
|
|
|
|
1. If they don't share root elements but the temporary merge file's |
142
|
|
|
|
|
|
|
root element is found anywhere within the main file, the merge |
143
|
|
|
|
|
|
|
occurs at the match. |
144
|
|
|
|
|
|
|
2. If no root element match is found, the merge document becomes the |
145
|
|
|
|
|
|
|
new last child of the main file's root element. |
146
|
|
|
|
|
|
|
3. Whenever a deeper level is found with an element of the same name |
147
|
|
|
|
|
|
|
in both documents && either it does not contain any |
148
|
|
|
|
|
|
|
distinguishing attributes or it has attributes which are |
149
|
|
|
|
|
|
|
recognized as 'identifier' (id) attributes (by default, for any |
150
|
|
|
|
|
|
|
element, these are attributes named: 'id', 'name', && 'handle'), |
151
|
|
|
|
|
|
|
a corresponding element is searched for to match && merge with. |
152
|
|
|
|
|
|
|
4. Any remaining (non-id) nodes are merged in document order. |
153
|
|
|
|
|
|
|
5. When a conflict arises as non-id attributes or other nodes merge, |
154
|
|
|
|
|
|
|
the specified conflict_resolution_method merge-option is |
155
|
|
|
|
|
|
|
applied (which by default has the main file data persist at the |
156
|
|
|
|
|
|
|
expense of the merging file data). |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Some of the above rules can be overridden first by the object's |
159
|
|
|
|
|
|
|
merge-options && second by the particular method call's merge-options. |
160
|
|
|
|
|
|
|
Thus, if the default merge-option for conflict resolution is to |
161
|
|
|
|
|
|
|
have the main object win && you use the following constructor: |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
my $merge_obj = XML::Merge->new( |
164
|
|
|
|
|
|
|
'filename' => 'MainFile.xml', |
165
|
|
|
|
|
|
|
'conflict_resolution_method' => 'last-in_wins'); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
... then any $merge_obj->merge() call would override the |
168
|
|
|
|
|
|
|
default merge behavior by letting the document being merged have |
169
|
|
|
|
|
|
|
priority over the main object's document. However, you could |
170
|
|
|
|
|
|
|
supply additional merge-options in the parameter list of your |
171
|
|
|
|
|
|
|
specific merge() call like: |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
$merge_obj->merge( |
174
|
|
|
|
|
|
|
'filename' => 'File2Add.xml', |
175
|
|
|
|
|
|
|
'conflict_resolution_method' => 'warn'); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
... then the latest option would override the already overridden. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
The 'test' conflict_resolution_method merge-option does not modify the |
180
|
|
|
|
|
|
|
object at all. It solely returns true if no conflict is encountered. |
181
|
|
|
|
|
|
|
It should be used like: |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
foreach(@files) { |
184
|
|
|
|
|
|
|
if($merge_obj->merge('cres' => 'test', $_)) { |
185
|
|
|
|
|
|
|
$merge_obj->merge($_); # only do it if there are no conflicts |
186
|
|
|
|
|
|
|
} else { |
187
|
|
|
|
|
|
|
croak("Yipes! Conflict with file:$_!\n"); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
merge() can also accept another XML::Merge object as a parameter |
192
|
|
|
|
|
|
|
for what to be merged with the main object instead of a filename. |
193
|
|
|
|
|
|
|
An example of this is: |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
$merge_obj->merge($another_merge_obj); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Along with the merge options that can be specified in the object |
198
|
|
|
|
|
|
|
constructor, merge() also accepts the following options to specify |
199
|
|
|
|
|
|
|
where to perform the merge relative to: |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
'merge_destination_path' => $main_obj_xpath_location, |
202
|
|
|
|
|
|
|
'merge_source_path' => $merging_obj_xpath_location, |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head2 unmerge() |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
The unmerge() member function is a shorthand for calling both write() |
207
|
|
|
|
|
|
|
&& prune() on a certain XPath location which should be written out |
208
|
|
|
|
|
|
|
to a disk file before being removed from the Merge object. Please |
209
|
|
|
|
|
|
|
see L for documentation of the inherited write() && prune() |
210
|
|
|
|
|
|
|
member functions. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
This unmerge() process could be the opposite of merge() if no original |
213
|
|
|
|
|
|
|
elements or attributes overlapped && combined but if combining did |
214
|
|
|
|
|
|
|
happen, this would remove original sections of your primary XML |
215
|
|
|
|
|
|
|
document's data from your Merge object so please use this carefully. |
216
|
|
|
|
|
|
|
It is meant to help separate a giant object (probably the result of |
217
|
|
|
|
|
|
|
myriad merge() calls) back into separate useful well-formed XML |
218
|
|
|
|
|
|
|
documents on disk. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
unmerge() takes a filename && an xpath_location parameter. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head1 Accessors |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head2 get_object_to_merge() |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Returns the object which was last merged into the main object. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 set_object_to_merge() |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Assigns the object which was last merged into the main object. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head2 get_conflict_resolution_method() |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Returns the underlying merge-option conflict_resolution_method. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 set_conflict_resolution_method() |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
A new value can be provided as a parameter to be assigned |
239
|
|
|
|
|
|
|
as the XML::Merge object's merge-option. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head2 get_comment_join_method() |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Returns the underlying merge-option comment_join_method. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head2 set_comment_join_method() |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
A new value can be provided as a parameter to be assigned |
248
|
|
|
|
|
|
|
as the XML::Merge object's merge-option. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head2 get_id_xpath_list() |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Returns the underlying id_xpath_list. This is normally just a list |
253
|
|
|
|
|
|
|
of attributes (eg. '@id', '@name', '@handle') which are unique |
254
|
|
|
|
|
|
|
identifiers for any XML element. When these attribute names are |
255
|
|
|
|
|
|
|
encountered during a merge(), another element with the same name && |
256
|
|
|
|
|
|
|
attribute value are matched for further merging && conflict resolution. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head2 set_id_xpath_list() |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
A new list can assigned to the XML::Merge object's id_xpath_list. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Please note that this list normally contains XPath attributes so they |
263
|
|
|
|
|
|
|
must be preceded by an at-symbol (@) like: '@example_id_attribute'. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head1 CHANGES |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Revision history for Perl extension XML::Merge: |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=over 4 |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=item - 1.2.565EgGd Sun Jun 5 14:42:16:39 2005 |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
* added use XML::Tidy to make sure exports are available |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
* removed 02prune.t && moved 03keep.t to 02keep.t ... passing tests is good |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=item - 1.2.4CCJWiB Sun Dec 12 19:32:44:11 2004 |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
* guessing how to fix Darwin test failure @ t/02prune.t first prune() call |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=item - 1.0.4CAL5IS Fri Dec 10 21:05:18:28 2004 |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
* fixed buggy _recmerge |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=item - 1.0.4CAEU0I Fri Dec 10 14:30:00:18 2004 |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
* made accessors for _id_xpath_list |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
* made _id_xpath_list take XPath locations instead of elem names (old _idea) |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
* made test _cres (at Marc's request) |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
* made warn _cres croak |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
* made Merge inherit from Tidy (which inherits from XPath) |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
* separated reload(), strip(), tidy(), prune(), && write() into own |
298
|
|
|
|
|
|
|
XML::Tidy module |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=item - 1.0.4C2Nf0R Thu Dec 2 23:41:00:27 2004 |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
* updated license && prep'd for release |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=item - 1.0.4C2BcI2 Thu Dec 2 11:38:18:02 2004 |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
* updated reload(), strip(), && tidy() to verify _xpob exists |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=item - 1.0.4C1JHOl Wed Dec 1 19:17:24:47 2004 |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
* commented out override stuff since it's probably bad form && dumps crap |
311
|
|
|
|
|
|
|
warnings all over tests && causes them to fail... so I guess just |
312
|
|
|
|
|
|
|
uncomment that stuff if you care to preserve PI's && escapes |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=item - 1.0.4C1J7gt Wed Dec 1 19:07:42:55 2004 |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
* made merge() accept merge_source_xpath && merge_destination_xpath params |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
* made merge() accept other Merge objects |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
* made reload() not clobber basic escapes (by overriding Text toString()) |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
* made tidy() not kill processing-instructions (by overriding node_test()) |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
* made tidy() not kill comments |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=item - 1.0.4BOHGjm Wed Nov 24 17:16:45:48 2004 |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
* fixed merge() same elems with diff ids bug |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=item - 1.0.4BNBCZL Tue Nov 23 11:12:35:21 2004 |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
* rewrote both merge() && _recmerge() _cres stuff since it was |
333
|
|
|
|
|
|
|
buggy before... so hopefully consistently good now |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=item - 1.0.4BMJCPm Mon Nov 22 19:12:25:48 2004 |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
* fixed merge() for empty elem matching && _cres on text kids |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=item - 1.0.4BMGTLF Mon Nov 22 16:29:21:15 2004 |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
* separated reload() from strip() so that prune() can call it too |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=item - 1.0.4BM0B3x Mon Nov 22 00:11:03:59 2004 |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
* fixed tidy() empty elem bug && implemented prune() && unmerge() |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=item - 1.0.4BJAZpM Fri Nov 19 10:35:51:22 2004 |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
* fixing e() ABSTRACT gen bug |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=item - 1.0.4BJAMR6 Fri Nov 19 10:22:27:06 2004 |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
* fleshed out pod && members |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=item - 1.0.4AIDqmR Mon Oct 18 13:52:48:27 2004 |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
* original version |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=back |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=head1 INSTALL |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
From your command shell, please run: |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
`perl -MCPAN -e "install XML::Merge"` |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
or uncompress the package && run the standard: |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
`perl Makefile.PL; make; make test; make install` |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head1 FILES |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
XML::Merge requires: |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
L to allow errors to croak() from calling sub |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
L to use objects derived from XPath to update XML |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=head1 LICENSE |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
Most source code should be Free! |
382
|
|
|
|
|
|
|
Code I have lawful authority over is && shall be! |
383
|
|
|
|
|
|
|
Copyright: (c) 2004, Pip Stuart. |
384
|
|
|
|
|
|
|
Copyleft : This software is licensed under the GNU General Public |
385
|
|
|
|
|
|
|
License (version 2), && as such comes with NO WARRANTY. Please |
386
|
|
|
|
|
|
|
consult the Free Software Foundation (http://FSF.Org) for |
387
|
|
|
|
|
|
|
important information about your freedom. |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=head1 AUTHOR |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Pip Stuart |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=cut |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# Please see CHANGES section to know why the following is commented. |
396
|
|
|
|
|
|
|
## Need to fix node_test() test_nt_pi return in XML::XPath::Step.pm first... |
397
|
|
|
|
|
|
|
#package XML::XPath::Step; |
398
|
|
|
|
|
|
|
#use XML::XPath::Parser; |
399
|
|
|
|
|
|
|
#use XML::XPath::Node; |
400
|
|
|
|
|
|
|
# |
401
|
|
|
|
|
|
|
#sub node_test { |
402
|
|
|
|
|
|
|
# my $self = shift; my $node = shift; |
403
|
|
|
|
|
|
|
# my $test = $self->{test}; # if node passes test, return true |
404
|
|
|
|
|
|
|
# return 1 if $test == test_nt_node; |
405
|
|
|
|
|
|
|
# if($test == test_any) { |
406
|
|
|
|
|
|
|
# return 1 if $node->isElementNode && defined $node->getName; |
407
|
|
|
|
|
|
|
# } |
408
|
|
|
|
|
|
|
# local $^W; |
409
|
|
|
|
|
|
|
# if($test == test_ncwild) { |
410
|
|
|
|
|
|
|
# return unless $node->isElementNode; |
411
|
|
|
|
|
|
|
# my $match_ns = $self->{pp}->get_namespace($self->{literal}, $node); |
412
|
|
|
|
|
|
|
# if(my $node_nsnode = $node->getNamespace()) { |
413
|
|
|
|
|
|
|
# return 1 if $match_ns eq $node_nsnode->getValue; |
414
|
|
|
|
|
|
|
# } |
415
|
|
|
|
|
|
|
# } elsif($test == test_qname) { |
416
|
|
|
|
|
|
|
# return unless $node->isElementNode; |
417
|
|
|
|
|
|
|
# if($self->{literal} =~ /:/) { |
418
|
|
|
|
|
|
|
# my($prefix, $name) = split(':', $self->{literal}, 2); |
419
|
|
|
|
|
|
|
# my $match_ns = $self->{pp}->get_namespace($prefix, $node); |
420
|
|
|
|
|
|
|
# if(my $node_nsnode = $node->getNamespace()) { |
421
|
|
|
|
|
|
|
# return 1 if($match_ns eq $node_nsnode->getValue && $name eq $node->getLocalName); |
422
|
|
|
|
|
|
|
# } |
423
|
|
|
|
|
|
|
# } else { |
424
|
|
|
|
|
|
|
# return 1 if $node->getName eq $self->{literal}; |
425
|
|
|
|
|
|
|
# } |
426
|
|
|
|
|
|
|
# } elsif ($test == test_nt_text) { |
427
|
|
|
|
|
|
|
# return 1 if $node->isTextNode; |
428
|
|
|
|
|
|
|
# } elsif($test == test_nt_comment) { |
429
|
|
|
|
|
|
|
# return 1 if $node->isCommentNode; |
430
|
|
|
|
|
|
|
# } elsif($test == test_nt_pi) { |
431
|
|
|
|
|
|
|
# return unless $node->isPINode; |
432
|
|
|
|
|
|
|
# # EROR was here! $self->{literal} is undefined so can't ->value! |
433
|
|
|
|
|
|
|
# #if(my $val = $self->{literal}->value) { |
434
|
|
|
|
|
|
|
# # return 1 if $node->getTarget eq $val; |
435
|
|
|
|
|
|
|
# #} else { |
436
|
|
|
|
|
|
|
# return 1; |
437
|
|
|
|
|
|
|
# #} |
438
|
|
|
|
|
|
|
# } |
439
|
|
|
|
|
|
|
# return; # fallthrough returns false |
440
|
|
|
|
|
|
|
#} |
441
|
|
|
|
|
|
|
## ... also update Text nodes' toString() to escape both < && >! ... |
442
|
|
|
|
|
|
|
#package XML::XPath::Node::TextImpl; |
443
|
|
|
|
|
|
|
#sub toString { |
444
|
|
|
|
|
|
|
# my $self = shift; XML::XPath::Node::XMLescape($self->[node_text], '<&>'); |
445
|
|
|
|
|
|
|
#} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# Now ready to handle XML::Merge package... |
448
|
|
|
|
|
|
|
package XML::Merge; |
449
|
2
|
|
|
2
|
|
14477
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
73
|
|
450
|
2
|
|
|
2
|
|
20
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
91
|
|
451
|
|
|
|
|
|
|
require XML::Tidy; |
452
|
2
|
|
|
2
|
|
14
|
use base qw( XML::Tidy ); |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
3485
|
|
453
|
|
|
|
|
|
|
use XML::Tidy; |
454
|
|
|
|
|
|
|
use Carp; |
455
|
|
|
|
|
|
|
our $VERSION = '1.2.565EgGd'; # major . minor . PipTimeStamp |
456
|
|
|
|
|
|
|
our $PTVR = $VERSION; $PTVR =~ s/^\d+\.\d+\.//; # strip major and minor |
457
|
|
|
|
|
|
|
# Please see `perldoc Time::PT` for an explanation of $PTVR. |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
my $DBUG = 0; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
sub new { |
462
|
|
|
|
|
|
|
my $clas = shift(); my @parm; my $cres = 'main'; |
463
|
|
|
|
|
|
|
for(my $indx = 0; $indx < @_; $indx++) { |
464
|
|
|
|
|
|
|
if($_[$indx] =~ /^[-_]?(cres$|conflict_resolution)/ && ($indx + 1) < @_) { |
465
|
|
|
|
|
|
|
$cres = $_[++$indx]; |
466
|
|
|
|
|
|
|
} else { |
467
|
|
|
|
|
|
|
push(@parm, $_[$indx]); |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
my $tdob = XML::Tidy->new(@parm); |
471
|
|
|
|
|
|
|
my $self = bless($tdob, $clas); |
472
|
|
|
|
|
|
|
# self just a new Tidy (XPath) obj blessed into Merge class... |
473
|
|
|
|
|
|
|
# ... with a few new options |
474
|
|
|
|
|
|
|
$self->{'_object_to_merge'} = undef; |
475
|
|
|
|
|
|
|
$self->{'_conflict_resolution_method'} = $cres; |
476
|
|
|
|
|
|
|
# Conflict RESolution method valid values: |
477
|
|
|
|
|
|
|
# 'main' = Main (primary) file wins |
478
|
|
|
|
|
|
|
# 'merg' = Merge file resolves (Last-In wins) |
479
|
|
|
|
|
|
|
# 'warn' = Croak warning about conflict && halt merge |
480
|
|
|
|
|
|
|
# 'test' = Test whether any conflict would occur if merge were performed |
481
|
|
|
|
|
|
|
$self->{'_comment_join_method'} = 'none'; |
482
|
|
|
|
|
|
|
# CoMmenT Join method valid values: |
483
|
|
|
|
|
|
|
# 'none', 'separate' |
484
|
|
|
|
|
|
|
# 'join', 'combine' |
485
|
|
|
|
|
|
|
# 'jpts', 'join_with_piptime_stamp' |
486
|
|
|
|
|
|
|
# 'jlts', 'join_with_localtime_stamp' |
487
|
|
|
|
|
|
|
$self->{'_id_xpath_list'} = [ # unique ID elements or attributes |
488
|
|
|
|
|
|
|
'@id', |
489
|
|
|
|
|
|
|
'@name', |
490
|
|
|
|
|
|
|
'@handle', |
491
|
|
|
|
|
|
|
]; |
492
|
|
|
|
|
|
|
return($self); |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
sub merge { # under water |
496
|
|
|
|
|
|
|
my $self = shift(); my @parm; |
497
|
|
|
|
|
|
|
my $cres = $self->get_conflict_resolution_method(); |
498
|
|
|
|
|
|
|
my $cmtj = $self->get_comment_join_method(); |
499
|
|
|
|
|
|
|
my $mdxp = undef; |
500
|
|
|
|
|
|
|
my $msxp = undef; |
501
|
|
|
|
|
|
|
my $mgob = undef; |
502
|
|
|
|
|
|
|
# setup local options |
503
|
|
|
|
|
|
|
for(my $indx = 0; $indx < @_; $indx++) { |
504
|
|
|
|
|
|
|
if ($_[$indx] =~ /^[-_]?(cres$|conflict_resolution)/ && ($indx + 1) < @_) { |
505
|
|
|
|
|
|
|
$cres = $_[++$indx]; |
506
|
|
|
|
|
|
|
} elsif($_[$indx] =~ /^[-_]?(cmtj$|comment_join)/ && ($indx + 1) < @_) { |
507
|
|
|
|
|
|
|
$cmtj = $_[++$indx]; |
508
|
|
|
|
|
|
|
} elsif($_[$indx] =~ /^[-_]?(mdxp$|merge_destination)/ && ($indx + 1) < @_) { |
509
|
|
|
|
|
|
|
$mdxp = $_[++$indx]; |
510
|
|
|
|
|
|
|
} elsif($_[$indx] =~ /^[-_]?(msxp$|merge_source)/ && ($indx + 1) < @_) { |
511
|
|
|
|
|
|
|
$msxp = $_[++$indx]; |
512
|
|
|
|
|
|
|
} elsif(ref($_[$indx]) =~ /XML::(XPath|Tidy|Merge)/) { |
513
|
|
|
|
|
|
|
$self->set_object_to_merge($_[$indx]); |
514
|
|
|
|
|
|
|
} else { |
515
|
|
|
|
|
|
|
push(@parm, $_[$indx]); |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
$self->set_object_to_merge( XML::Merge->new(@parm) ) if(@parm); |
519
|
|
|
|
|
|
|
$cres = 'merg' if($cres =~ /last/i); |
520
|
|
|
|
|
|
|
$mgob = $self->get_object_to_merge(); |
521
|
|
|
|
|
|
|
if($mgob) { |
522
|
|
|
|
|
|
|
my $mnrn; my $mgrn; |
523
|
|
|
|
|
|
|
# traverse main Merge obj && merge w/ object_to_merge according to options |
524
|
|
|
|
|
|
|
# 0a. ck if root node elems have same LocalName |
525
|
|
|
|
|
|
|
# but short-circuit root element loading if merge_source or merge_dest |
526
|
|
|
|
|
|
|
if(defined($mdxp) && length($mdxp)) { |
527
|
|
|
|
|
|
|
($mnrn)= $self->findnodes($mdxp); |
528
|
|
|
|
|
|
|
} else { |
529
|
|
|
|
|
|
|
($mnrn)= $self->findnodes('/*'); |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
if(defined($msxp) && length($msxp)) { |
532
|
|
|
|
|
|
|
($mgrn)= $mgob->findnodes($msxp); |
533
|
|
|
|
|
|
|
} else { |
534
|
|
|
|
|
|
|
($mgrn)= $mgob->findnodes('/*'); |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
if($mnrn->getLocalName() eq $mgrn->getLocalName()) { |
537
|
|
|
|
|
|
|
print "Root Node Element names match so merging in place!\n" if($DBUG); |
538
|
|
|
|
|
|
|
# 1a. ck if each merge root elem has attributes which main doesn't |
539
|
|
|
|
|
|
|
foreach($mgrn->findnodes('@*')) { |
540
|
|
|
|
|
|
|
print " Found attr:" . $_->getLocalName() . "\n" if($DBUG); |
541
|
|
|
|
|
|
|
my($mnat)= $mnrn->findnodes('@' . $_->getLocalName()); |
542
|
|
|
|
|
|
|
# if both root elems have same attribute name with different values... |
543
|
|
|
|
|
|
|
if(defined($mnat)) { |
544
|
|
|
|
|
|
|
print " Found matching attr:" . $_->getLocalName() . "\n" if($DBUG); |
545
|
|
|
|
|
|
|
# must use Conflict RESolution method to know who's value wins |
546
|
|
|
|
|
|
|
if($mnat->getNodeValue() ne $_->getNodeValue()) { |
547
|
|
|
|
|
|
|
if ($cres eq 'merg') { |
548
|
|
|
|
|
|
|
print " CRES:merg so setting main attr:" . $_->getLocalName() . " to merg valu:" . $_->getNodeValue() . "\n" if($DBUG); |
549
|
|
|
|
|
|
|
$mnat->setNodeValue($_->getNodeValue()); |
550
|
|
|
|
|
|
|
} elsif($cres eq 'warn') { |
551
|
|
|
|
|
|
|
croak("!*WARN*! Found conflicting attribute:" . |
552
|
|
|
|
|
|
|
$_ ->getLocalName() . |
553
|
|
|
|
|
|
|
"\n main value:" . $mnat->getNodeValue() . |
554
|
|
|
|
|
|
|
"\n merg value:" . $_ ->getNodeValue() . |
555
|
|
|
|
|
|
|
"\n Croaking... please resolve manually.\n"); |
556
|
|
|
|
|
|
|
} elsif($cres eq 'test') { |
557
|
|
|
|
|
|
|
return(0); |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} else { |
561
|
|
|
|
|
|
|
print " Found new attr:" . $_->getLocalName() . "\n" if($DBUG); |
562
|
|
|
|
|
|
|
$mnrn->appendAttribute($_) unless($cres eq 'test'); |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
# 1b. loop through all merge child elems |
566
|
|
|
|
|
|
|
if($mgrn->findnodes('*')) { |
567
|
|
|
|
|
|
|
foreach($mgrn->findnodes('*')) { |
568
|
|
|
|
|
|
|
print " Found elem:" . $_->getLocalName() . "\n" if($DBUG); |
569
|
|
|
|
|
|
|
my $mtch = 0; # flag to know if already matched |
570
|
|
|
|
|
|
|
# test ID paths |
571
|
|
|
|
|
|
|
foreach my $idat (@{$self->get_id_xpath_list()}) { |
572
|
|
|
|
|
|
|
print " idat matching against:$idat\n" if($DBUG); |
573
|
|
|
|
|
|
|
# if a child merge elem has a matching id, search main for same |
574
|
|
|
|
|
|
|
my($mgmt)= $_->findnodes($idat); # MerG MaTch |
575
|
|
|
|
|
|
|
if(defined($mgmt)) { |
576
|
|
|
|
|
|
|
print " Matched idat:$idat\n" if($DBUG); |
577
|
|
|
|
|
|
|
my $mnmt; |
578
|
|
|
|
|
|
|
if ($idat =~ /^\@/) { |
579
|
|
|
|
|
|
|
($mnmt)= $mnrn->findnodes($_->getLocalName() . '[' . $idat . '="' . $mgmt->getNodeValue() . '"]'); |
580
|
|
|
|
|
|
|
} elsif($idat =~ /\[\@\w+\]/) { |
581
|
|
|
|
|
|
|
my $itmp = $idat; my $nval = $mgmt->getNodeValue(); |
582
|
|
|
|
|
|
|
$itmp =~ s/(\[\@\w+)\]/$1="$nval"\]/; |
583
|
|
|
|
|
|
|
($mnmt)= $mnrn->findnodes($itmp); |
584
|
|
|
|
|
|
|
} else { |
585
|
|
|
|
|
|
|
($mnmt)= $mnrn->findnodes($idat); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
if(defined($mnmt)) { # id matched both main && merg... |
588
|
|
|
|
|
|
|
print " Matched elem:" . $_->getLocalName() . '[' . $idat . '="' . $mgmt->getNodeValue() . '"] with elem:' . $mnmt->getLocalName() . "\n" if($DBUG); |
589
|
|
|
|
|
|
|
$mtch = 1; # so recursively merge deeper... |
590
|
|
|
|
|
|
|
my $test = $self->_recmerge($mnmt, $_, $cres, $cmtj); |
591
|
|
|
|
|
|
|
return(0) if($cres eq 'test' && !$test); |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
if(!$mtch && $mnrn->findnodes($_->getLocalName())) { |
596
|
|
|
|
|
|
|
my($mnmt)= $mnrn->findnodes($_->getLocalName()); |
597
|
|
|
|
|
|
|
if(defined($mnmt)) { # plain elem matched both main && merg... |
598
|
|
|
|
|
|
|
my $fail = 0; |
599
|
|
|
|
|
|
|
foreach my $idat (@{$self->get_id_xpath_list()}) { |
600
|
|
|
|
|
|
|
my($mnat)= $mnmt->findnodes($idat); # MaiN ATtribute |
601
|
|
|
|
|
|
|
my($mgat)= $_ ->findnodes($idat); # MerG ATtribute |
602
|
|
|
|
|
|
|
$fail = 1 if(defined($mnat) || defined($mgat)); |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
unless($fail) { # fail tests if any unique id paths were found |
605
|
|
|
|
|
|
|
$mtch = 1; # so recursively merge deeper... |
606
|
|
|
|
|
|
|
my $test = $self->_recmerge($mnmt, $_, $cres, $cmtj); |
607
|
|
|
|
|
|
|
return(0) if($cres eq 'test' && !$test); |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
# if none above matched, append diff child to main root node |
612
|
|
|
|
|
|
|
$mnrn->appendChild($_) unless($mtch || $cres eq 'test'); |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
} elsif($mgrn->getChildNodes()) { # no kid elems but kid text data node |
615
|
|
|
|
|
|
|
my($mntx)= $mnrn->getChildNodes(); |
616
|
|
|
|
|
|
|
my($mgtx)= $mgrn->getChildNodes(); |
617
|
|
|
|
|
|
|
if(defined($mgtx) && $mgtx->getNodeType() == TEXT_NODE) { |
618
|
|
|
|
|
|
|
print " Found text:" . $mgrn->getLocalName() . " valu:" . $mgtx->getNodeValue() . "\n" if($DBUG); |
619
|
|
|
|
|
|
|
if (!defined($mntx)) { |
620
|
|
|
|
|
|
|
$mnrn->appendChild($mgtx) unless($cres eq 'test'); |
621
|
|
|
|
|
|
|
} elsif($cres eq 'merg') { |
622
|
|
|
|
|
|
|
$mntx->setNodeValue($mgtx->getNodeValue()); |
623
|
|
|
|
|
|
|
} elsif($cres eq 'warn') { |
624
|
|
|
|
|
|
|
croak("!*WARN*! Found conflicting Root text node:" . |
625
|
|
|
|
|
|
|
$mnrn->getLocalName() . |
626
|
|
|
|
|
|
|
"\n main value:" . $mntx->getNodeValue() . |
627
|
|
|
|
|
|
|
"\n merg value:" . $mgtx->getNodeValue() . |
628
|
|
|
|
|
|
|
"\n Croaking... please resolve manually.\n"); |
629
|
|
|
|
|
|
|
} elsif($cres eq 'test') { |
630
|
|
|
|
|
|
|
#return(0); # new text node value is not a merge prob? |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
# 0b. ck if merge root node elem exists somewhere in main |
635
|
|
|
|
|
|
|
} elsif($self->findnodes('//' . $mgrn->getLocalName())) { |
636
|
|
|
|
|
|
|
print "Root Node Element names differ && mgrn is in mnrn so merging at match!\n" if($DBUG); |
637
|
|
|
|
|
|
|
my($mnmt)= $self->findnodes('//' . $mgrn->getLocalName()); |
638
|
|
|
|
|
|
|
# recursively merge main child with merg root |
639
|
|
|
|
|
|
|
my $test = $self->_recmerge($mnmt, $mgrn, $cres, $cmtj); |
640
|
|
|
|
|
|
|
return(0) if($cres eq 'test' && !$test); |
641
|
|
|
|
|
|
|
# 0c. just append whole merge doc as last child of main root |
642
|
|
|
|
|
|
|
} elsif($cres ne 'test') { |
643
|
|
|
|
|
|
|
print "Root Node Element names differ so appending mgrn as last child of mnrn!\n" if($DBUG); |
644
|
|
|
|
|
|
|
$mnrn->appendChild($mgrn); |
645
|
|
|
|
|
|
|
$mnrn->appendChild($self->Text("\n")); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
print " mnrn:" . $mnrn->getLocalName() . "\n" if($DBUG); |
648
|
|
|
|
|
|
|
print " mgrn:" . $mgrn->getLocalName() . "\n" if($DBUG); |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
return(1); # true test _cres == no conflict, 0 == conflict |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub _recmerge { # recursively merge XML elements |
654
|
|
|
|
|
|
|
my $self = shift(); # merge() already setup all needed _optn values |
655
|
|
|
|
|
|
|
my $mnnd = shift(); # MaiN NoDe |
656
|
|
|
|
|
|
|
my $mgnd = shift(); # MerG NoDe |
657
|
|
|
|
|
|
|
my $cres = shift() || $self->get_conflict_resolution_method(); |
658
|
|
|
|
|
|
|
my $cmtj = shift() || $self->get_comment_join_method(); |
659
|
|
|
|
|
|
|
if($mnnd->getLocalName() eq $mgnd->getLocalName()) { |
660
|
|
|
|
|
|
|
print "Non-Root Node Element names match so merging in place!\n" if($DBUG); |
661
|
|
|
|
|
|
|
foreach($mgnd->findnodes('@*')) { |
662
|
|
|
|
|
|
|
print "NR Found attr:" . $_->getLocalName() . "\n" if($DBUG); |
663
|
|
|
|
|
|
|
my($mnat)= $mnnd->findnodes('@' . $_->getLocalName()); |
664
|
|
|
|
|
|
|
if(defined($mnat)) { |
665
|
|
|
|
|
|
|
print "NR Found matching attr:" . $_->getLocalName() . "\n" if($DBUG); |
666
|
|
|
|
|
|
|
if($mnat->getNodeValue() ne $_->getNodeValue()) { |
667
|
|
|
|
|
|
|
if ($cres eq 'merg') { |
668
|
|
|
|
|
|
|
print "NR CRES:merg so setting main attr:" . $_->getLocalName() . " to merg valu:" . $_->getNodeValue() . "\n" if($DBUG); |
669
|
|
|
|
|
|
|
$mnat->setNodeValue($_->getNodeValue()); |
670
|
|
|
|
|
|
|
} elsif($cres eq 'warn') { |
671
|
|
|
|
|
|
|
croak("!*WARN*! Found conflicting Non-Root attribute:" . |
672
|
|
|
|
|
|
|
$_ ->getLocalName() . |
673
|
|
|
|
|
|
|
"\n main value:" . $mnat->getNodeValue() . |
674
|
|
|
|
|
|
|
"\n merg value:" . $_ ->getNodeValue() . |
675
|
|
|
|
|
|
|
"\n Croaking... please resolve manually.\n"); |
676
|
|
|
|
|
|
|
} elsif($cres eq 'test') { |
677
|
|
|
|
|
|
|
return(0); |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} else { |
681
|
|
|
|
|
|
|
print "NR Found new attr:" . $_->getLocalName() . "\n" if($DBUG); |
682
|
|
|
|
|
|
|
$mnnd->appendAttribute($_) unless($cres eq 'test'); |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
if($mgnd->findnodes('*')) { |
686
|
|
|
|
|
|
|
foreach($mgnd->findnodes('*')) { |
687
|
|
|
|
|
|
|
print "NR Found elem:" . $_->getLocalName() . "\n" if($DBUG); |
688
|
|
|
|
|
|
|
my $mtch = 0; # flag to know if already matched |
689
|
|
|
|
|
|
|
foreach my $idat (@{$self->get_id_xpath_list()}) { # test ID XPaths |
690
|
|
|
|
|
|
|
# if a child merge elem has a matching id, search main for same |
691
|
|
|
|
|
|
|
my($mgmt)= $_->findnodes($idat); # MerG MaTch |
692
|
|
|
|
|
|
|
if(defined($mgmt)) { |
693
|
|
|
|
|
|
|
my $mnmt; |
694
|
|
|
|
|
|
|
if ($idat =~ /^\@/) { |
695
|
|
|
|
|
|
|
($mnmt)= $mnnd->findnodes($_->getLocalName() . '[' . $idat . '="' . $mgmt->getNodeValue() . '"]'); |
696
|
|
|
|
|
|
|
} elsif($idat =~ /\[\@\w+\]/) { |
697
|
|
|
|
|
|
|
my $itmp = $idat; my $nval = $mgmt->getNodeValue(); |
698
|
|
|
|
|
|
|
$itmp =~ s/(\[\@\w+)\]/$1="$nval"\]/; |
699
|
|
|
|
|
|
|
($mnmt)= $mnnd->findnodes($itmp); |
700
|
|
|
|
|
|
|
} else { |
701
|
|
|
|
|
|
|
($mnmt)= $mnnd->findnodes($idat); |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
if(defined($mnmt)) { # id matched both main && merg... |
704
|
|
|
|
|
|
|
print " Matched elem:" . $_->getLocalName() . '[' . $idat . '="' . $mgmt->getNodeValue() . '"] with elem:' . $mnmt->getLocalName() . "\n" if($DBUG); |
705
|
|
|
|
|
|
|
$mtch = 1; # so recursively merge deeper... |
706
|
|
|
|
|
|
|
my $test = $self->_recmerge($mnmt, $_, $cres, $cmtj); |
707
|
|
|
|
|
|
|
return(0) if($cres eq 'test' && !$test); |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
if(!$mtch && $mnnd->findnodes($_->getLocalName())) { |
712
|
|
|
|
|
|
|
my($mnmt)= $mnnd->findnodes($_->getLocalName()); |
713
|
|
|
|
|
|
|
if(defined($mnmt)) { # plain elem matched both main && merg... |
714
|
|
|
|
|
|
|
my $fail = 0; |
715
|
|
|
|
|
|
|
foreach my $idat (@{$self->get_id_xpath_list()}) { |
716
|
|
|
|
|
|
|
my($mnat)= $mnmt->findnodes($idat); # MaiN ATtribute |
717
|
|
|
|
|
|
|
my($mgat)= $_ ->findnodes($idat); # MerG ATtribute |
718
|
|
|
|
|
|
|
$fail = 1 if(defined($mnat) || defined($mgat)); |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
unless($fail) { # fail tests if any unique id paths were found |
721
|
|
|
|
|
|
|
$mtch = 1; # so recursively merge deeper... |
722
|
|
|
|
|
|
|
my $test = $self->_recmerge($mnmt, $_, $cres, $cmtj); |
723
|
|
|
|
|
|
|
return(0) if($cres eq 'test' && !$test); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
# if none above matched, append diff child to main root node |
728
|
|
|
|
|
|
|
$mnnd->appendChild($_) unless($mtch || $cres eq 'test'); |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
} elsif($mgnd->getChildNodes()) { # no child elems but child text data node |
731
|
|
|
|
|
|
|
my($mntx)= $mnnd->getChildNodes(); |
732
|
|
|
|
|
|
|
my($mgtx)= $mgnd->getChildNodes(); |
733
|
|
|
|
|
|
|
if(defined($mgtx) && $mgtx->getNodeType() == TEXT_NODE) { |
734
|
|
|
|
|
|
|
print "NR Found text:" . $mgnd->getLocalName() . " valu:" . $mgtx->getNodeValue() . "\n" if($DBUG); |
735
|
|
|
|
|
|
|
if (!defined($mntx) && $cres ne 'test') { |
736
|
|
|
|
|
|
|
$mnnd->appendChild($mgtx); |
737
|
|
|
|
|
|
|
} elsif($cres eq 'merg') { |
738
|
|
|
|
|
|
|
$mntx->setNodeValue($mgtx->getNodeValue()); |
739
|
|
|
|
|
|
|
} elsif($cres eq 'warn') { |
740
|
|
|
|
|
|
|
croak("!*WARN*! Found conflicting Non-Root text node:" . |
741
|
|
|
|
|
|
|
$mnnd->getLocalName() . |
742
|
|
|
|
|
|
|
"\n main value:" . $mntx->getNodeValue() . |
743
|
|
|
|
|
|
|
"\n merg value:" . $mgtx->getNodeValue() . |
744
|
|
|
|
|
|
|
"\n Croaking... please resolve manually.\n"); |
745
|
|
|
|
|
|
|
} elsif($cres eq 'test') { |
746
|
|
|
|
|
|
|
#return(0); # new text node value is not a merge prob? |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
} elsif($cres ne 'test') { # append whole merge elem as last kid of main elem |
751
|
|
|
|
|
|
|
print "Non-Root Node Element names differ so appending mgrn as last child of mnrn!\n" if($DBUG); |
752
|
|
|
|
|
|
|
$mnnd->appendChild($mgnd); |
753
|
|
|
|
|
|
|
$mnnd->appendChild($self->Text("\n")); |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
print "NR mnnd:" . $mnnd->getLocalName() . "\n" if($DBUG); |
756
|
|
|
|
|
|
|
print "NR mgnd:" . $mgnd->getLocalName() . "\n" if($DBUG); |
757
|
|
|
|
|
|
|
return(1); |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
sub unmerge { # short-hand for writing a certain xpath_loc out then pruning it |
761
|
|
|
|
|
|
|
my $self = shift(); my @parm; my $xplc = undef; my $flnm = undef; |
762
|
|
|
|
|
|
|
# setup local options |
763
|
|
|
|
|
|
|
for(my $indx = 0; $indx < @_; $indx++) { |
764
|
|
|
|
|
|
|
if ($_[$indx] =~ /^[-_]?(flnm$|filename)/ && ($indx + 1) < @_) { |
765
|
|
|
|
|
|
|
$flnm = $_[++$indx]; |
766
|
|
|
|
|
|
|
} elsif($_[$indx] =~ /^[-_]?(xplc$|xpath_location)/ && ($indx + 1) < @_) { |
767
|
|
|
|
|
|
|
$xplc = $_[++$indx]; |
768
|
|
|
|
|
|
|
} else { |
769
|
|
|
|
|
|
|
push(@parm, $_[$indx]); |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
if(@parm) { |
773
|
|
|
|
|
|
|
$flnm = shift(@parm) unless(defined($flnm)); |
774
|
|
|
|
|
|
|
$xplc = shift(@parm) unless(defined($xplc)); |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
if(defined($flnm) && defined($xplc) && |
777
|
|
|
|
|
|
|
length ($flnm) && length ($xplc)) { |
778
|
|
|
|
|
|
|
$self->write($flnm, |
779
|
|
|
|
|
|
|
$xplc); |
780
|
|
|
|
|
|
|
$self->prune($xplc); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
# Accessors |
785
|
|
|
|
|
|
|
sub get_object_to_merge { |
786
|
|
|
|
|
|
|
my $self = shift(); |
787
|
|
|
|
|
|
|
return($self->{'_object_to_merge'}); |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
sub set_object_to_merge { |
791
|
|
|
|
|
|
|
my $self = shift(); |
792
|
|
|
|
|
|
|
$self->{'_object_to_merge'} = shift() if(@_); |
793
|
|
|
|
|
|
|
return($self->{'_object_to_merge'}); |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
sub get_conflict_resolution_method { |
797
|
|
|
|
|
|
|
my $self = shift(); |
798
|
|
|
|
|
|
|
return($self->{'_conflict_resolution_method'}); |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
sub set_conflict_resolution_method { |
802
|
|
|
|
|
|
|
my $self = shift(); |
803
|
|
|
|
|
|
|
$self->{'_conflict_resolution_method'} = shift() if(@_); |
804
|
|
|
|
|
|
|
return($self->{'_conflict_resolution_method'}); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub get_comment_join_method { |
808
|
|
|
|
|
|
|
my $self = shift(); |
809
|
|
|
|
|
|
|
return($self->{'_comment_join_method'}); |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
sub set_comment_join_method { |
813
|
|
|
|
|
|
|
my $self = shift(); |
814
|
|
|
|
|
|
|
$self->{'_comment_join_method'} = shift() if(@_); |
815
|
|
|
|
|
|
|
return($self->{'_comment_join_method'}); |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub get_id_xpath_list { |
819
|
|
|
|
|
|
|
my $self = shift(); |
820
|
|
|
|
|
|
|
return($self->{'_id_xpath_list'}); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
sub set_id_xpath_list { |
824
|
|
|
|
|
|
|
my $self = shift(); |
825
|
|
|
|
|
|
|
if(@_) { |
826
|
|
|
|
|
|
|
if(@_ == 1 && ref($_[0]) eq 'ARRAY') { |
827
|
|
|
|
|
|
|
$self->{'_id_xpath_list'} = shift(); |
828
|
|
|
|
|
|
|
} else { |
829
|
|
|
|
|
|
|
$self->{'_id_xpath_list'} = [ @_ ]; |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
return($self->{'_id_xpath_list'}); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub DESTROY { } # do nothing but define in case && to calm test warnings |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
127; |