line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Struct::Diff; |
2
|
|
|
|
|
|
|
|
3
|
14
|
|
|
14
|
|
624878
|
use 5.006; |
|
14
|
|
|
|
|
113
|
|
4
|
14
|
|
|
14
|
|
59
|
use strict; |
|
14
|
|
|
|
|
22
|
|
|
14
|
|
|
|
|
261
|
|
5
|
14
|
|
|
14
|
|
53
|
use warnings FATAL => 'all'; |
|
14
|
|
|
|
|
25
|
|
|
14
|
|
|
|
|
418
|
|
6
|
14
|
|
|
14
|
|
1804
|
use parent qw(Exporter); |
|
14
|
|
|
|
|
1134
|
|
|
14
|
|
|
|
|
57
|
|
7
|
|
|
|
|
|
|
|
8
|
14
|
|
|
14
|
|
7254
|
use Algorithm::Diff qw(LCSidx); |
|
14
|
|
|
|
|
57553
|
|
|
14
|
|
|
|
|
712
|
|
9
|
14
|
|
|
14
|
|
93
|
use Scalar::Util qw(looks_like_number); |
|
14
|
|
|
|
|
49
|
|
|
14
|
|
|
|
|
1037
|
|
10
|
14
|
|
|
14
|
|
6746
|
use Storable 2.05 qw(freeze); |
|
14
|
|
|
|
|
33607
|
|
|
14
|
|
|
|
|
27411
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
13
|
|
|
|
|
|
|
diff |
14
|
|
|
|
|
|
|
list_diff |
15
|
|
|
|
|
|
|
patch |
16
|
|
|
|
|
|
|
split_diff |
17
|
|
|
|
|
|
|
valid_diff |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 NAME |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Struct::Diff - Recursive diff for nested perl structures |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=begin html |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=end html |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 VERSION |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Version 0.96 |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=cut |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
our $VERSION = '0.96'; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 SYNOPSIS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use Struct::Diff qw(diff list_diff split_diff patch valid_diff); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
$x = {one => [1,{two => 2}]}; |
45
|
|
|
|
|
|
|
$y = {one => [1,{two => 9}],three => 3}; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
$diff = diff($x, $y, noO => 1, noU => 1); # omit unchanged items and old values |
48
|
|
|
|
|
|
|
# $diff == {D => {one => {D => [{D => {two => {N => 9}},I => 1}]},three => {A => 3}}} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
@list_diff = list_diff($diff); # list (path and ref pairs) all diff entries |
51
|
|
|
|
|
|
|
# @list_diff == ({K => ['one']},[1],{K => ['two']}],\{N => 9},[{K => ['three']}],\{A => 3}) |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
$splitted = split_diff($diff); |
54
|
|
|
|
|
|
|
# $splitted->{a} # does not exist |
55
|
|
|
|
|
|
|
# $splitted->{b} == {one => [{two => 9}],three => 3} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
patch($x, $diff); # $x now equal to $y by structure and data |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
@errors = valid_diff($diff); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 EXPORT |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Nothing is exported by default. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 DIFF FORMAT |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Diff is simply a HASH whose keys shows status for each item in passed |
68
|
|
|
|
|
|
|
structures. Every status type (except C) may be omitted during the diff |
69
|
|
|
|
|
|
|
calculation. Disabling some or other types produce different diffs: diff with |
70
|
|
|
|
|
|
|
only unchanged items is also possible (when all other types disabled). |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=over 4 |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item A |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Stands for 'added' (exists only in second structure), it's value - added item. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item D |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Means 'different' and contains subdiff. The only status type which can't be |
81
|
|
|
|
|
|
|
disabled. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item I |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Index for array item, used only when prior item was omitted. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=item N |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Is a new value for changed item. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item O |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Alike C, C is a changed item's old value. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item R |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Similar for C, but for removed items. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item U |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Represent unchanged items. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=back |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Diff format: metadata alternates with data and, as a result, diff may represent |
106
|
|
|
|
|
|
|
any structure of any data types. Simple types specified as is, arrays and hashes |
107
|
|
|
|
|
|
|
contain subdiffs for their items with native for such types addressing: indexes |
108
|
|
|
|
|
|
|
for arrays and keys for hashes. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Sample: |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
old: {one => [5,7]} |
113
|
|
|
|
|
|
|
new: {one => [5],two => 2} |
114
|
|
|
|
|
|
|
opts: {noU => 1} # omit unchanged items |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
diff: |
117
|
|
|
|
|
|
|
{D => {one => {D => [{I => 1,R => 7}]},two => {A => 2}}} |
118
|
|
|
|
|
|
|
|| | | || ||| | | | | || | |
119
|
|
|
|
|
|
|
|| | | || ||| | | | | || +- with value 2 |
120
|
|
|
|
|
|
|
|| | | || ||| | | | | |+- it says key was added |
121
|
|
|
|
|
|
|
|| | | || ||| | | | | +- subdiff for it |
122
|
|
|
|
|
|
|
|| | | || ||| | | | +- another key from top-level hash |
123
|
|
|
|
|
|
|
|| | | || ||| | | +- what it was (item's value: 7) |
124
|
|
|
|
|
|
|
|| | | || ||| | +- shows what happened to item (removed) |
125
|
|
|
|
|
|
|
|| | | || ||| +- array item's actual index |
126
|
|
|
|
|
|
|
|| | | || ||+- prior item was omitted |
127
|
|
|
|
|
|
|
|| | | || |+- subdiff for array item |
128
|
|
|
|
|
|
|
|| | | || +- it's value - ARRAY |
129
|
|
|
|
|
|
|
|| | | |+- it is deeply changed |
130
|
|
|
|
|
|
|
|| | | +- subdiff for key 'one' |
131
|
|
|
|
|
|
|
|| | +- it has key 'one' |
132
|
|
|
|
|
|
|
|| +- top-level thing is a HASH |
133
|
|
|
|
|
|
|
|+- changes somewhere deeply inside |
134
|
|
|
|
|
|
|
+- diff is always a HASH |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 SUBROUTINES |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head2 diff |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Returns hashref to recursive diff between two passed things. Beware when |
141
|
|
|
|
|
|
|
changing diff: it's parts are links to original structures. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
$diff = diff($x, $y, %opts); |
144
|
|
|
|
|
|
|
$patch = diff($x, $y, noU => 1, noO => 1, trimR => 1); # smallest possible diff |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head3 Options |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=over 4 |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item freezer C<< >> |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Serializer callback (redefines default serializer). L is used |
153
|
|
|
|
|
|
|
by default, see L for details. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item noX C<< >> |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Where X is a status (C, C, C, C, C); such status will be omitted. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=item trimR C<< >> |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Drop removed item's data. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=back |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=cut |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
our $FREEZER = sub { |
168
|
|
|
|
|
|
|
local $Storable::canonical = 1; # for equal snapshots for equal by data hashes |
169
|
|
|
|
|
|
|
local $Storable::Deparse = 1; # for coderefs |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
freeze \$_[0]; |
172
|
|
|
|
|
|
|
}; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub diff($$;@) { |
175
|
147
|
|
|
147
|
1
|
235243
|
my ($x, $y, %opts) = @_; |
176
|
|
|
|
|
|
|
|
177
|
147
|
100
|
|
|
|
410
|
$opts{freezer} = $FREEZER unless (exists $opts{freezer}); |
178
|
|
|
|
|
|
|
|
179
|
147
|
|
|
|
|
439
|
_diff($x, $y, %opts); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _diff($$;@); |
183
|
|
|
|
|
|
|
sub _diff($$;@) { |
184
|
264
|
|
|
264
|
|
510
|
my ($x, $y, %opts) = @_; |
185
|
|
|
|
|
|
|
|
186
|
264
|
|
|
|
|
343
|
my $d = {}; |
187
|
264
|
|
|
|
|
400
|
my $type = ref $x; |
188
|
|
|
|
|
|
|
|
189
|
264
|
100
|
100
|
|
|
1453
|
if ($type ne ref $y) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
190
|
10
|
100
|
|
|
|
372
|
$d->{O} = $x unless ($opts{noO}); |
191
|
10
|
100
|
|
|
|
26
|
$d->{N} = $y unless ($opts{noN}); |
192
|
|
|
|
|
|
|
} elsif ($type eq 'ARRAY' and $x != $y) { |
193
|
86
|
|
|
|
|
205
|
my ($lcs, $stat) = _lcs_diff($x, $y, $opts{freezer}); |
194
|
|
|
|
|
|
|
|
195
|
86
|
100
|
|
|
|
149
|
if ($stat->{U} * 3 == @{$lcs}) { |
|
86
|
|
|
|
|
126
|
|
196
|
5
|
100
|
|
|
|
15
|
$d->{U} = $y unless ($opts{noU}); |
197
|
|
|
|
|
|
|
} else { |
198
|
81
|
|
|
|
|
160
|
my ($I, $xi, $yi, $op, $sd) = 0; |
199
|
|
|
|
|
|
|
|
200
|
81
|
|
|
|
|
88
|
while (@{$lcs}) { |
|
319
|
|
|
|
|
520
|
|
201
|
238
|
|
|
|
|
262
|
($op, $xi, $yi) = splice @{$lcs}, 0, 3; |
|
238
|
|
|
|
|
335
|
|
202
|
|
|
|
|
|
|
|
203
|
238
|
100
|
|
|
|
416
|
if ($op eq 'U') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
204
|
110
|
100
|
|
|
|
167
|
if ($opts{noU}) { $I++; next } |
|
44
|
|
|
|
|
67
|
|
|
44
|
|
|
|
|
53
|
|
205
|
66
|
|
|
|
|
76
|
push @{$d->{D}}, { U => $y->[$yi] }; |
|
66
|
|
|
|
|
144
|
|
206
|
|
|
|
|
|
|
} elsif ($op eq 'D') { |
207
|
67
|
|
|
|
|
206
|
$sd = _diff($x->[$xi], $y->[$yi], %opts); |
208
|
67
|
100
|
|
|
|
81
|
unless (keys %{$sd}) { $I++; next } |
|
67
|
|
|
|
|
148
|
|
|
6
|
|
|
|
|
6
|
|
|
6
|
|
|
|
|
10
|
|
209
|
61
|
|
|
|
|
69
|
push @{$d->{D}}, $sd; |
|
61
|
|
|
|
|
99
|
|
210
|
|
|
|
|
|
|
} elsif ($op eq 'A') { |
211
|
32
|
100
|
|
|
|
54
|
if ($opts{noA}) { $I++; next } |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
8
|
|
212
|
26
|
|
|
|
|
31
|
push @{$d->{D}}, { A => $y->[$yi] }; |
|
26
|
|
|
|
|
55
|
|
213
|
|
|
|
|
|
|
} else { |
214
|
29
|
100
|
|
|
|
47
|
if ($opts{noR}) { $I++; next } |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
7
|
|
215
|
25
|
100
|
|
|
|
29
|
push @{$d->{D}}, { R => $opts{trimR} ? undef : $x->[$xi] }; |
|
25
|
|
|
|
|
65
|
|
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
178
|
100
|
|
|
|
280
|
if ($I) { |
219
|
32
|
|
|
|
|
46
|
$d->{D}->[-1]->{I} = $xi; |
220
|
32
|
|
|
|
|
38
|
$I = 0; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} elsif ($type eq 'HASH' and $x != $y) { |
225
|
65
|
|
|
|
|
81
|
my @keys = keys %{{ %{$x}, %{$y} }}; # uniq keys for both hashes |
|
65
|
|
|
|
|
75
|
|
|
65
|
|
|
|
|
107
|
|
|
65
|
|
|
|
|
216
|
|
226
|
65
|
100
|
|
|
|
165
|
return $opts{noU} ? {} : { U => {} } unless (@keys); |
|
|
100
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
63
|
|
|
|
|
106
|
for my $k (@keys) { |
229
|
105
|
100
|
100
|
|
|
307
|
if (exists $x->{$k} and exists $y->{$k}) { |
|
|
100
|
|
|
|
|
|
230
|
75
|
100
|
|
|
|
131
|
if ($opts{freezer}($x->{$k}) eq $opts{freezer}($y->{$k})) { |
231
|
25
|
100
|
|
|
|
499
|
$d->{U}->{$k} = $y->{$k} unless ($opts{noU}); |
232
|
|
|
|
|
|
|
} else { |
233
|
50
|
|
|
|
|
1154
|
my $sd = _diff($x->{$k}, $y->{$k}, %opts); |
234
|
50
|
100
|
|
|
|
57
|
$d->{D}->{$k} = $sd if (keys %{$sd}); |
|
50
|
|
|
|
|
170
|
|
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
} elsif (exists $x->{$k}) { |
237
|
|
|
|
|
|
|
$d->{D}->{$k}->{R} = $opts{trimR} ? undef : $x->{$k} |
238
|
17
|
100
|
|
|
|
55
|
unless ($opts{noR}); |
|
|
100
|
|
|
|
|
|
239
|
|
|
|
|
|
|
} else { |
240
|
13
|
100
|
|
|
|
35
|
$d->{D}->{$k}->{A} = $y->{$k} unless ($opts{noA}); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
63
|
100
|
100
|
|
|
144
|
if (exists $d->{U} and exists $d->{D}) { |
245
|
12
|
|
|
|
|
16
|
map { $d->{D}->{$_}->{U} = $d->{U}->{$_} } keys %{$d->{U}}; |
|
15
|
|
|
|
|
39
|
|
|
12
|
|
|
|
|
31
|
|
246
|
12
|
|
|
|
|
27
|
delete $d->{U}; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
} elsif ($type && $x == $y || $opts{freezer}($x) eq $opts{freezer}($y)) { |
249
|
18
|
100
|
|
|
|
884
|
$d->{U} = $x unless ($opts{noU}); |
250
|
|
|
|
|
|
|
} else { |
251
|
85
|
100
|
|
|
|
2787
|
$d->{O} = $x unless ($opts{noO}); |
252
|
85
|
100
|
|
|
|
189
|
$d->{N} = $y unless ($opts{noN}); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
262
|
|
|
|
|
695
|
return $d; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub _lcs_diff { |
259
|
86
|
|
|
86
|
|
259
|
my ($xm, $ym) = LCSidx(@_); |
260
|
86
|
|
|
|
|
3730
|
my ($xi, $yi, @diff, %stat) = (0, 0); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# additional unchanged items to collect trailing non-matched |
263
|
86
|
|
|
|
|
96
|
push @{$xm}, scalar @{$_[0]}; |
|
86
|
|
|
|
|
166
|
|
|
86
|
|
|
|
|
134
|
|
264
|
86
|
|
|
|
|
106
|
push @{$ym}, scalar @{$_[1]}; |
|
86
|
|
|
|
|
105
|
|
|
86
|
|
|
|
|
122
|
|
265
|
|
|
|
|
|
|
|
266
|
86
|
|
|
|
|
105
|
while (@{$xm}) { |
|
413
|
|
|
|
|
596
|
|
267
|
327
|
100
|
100
|
|
|
972
|
if ($xi == $xm->[0] and $yi == $ym->[0]) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
268
|
199
|
|
|
|
|
216
|
push @diff, 'U', shift @{$xm}, shift @{$ym}; |
|
199
|
|
|
|
|
219
|
|
|
199
|
|
|
|
|
336
|
|
269
|
199
|
|
|
|
|
224
|
$xi++; $yi++; |
|
199
|
|
|
|
|
183
|
|
270
|
199
|
|
|
|
|
253
|
$stat{U}++; |
271
|
|
|
|
|
|
|
} elsif ($xi < $xm->[0] and $yi < $ym->[0]) { |
272
|
67
|
|
|
|
|
150
|
push @diff, 'D', $xi++, $yi++; |
273
|
67
|
|
|
|
|
95
|
$stat{N}++; |
274
|
|
|
|
|
|
|
} elsif ($xi < $xm->[0]) { |
275
|
29
|
|
|
|
|
50
|
push @diff, 'R', $xi++, $yi; |
276
|
29
|
|
|
|
|
57
|
$stat{R}++; |
277
|
|
|
|
|
|
|
} else { |
278
|
32
|
|
|
|
|
56
|
push @diff, 'A', $xi, $yi++; |
279
|
32
|
|
|
|
|
41
|
$stat{A}++; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
86
|
100
|
|
|
|
196
|
$stat{O} = $stat{N} if (exists $stat{N}); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# remove added above trailing item |
286
|
86
|
|
|
|
|
134
|
splice @diff, -3, 3; |
287
|
86
|
|
|
|
|
95
|
$stat{U}--; |
288
|
|
|
|
|
|
|
|
289
|
86
|
|
|
|
|
216
|
return \@diff, \%stat; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head2 list_diff |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
List all pairs (path_to_subdiff, ref_to_subdiff) for provided diff. See |
295
|
|
|
|
|
|
|
L for path format specification. |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
@list = list_diff($diff); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=head3 Options |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=over 4 |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=item depth C<< >> |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
Don't dive deeper than defined number of levels; C used by default |
306
|
|
|
|
|
|
|
(unlimited). |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=item sort C<< >> |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Defines how to handle hash subdiffs. Keys will be picked randomely (default |
311
|
|
|
|
|
|
|
C behavior), sorted by provided subroutine (if value is a coderef) or |
312
|
|
|
|
|
|
|
lexically sorted if set to some other true value. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=back |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=cut |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub list_diff($;@) { |
319
|
8
|
|
|
8
|
1
|
20
|
my @stack = ([], \shift); # init: (path, diff) |
320
|
8
|
|
|
|
|
13
|
my %opts = @_; |
321
|
8
|
|
|
|
|
10
|
my ($diff, @list, $path, $I); |
322
|
|
|
|
|
|
|
|
323
|
8
|
|
|
|
|
13
|
while (@stack) { |
324
|
36
|
|
|
|
|
47
|
($path, $diff) = splice @stack, -2, 2; |
325
|
|
|
|
|
|
|
|
326
|
36
|
100
|
100
|
|
|
39
|
if (!exists ${$diff}->{D} or $opts{depth} and @{$path} >= $opts{depth}) { |
|
36
|
100
|
100
|
|
|
74
|
|
|
5
|
|
|
|
|
13
|
|
327
|
18
|
|
|
|
|
38
|
unshift @list, $path, $diff; |
328
|
18
|
|
|
|
|
30
|
} elsif (ref ${$diff}->{D} eq 'ARRAY') { |
329
|
8
|
|
|
|
|
7
|
$I = 0; |
330
|
8
|
|
|
|
|
8
|
for (@{${$diff}->{D}}) { |
|
8
|
|
|
|
|
7
|
|
|
8
|
|
|
|
|
14
|
|
331
|
14
|
100
|
|
|
|
17
|
$I = $_->{I} if (exists $_->{I}); # use provided index |
332
|
14
|
|
|
|
|
14
|
push @stack, [@{$path}, [$I]], \$_; |
|
14
|
|
|
|
|
22
|
|
333
|
14
|
|
|
|
|
22
|
$I++; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
} else { # HASH |
336
|
|
|
|
|
|
|
map { |
337
|
14
|
|
|
|
|
22
|
push @stack, [@{$path}, {K => [$_]}], \${$diff}->{D}->{$_} |
|
14
|
|
|
|
|
26
|
|
|
14
|
|
|
|
|
32
|
|
338
|
|
|
|
|
|
|
} $opts{sort} |
339
|
|
|
|
|
|
|
? ref $opts{sort} eq 'CODE' |
340
|
1
|
|
|
|
|
2
|
? $opts{sort}(keys %{${$diff}->{D}}) |
|
1
|
|
|
|
|
4
|
|
341
|
1
|
|
|
|
|
1
|
: sort keys %{${$diff}->{D}} |
|
1
|
|
|
|
|
5
|
|
342
|
10
|
100
|
|
|
|
16
|
: keys %{${$diff}->{D}}; |
|
8
|
100
|
|
|
|
8
|
|
|
8
|
|
|
|
|
16
|
|
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
8
|
|
|
|
|
47
|
return @list; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head2 split_diff |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
Divide diff to pseudo original structures. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
$structs = split_diff(diff($x, $y)); |
354
|
|
|
|
|
|
|
# $structs->{a}: items from $x |
355
|
|
|
|
|
|
|
# $structs->{b}: items from $y |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=cut |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub split_diff($); |
360
|
|
|
|
|
|
|
sub split_diff($) { |
361
|
57
|
|
|
57
|
1
|
292
|
my $d = $_[0]; |
362
|
57
|
|
|
|
|
57
|
my (%out, $sd); |
363
|
|
|
|
|
|
|
|
364
|
57
|
100
|
|
|
|
94
|
if (exists $d->{D}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
365
|
14
|
100
|
|
|
|
23
|
if (ref $d->{D} eq 'ARRAY') { |
366
|
8
|
|
|
|
|
9
|
for (@{$d->{D}}) { |
|
8
|
|
|
|
|
12
|
|
367
|
20
|
|
|
|
|
26
|
$sd = split_diff($_); |
368
|
20
|
100
|
|
|
|
27
|
push @{$out{a}}, $sd->{a} if (exists $sd->{a}); |
|
19
|
|
|
|
|
31
|
|
369
|
20
|
100
|
|
|
|
27
|
push @{$out{b}}, $sd->{b} if (exists $sd->{b}); |
|
19
|
|
|
|
|
28
|
|
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} else { # HASH |
372
|
6
|
|
|
|
|
7
|
for (keys %{$d->{D}}) { |
|
6
|
|
|
|
|
14
|
|
373
|
27
|
|
|
|
|
30
|
$sd = split_diff($d->{D}->{$_}); |
374
|
27
|
100
|
|
|
|
44
|
$out{a}->{$_} = $sd->{a} if (exists $sd->{a}); |
375
|
27
|
100
|
|
|
|
45
|
$out{b}->{$_} = $sd->{b} if (exists $sd->{b}); |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
} elsif (exists $d->{U}) { |
379
|
14
|
|
|
|
|
20
|
$out{a} = $out{b} = $d->{U}; |
380
|
|
|
|
|
|
|
} elsif (exists $d->{A}) { |
381
|
6
|
|
|
|
|
7
|
$out{b} = $d->{A}; |
382
|
|
|
|
|
|
|
} elsif (exists $d->{R}) { |
383
|
6
|
|
|
|
|
10
|
$out{a} = $d->{R}; |
384
|
|
|
|
|
|
|
} else { |
385
|
17
|
100
|
|
|
|
33
|
$out{b} = $d->{N} if (exists $d->{N}); |
386
|
17
|
100
|
|
|
|
28
|
$out{a} = $d->{O} if (exists $d->{O}); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
57
|
|
|
|
|
104
|
return \%out; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 patch |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Apply diff. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
patch($target, $diff); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=cut |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub patch($$) { |
401
|
111
|
|
|
111
|
1
|
379871
|
my @stack = (\$_[0], $_[1]); # ref to alias - to be able to change passed scalar |
402
|
|
|
|
|
|
|
|
403
|
111
|
|
|
|
|
347
|
while (@stack) { |
404
|
168
|
|
|
|
|
347
|
my ($s, $d) = splice @stack, 0, 2; # struct, subdiff |
405
|
|
|
|
|
|
|
|
406
|
168
|
100
|
|
|
|
467
|
if (exists $d->{D}) { |
|
|
100
|
|
|
|
|
|
407
|
82
|
100
|
|
|
|
166
|
if (ref $d->{D} eq 'ARRAY') { |
408
|
50
|
|
|
|
|
81
|
my ($i, $j) = (0, 0); # target array idx, jitter |
409
|
|
|
|
|
|
|
|
410
|
50
|
|
|
|
|
52
|
for (@{$d->{D}}) { |
|
50
|
|
|
|
|
100
|
|
411
|
122
|
100
|
|
|
|
211
|
$i = $_->{I} + $j if (exists $_->{I}); |
412
|
|
|
|
|
|
|
|
413
|
122
|
100
|
100
|
|
|
348
|
if (exists $_->{D} or exists $_->{N}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
414
|
37
|
|
|
|
|
43
|
push @stack, \${$s}->[$i], $_; |
|
37
|
|
|
|
|
60
|
|
415
|
|
|
|
|
|
|
} elsif (exists $_->{A}) { |
416
|
25
|
|
|
|
|
30
|
splice @{${$s}}, $i, 0, $_->{A}; |
|
25
|
|
|
|
|
25
|
|
|
25
|
|
|
|
|
42
|
|
417
|
25
|
|
|
|
|
29
|
$j++; |
418
|
|
|
|
|
|
|
} elsif (exists $_->{R}) { |
419
|
24
|
|
|
|
|
27
|
splice @{${$s}}, $i, 1; |
|
24
|
|
|
|
|
25
|
|
|
24
|
|
|
|
|
37
|
|
420
|
24
|
|
|
|
|
29
|
$j--; |
421
|
24
|
|
|
|
|
57
|
next; # don't increment $i |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
98
|
|
|
|
|
165
|
$i++; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} else { # HASH |
427
|
32
|
|
|
|
|
35
|
while (my ($k, $v) = each %{$d->{D}}) { |
|
74
|
|
|
|
|
208
|
|
428
|
42
|
100
|
100
|
|
|
137
|
if (exists $v->{D} or exists $v->{N}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
429
|
20
|
|
|
|
|
24
|
push @stack, \${$s}->{$k}, $v; |
|
20
|
|
|
|
|
38
|
|
430
|
|
|
|
|
|
|
} elsif (exists $v->{A}) { |
431
|
6
|
|
|
|
|
8
|
${$s}->{$k} = $v->{A}; |
|
6
|
|
|
|
|
13
|
|
432
|
|
|
|
|
|
|
} elsif (exists $v->{R}) { |
433
|
10
|
|
|
|
|
11
|
delete ${$s}->{$k}; |
|
10
|
|
|
|
|
22
|
|
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
} elsif (exists $d->{N}) { |
438
|
61
|
|
|
|
|
79
|
${$s} = $d->{N}; |
|
61
|
|
|
|
|
162
|
|
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=head2 valid_diff |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Validate diff structure. In scalar context returns C<1> for valid diff, C |
446
|
|
|
|
|
|
|
otherwise. In list context returns list of pairs (path, type) for each error. See |
447
|
|
|
|
|
|
|
L for path format specification. |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
@errors_list = valid_diff($diff); # list context |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
or |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
$is_valid = valid_diff($diff); # scalar context |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=cut |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub valid_diff($) { |
458
|
142
|
|
|
142
|
1
|
457901
|
my @stack = ([], shift); # (path, diff) |
459
|
142
|
|
|
|
|
240
|
my ($diff, @errs, $path); |
460
|
|
|
|
|
|
|
|
461
|
142
|
|
|
|
|
343
|
while (@stack) { |
462
|
340
|
|
|
|
|
586
|
($path, $diff) = splice @stack, 0, 2; |
463
|
|
|
|
|
|
|
|
464
|
340
|
100
|
|
|
|
709
|
unless (ref $diff eq 'HASH') { |
465
|
5
|
100
|
|
|
|
14
|
return undef unless wantarray; |
466
|
4
|
|
|
|
|
7
|
push @errs, $path, 'BAD_DIFF_TYPE'; |
467
|
4
|
|
|
|
|
11
|
next; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
335
|
100
|
|
|
|
592
|
if (exists $diff->{D}) { |
471
|
103
|
100
|
|
|
|
227
|
if (ref $diff->{D} eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
472
|
|
|
|
|
|
|
map { |
473
|
152
|
|
|
|
|
157
|
unshift @stack, [@{$path}, [$_]], $diff->{D}->[$_] |
|
152
|
|
|
|
|
326
|
|
474
|
61
|
|
|
|
|
88
|
} 0 .. $#{$diff->{D}}; |
|
61
|
|
|
|
|
112
|
|
475
|
|
|
|
|
|
|
} elsif (ref $diff->{D} eq 'HASH') { |
476
|
|
|
|
|
|
|
map { |
477
|
46
|
|
|
|
|
73
|
unshift @stack, [@{$path}, {K => [$_]}], $diff->{D}->{$_} |
|
46
|
|
|
|
|
142
|
|
478
|
35
|
|
|
|
|
36
|
} sort keys %{$diff->{D}}; |
|
35
|
|
|
|
|
113
|
|
479
|
|
|
|
|
|
|
} else { |
480
|
7
|
100
|
|
|
|
13
|
return undef unless wantarray; |
481
|
6
|
|
|
|
|
10
|
unshift @errs, $path, 'BAD_D_TYPE'; |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
334
|
100
|
|
|
|
644
|
if (exists $diff->{I}) { |
486
|
37
|
100
|
100
|
|
|
150
|
if (!looks_like_number($diff->{I}) or int($diff->{I}) != $diff->{I}) { |
487
|
6
|
100
|
|
|
|
21
|
return undef unless wantarray; |
488
|
5
|
|
|
|
|
9
|
unshift @errs, $path, 'BAD_I_TYPE'; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
36
|
100
|
|
|
|
39
|
if (keys %{$diff} < 2) { |
|
36
|
|
|
|
|
102
|
|
492
|
2
|
100
|
|
|
|
7
|
return undef unless wantarray; |
493
|
1
|
|
|
|
|
4
|
unshift @errs, $path, 'LONESOME_I'; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
138
|
100
|
|
|
|
561
|
return wantarray ? @errs : 1; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=head1 CONFIGURATION VARIABLES |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=over 4 |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=item $Struct::Diff::FREEZER |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
Contains reference to default serialization function (C rely on it |
508
|
|
|
|
|
|
|
to determine data equivalency). L with enabled |
509
|
|
|
|
|
|
|
C<$Storable::canonical> and C<$Storable::Deparse> opts used by default. |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
L is suitable for structures with regular expressions: |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
use Data::Dumper; |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
$Struct::Diff::FREEZER = sub { |
516
|
|
|
|
|
|
|
local $Data::Dumper::Deparse = 1; |
517
|
|
|
|
|
|
|
local $Data::Dumper::Sortkeys = 1; |
518
|
|
|
|
|
|
|
local $Data::Dumper::Terse = 1; |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
return Dumper @_; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
But comparing to L it has two other issues: speed and unability |
524
|
|
|
|
|
|
|
to distinguish numbers from their string representations. |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=back |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=head1 LIMITATIONS |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Only arrays and hashes traversed. All other types compared by reference address |
531
|
|
|
|
|
|
|
and serialized content. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
L (serializer used by default) will fail serializing compiled |
534
|
|
|
|
|
|
|
regexps, so, consider to use other serializer if data contains regular |
535
|
|
|
|
|
|
|
expressions. See L for details. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
Struct::Diff will fail on structures with loops in references; |
538
|
|
|
|
|
|
|
C from L can help to detect such |
539
|
|
|
|
|
|
|
structures. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=head1 AUTHOR |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
Michael Samoglyadov, C<< >> |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=head1 BUGS |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, |
548
|
|
|
|
|
|
|
or through the web interface at |
549
|
|
|
|
|
|
|
L. I will be notified, |
550
|
|
|
|
|
|
|
and then you'll automatically be notified of progress on your bug as I make |
551
|
|
|
|
|
|
|
changes. |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=head1 SUPPORT |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
perldoc Struct::Diff |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
You can also look for information at: |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=over 4 |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
L |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
L |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=item * CPAN Ratings |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
L |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=item * Search CPAN |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
L |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=back |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head1 SEE ALSO |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
L, L, L, L, |
584
|
|
|
|
|
|
|
L |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
L, L, L |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
Copyright 2015-2018 Michael Samoglyadov. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
593
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
594
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
See L for more information. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=cut |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
1; # End of Struct::Diff |