| 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; |