File Coverage

blib/lib/Data/ModeMerge.pm
Criterion Covered Total %
statement 179 196 91.3
branch 103 126 81.7
condition 55 67 82.0
subroutine 18 18 100.0
pod 9 10 90.0
total 364 417 87.2


line stmt bran cond sub pod time code
1             package Data::ModeMerge;
2              
3             our $DATE = '2016-07-22'; # DATE
4             our $VERSION = '0.35'; # VERSION
5              
6 31     31   477765 use 5.010001;
  31         94  
7 31     31   108 use strict;
  31         34  
  31         473  
8 31     31   93 use warnings;
  31         44  
  31         1154  
9              
10 31     31   10786 use Mo qw(build default);
  31         10730  
  31         121  
11              
12             require Exporter;
13             our @ISA = qw(Exporter);
14             our @EXPORT = qw(mode_merge);
15              
16             sub mode_merge {
17 133     133 1 84600 my ($l, $r, $config_vars) = @_;
18 133         505 my $mm = __PACKAGE__->new(config => $config_vars);
19 133         960 $mm->merge($l, $r);
20             }
21              
22             has config => (is => "rw");
23              
24             # hash of modename => handler
25             has modes => (is => 'rw', default => sub { {} });
26              
27             has combine_rules => (is => 'rw');
28              
29             # merging process state
30             has path => (is => "rw", default => sub { [] });
31             has errors => (is => "rw", default => sub { [] });
32             has mem => (is => "rw", default => sub { {} }); # for handling circular refs. {key=>{res=>[...], todo=>[sub1, ...]}, ...}
33             has cur_mem_key => (is => "rw"); # for handling circular refs. instead of passing around this as argument, we put it here.
34              
35             sub _in($$) {
36 1686     1686   1026 state $load_dmp = do { require Data::Dmp };
  10         56  
37 1686         1337 my ($self, $needle, $haystack) = @_;
38 1686 100       2002 return 0 unless defined($needle);
39 1685         1125 my $r1 = ref($needle);
40 1685 100       1699 my $f1 = $r1 ? Data::Dmp::dmp($needle) : undef;
41 1685         1924 for (@$haystack) {
42 2583         1660 my $r2 = ref($_);
43 2583 100 100     6140 next if $r1 xor $r2;
44 2578 100 100     3231 return 1 if $r2 && $f1 eq Data::Dmp::dmp($_);
45 2573 100 100     7870 return 1 if !$r2 && $needle eq $_;
46             }
47 1323         3215 0;
48             }
49              
50             sub BUILD {
51 330     330 0 143313 require Data::ModeMerge::Config;
52              
53 330         452 my ($self, $args) = @_;
54              
55 330 100       692 if ($self->config) {
56             # some sanity checks
57 107         634 my $is_hashref = ref($self->config) eq 'HASH';
58 107 50 33     572 die "config must be a hashref or a Data::ModeMerge::Config" unless
59             $is_hashref || UNIVERSAL::isa($self->config, "Data::ModeMerge::Config");
60 107 50       282 $self->config(Data::ModeMerge::Config->new(%{ $self->config })) if $is_hashref;
  107         187  
61             } else {
62 223         1243 $self->config(Data::ModeMerge::Config->new);
63             }
64              
65 330         8256 for (qw(NORMAL KEEP ADD CONCAT SUBTRACT DELETE)) {
66 1980         8578 $self->register_mode($_);
67             }
68              
69 330 50       1799 if (!$self->combine_rules) {
70 330         8147 $self->combine_rules({
71             # "left + right" => [which mode to use, which mode after merge]
72             'ADD+ADD' => ['ADD' , 'ADD' ],
73             #'ADD+CONCAT' => undef,
74             'ADD+DELETE' => ['DELETE' , 'DELETE'],
75             #'ADD+KEEP' => undef,
76             'ADD+NORMAL' => ['NORMAL' , 'NORMAL'],
77             'ADD+SUBTRACT' => ['SUBTRACT', 'ADD' ],
78              
79             #'CONCAT+ADD' => undef,
80             'CONCAT+CONCAT' => ['CONCAT' , 'CONCAT'],
81             'CONCAT+DELETE' => ['DELETE' , 'DELETE'],
82             #'CONCAT+KEEP' => undef,
83             'CONCAT+NORMAL' => ['NORMAL' , 'NORMAL'],
84             #'CONCAT+SUBTRACT' => undef,
85              
86             'DELETE+ADD' => ['NORMAL' , 'ADD' ],
87             'DELETE+CONCAT' => ['NORMAL' , 'CONCAT' ],
88             'DELETE+DELETE' => ['DELETE' , 'DELETE' ],
89             'DELETE+KEEP' => ['NORMAL' , 'KEEP' ],
90             'DELETE+NORMAL' => ['NORMAL' , 'NORMAL' ],
91             'DELETE+SUBTRACT' => ['NORMAL' , 'SUBTRACT'],
92              
93             'KEEP+ADD' => ['KEEP', 'KEEP'],
94             'KEEP+CONCAT' => ['KEEP', 'KEEP'],
95             'KEEP+DELETE' => ['KEEP', 'KEEP'],
96             'KEEP+KEEP' => ['KEEP', 'KEEP'],
97             'KEEP+NORMAL' => ['KEEP', 'KEEP'],
98             'KEEP+SUBTRACT' => ['KEEP', 'KEEP'],
99              
100             'NORMAL+ADD' => ['ADD' , 'NORMAL'],
101             'NORMAL+CONCAT' => ['CONCAT' , 'NORMAL'],
102             'NORMAL+DELETE' => ['DELETE' , 'NORMAL'],
103             'NORMAL+KEEP' => ['NORMAL' , 'KEEP' ],
104             'NORMAL+NORMAL' => ['NORMAL' , 'NORMAL'],
105             'NORMAL+SUBTRACT' => ['SUBTRACT', 'NORMAL'],
106              
107             'SUBTRACT+ADD' => ['SUBTRACT', 'SUBTRACT'],
108             #'SUBTRACT+CONCAT' => undef,
109             'SUBTRACT+DELETE' => ['DELETE' , 'DELETE' ],
110             #'SUBTRACT+KEEP' => undef,
111             'SUBTRACT+NORMAL' => ['NORMAL' , 'NORMAL' ],
112             'SUBTRACT+SUBTRACT' => ['ADD' , 'SUBTRACT'],
113             });
114             }
115             }
116              
117             sub push_error {
118 89     89 1 160 my ($self, $errmsg) = @_;
119 89         66 push @{ $self->errors }, [[@{ $self->path }], $errmsg];
  89         140  
  89         409  
120 89         540 return;
121             }
122              
123             sub register_mode {
124 1980     1980 1 1920 my ($self, $name0) = @_;
125 1980         1394 my $obj;
126 1980 50       8446 if (ref($name0)) {
    50          
    50          
127 0         0 my $obj = $name0;
128             } elsif ($name0 =~ /^\w+(::\w+)+$/) {
129 0         0 eval "require $name0; \$obj = $name0->new";
130 0 0       0 die "Can't load module $name0: $@" if $@;
131             } elsif ($name0 =~ /^\w+$/) {
132 1980         2409 my $modname = "Data::ModeMerge::Mode::$name0";
133 1980         102924 eval "require $modname; \$obj = $modname->new";
134 1980 50       25341 die "Can't load module $modname: $@" if $@;
135             } else {
136 0         0 die "Invalid mode name $name0";
137             }
138 1980         3693 my $name = $obj->name;
139 1980 50       3540 die "Mode $name already registered" if $self->modes->{$name};
140 1980         10656 $obj->merger($self);
141 1980         5595 $self->modes->{$name} = $obj;
142             }
143              
144             sub check_prefix {
145 18     18 1 513 my ($self, $hash_key) = @_;
146 18 100       46 die "Hash key not a string" if ref($hash_key);
147 16         32 my $dis = $self->config->disable_modes;
148 16 50 66     101 if (defined($dis) && ref($dis) ne 'ARRAY') {
149 0         0 $self->push_error("Invalid config value `disable_modes`: must be an array");
150 0         0 return;
151             }
152 16         13 for my $mh (sort { $b->precedence_level <=> $a->precedence_level }
  147         211  
153 96   100     309 grep { !$dis || !$self->_in($_->name, $dis) }
154 16         26 values %{ $self->modes }) {
155 80 100       370 if ($mh->check_prefix($hash_key)) {
156 5         33 return $mh->name;
157             }
158             }
159 11         76 return;
160             }
161              
162             sub check_prefix_on_hash {
163 7     7 1 40 my ($self, $hash) = @_;
164 7 100       29 die "Not a hash" unless ref($hash) eq 'HASH';
165 5         6 my $res = 0;
166 5         12 for (keys %$hash) {
167 7 100       9 do { $res++; last } if $self->check_prefix($_);
  2         2  
  2         3  
168             }
169 5         16 $res;
170             }
171              
172             sub add_prefix {
173 36     36 1 6995 my ($self, $hash_key, $mode) = @_;
174 36 100       105 die "Hash key not a string" if ref($hash_key);
175 34         74 my $dis = $self->config->disable_modes;
176 34 50 33     226 if (defined($dis) && ref($dis) ne 'ARRAY') {
177 0         0 die "Invalid config value `disable_modes`: must be an array";
178             }
179 34 50 33     83 if ($dis && $self->_in($mode, $dis)) {
180 0         0 $self->push_error("Can't add prefix for currently disabled mode `$mode`");
181 0         0 return $hash_key;
182             }
183 34 50       75 my $mh = $self->modes->{$mode} or die "Unknown mode: $mode";
184 34         318 $mh->add_prefix($hash_key);
185             }
186              
187             sub remove_prefix {
188 2293     2293 1 2368 my ($self, $hash_key) = @_;
189 2293 100       2903 die "Hash key not a string" if ref($hash_key);
190 2291         3002 my $dis = $self->config->disable_modes;
191 2291 100 100     9582 if (defined($dis) && ref($dis) ne 'ARRAY') {
192 1         14 die "Invalid config value `disable_modes`: must be an array";
193             }
194 2290         1631 for my $mh (sort { $b->precedence_level <=> $a->precedence_level }
  21936         29589  
195 13740   100     30131 grep { !$dis || !$self->_in($_->name, $dis) }
196 2290         3209 values %{ $self->modes }) {
197 11372 100       47702 if ($mh->check_prefix($hash_key)) {
198 912         5733 my $r = $mh->remove_prefix($hash_key);
199 912 100       1219 if (wantarray) { return ($r, $mh->name) }
  909         1531  
200 3         5 else { return $r }
201             }
202             }
203 1378 100       6108 if (wantarray) { return ($hash_key, $self->config->default_mode) }
  1377         2044  
204 1         2 else { return $hash_key }
205             }
206              
207             sub remove_prefix_on_hash {
208 3     3 1 36 my ($self, $hash) = @_;
209 3 100       18 die "Not a hash" unless ref($hash) eq 'HASH';
210 1         3 for (keys %$hash) {
211 4         12 my $old = $_;
212 4         6 $_ = $self->remove_prefix($_);
213 4 100       20 next unless $old ne $_;
214             die "Conflict when removing prefix on hash: $old -> $_ but $_ already exists"
215 3 50       8 if exists $hash->{$_};
216 3         4 $hash->{$_} = $hash->{$old};
217 3         6 delete $hash->{$old};
218             }
219 1         6 $hash;
220             }
221              
222             sub merge {
223 323     323 1 3440 my ($self, $l, $r) = @_;
224 323         646 $self->path([]);
225 323         1549 $self->errors([]);
226 323         1354 $self->mem({});
227 323         1301 $self->cur_mem_key(undef);
228 323         1037 my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
229             {
230 322         520 success => !@{ $self->errors },
231 322         1393 error => (@{ $self->errors } ?
232             join(", ",
233 89         307 map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
  89         662  
234 322 100       336 @{ $self->errors }) : ''),
  89         397  
235             result => $res,
236             backup => $backup,
237             };
238             }
239              
240             # handle circular refs: process todo's
241             sub _process_todo {
242 755     755   653 my ($self) = @_;
243 755 100       1059 if ($self->cur_mem_key) {
244 746         2123 for my $mk (keys %{ $self->mem }) {
  746         998  
245 1037         5321 my $res = $self->mem->{$mk}{res};
246 1037 100 100     4805 if (defined($res) && @{ $self->mem->{$mk}{todo} }) {
  549         699  
247             #print "DEBUG: processing todo for mem<$mk>\n";
248 2         10 for (@{ $self->mem->{$mk}{todo} }) {
  2         3  
249 2         10 $_->(@$res);
250 2 50       2 return if @{ $self->errors };
  2         3  
251             }
252 2         13 $self->mem->{$mk}{todo} = [];
253             }
254             }
255             }
256             }
257              
258             sub _merge {
259 776     776   931 my ($self, $key, $l, $r, $mode) = @_;
260 776         1143 my $c = $self->config;
261 776   66     2726 $mode //= $c->default_mode;
262              
263 776         1346 my $mh = $self->modes->{$mode};
264 776 50       3429 die "Can't find handler for mode $mode" unless $mh;
265              
266             # determine which merge method we will call
267 776         813 my $rl = ref($l);
268 776         625 my $rr = ref($r);
269 776 50       1755 my $tl = $rl eq 'HASH' ? 'HASH' : $rl eq 'ARRAY' ? 'ARRAY' : $rl eq 'CODE' ? 'CODE' : !$rl ? 'SCALAR' : '';
    100          
    100          
    100          
270 776 50       1499 my $tr = $rr eq 'HASH' ? 'HASH' : $rr eq 'ARRAY' ? 'ARRAY' : $rr eq 'CODE' ? 'CODE' : !$rr ? 'SCALAR' : '';
    100          
    100          
    100          
271 776 50       1112 if (!$tl) { $self->push_error("Unknown type in left side: $rl"); return }
  0         0  
  0         0  
272 776 50       966 if (!$tr) { $self->push_error("Unknown type in right side: $rr"); return }
  0         0  
  0         0  
273 776 100 100     1178 if (!$c->allow_create_array && $tl ne 'ARRAY' && $tr eq 'ARRAY') {
      66        
274 5         54 $self->push_error("Not allowed to create array"); return;
  5         9  
275             }
276 771 100 100     2948 if (!$c->allow_create_hash && $tl ne 'HASH' && $tr eq 'HASH') {
      66        
277 5         49 $self->push_error("Not allowed to create hash"); return;
  5         9  
278             }
279 766 100 100     2735 if (!$c->allow_destroy_array && $tl eq 'ARRAY' && $tr ne 'ARRAY') {
      100        
280 5         47 $self->push_error("Not allowed to destroy array"); return;
  5         10  
281             }
282 761 100 66     2771 if (!$c->allow_destroy_hash && $tl eq 'HASH' && $tr ne 'HASH') {
      100        
283 5         55 $self->push_error("Not allowed to destroy hash"); return;
  5         8  
284             }
285 756         2624 my $meth = "merge_${tl}_${tr}";
286 756 50       2611 if (!$mh->can($meth)) { $self->push_error("No merge method found for $tl + $tr (mode $mode)"); return }
  0         0  
  0         0  
287              
288             #$self->_process_todo;
289             # handle circular refs: add to todo if necessary
290 756         604 my $memkey;
291 756 100 100     1873 if ($rl || $rr) {
292 406 100       2199 $memkey = sprintf "%s%s %s%s %s %s",
    100          
    100          
    100          
    100          
    100          
293             (defined($l) ? ($rl ? 2 : 1) : 0),
294             (defined($l) ? "$l" : ''),
295             (defined($r) ? ($rr ? 2 : 1) : 0),
296             (defined($r) ? "$r" : ''),
297             $mode,
298             $self->config;
299             #print "DEBUG: number of keys in mem = ".scalar(keys %{ $self->mem })."\n";
300             #print "DEBUG: mem keys = \n".join("", map { " $_\n" } keys %{ $self->mem }) if keys %{ $self->mem };
301             #print "DEBUG: calculating memkey = <$memkey>\n";
302             }
303 756 100       3034 if ($memkey) {
304 406 100       633 if (exists $self->mem->{$memkey}) {
305 3         18 $self->_process_todo;
306 3 50       6 if (defined $self->mem->{$memkey}{res}) {
307             #print "DEBUG: already calculated, using cached result\n";
308 0         0 return @{ $self->mem->{$memkey}{res} };
  0         0  
309             } else {
310             #print "DEBUG: detecting circular\n";
311 3         19 return ($key, undef, undef, 1);
312             }
313             } else {
314 403         2528 $self->mem->{$memkey} = {res=>undef, todo=>[]};
315 403         2081 $self->cur_mem_key($memkey);
316             #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
317 403         1712 my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
318             #print "DEBUG: setting res for mem<$memkey>\n";
319 402         1160 $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
320 402         1937 $self->_process_todo;
321 402         2800 return ($newkey, $res, $backup);
322             }
323             } else {
324 350         511 $self->_process_todo;
325             #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
326 350         1081 return $mh->$meth($key, $l, $r);
327             }
328             }
329              
330             # returns 1 if a is included in b (e.g. [user => "jajang"] in included in [user
331             # => jajang => "quota"], but [user => "paijo"] is not)
332             sub _path_is_included {
333 5     5   42 my ($self, $p1, $p2) = @_;
334 5         5 my $res = 1;
335 5         10 for my $i (0..@$p1-1) {
336 6 100 66     25 do { $res = 0; last } if !defined($p2->[$i]) || $p1->[$i] ne $p2->[$i];
  2         3  
  2         2  
337             }
338             #print "_path_is_included([".join(", ", @$p1)."], [".join(", ", @$p2)."])? $res\n";
339 5         22 $res;
340             }
341              
342             1;
343             # ABSTRACT: Merge two nested data structures, with merging modes and options
344              
345             __END__
346              
347             =pod
348              
349             =encoding UTF-8
350              
351             =head1 NAME
352              
353             Data::ModeMerge - Merge two nested data structures, with merging modes and options
354              
355             =head1 VERSION
356              
357             This document describes version 0.35 of Data::ModeMerge (from Perl distribution Data-ModeMerge), released on 2016-07-22.
358              
359             =head1 SYNOPSIS
360              
361             use Data::ModeMerge;
362              
363             my $hash1 = { a=>1, c=>1, d=>{ da =>[1]} };
364             my $hash2 = { a=>2, "-c"=>2, d=>{"+da"=>[2]} };
365              
366              
367             # if you want Data::ModeMerge to behave like many other merging
368             # modules (e.g. Hash::Merge or Data::Merger), turn off modes
369             # (prefix) parsing and options key parsing.
370              
371             my $mm = Data::ModeMerge->new(config => {parse_prefix=>0, options_key=>undef});
372             my $res = $mm->merge($hash1, $hash2);
373             die $res->{error} if $res->{error};
374             # $res->{result} -> { a=>2, c=>1, "-c"=>2, d=>{da=>[1], "+da"=>[2]} }
375              
376              
377             # otherwise Data::ModeMerge will parse prefix as well as options
378             # key
379              
380             my $res = $mm->merge($hash1, $hash2);
381             die $res->{error} if $res->{error};
382             # $res->{result} -> { a=>2, c=>-1, d=>{da=>[1,2]} }
383              
384             $res = $merge({ a =>1, { a2 =>1, ""=>{parse_prefix=>0}},
385             {".a"=>2, {".a2"=>2 }});
386             # $res->{result} -> { a=>12, {a2=>1, ".a2"=>2} }, parse_prefix is turned off in just the subhash
387              
388              
389             # procedural interface
390              
391             my $res = mode_merge($hash1, $hash2, {allow_destroy_hash=>0});
392              
393             =head1 DESCRIPTION
394              
395             There are already several modules on CPAN to do recursive data
396             structure merging, like L<Data::Merger> and
397             L<Hash::Merge>. C<Data::ModeMerge> differs in that it offers merging
398             "modes" and "options". It provides greater flexibility on what the
399             result of a merge between two data should/can be. This module may or
400             may not be what you need.
401              
402             One application of this module is in handling configuration. Often
403             there are multiple levels of configuration, e.g. in your typical Unix
404             command-line program there are system-wide config file in /etc,
405             per-user config file under ~/, and command-line options. It's
406             convenient programatically to load each of those in a hash and then
407             merge system-wide hash with the per-user hash, and then merge the
408             result with the command-line hash to get the a single hash as the
409             final configuration. Your program can from there on deal with this
410             just one hash instead of three.
411              
412             In a typical merging process between two hashes (left-side and
413             right-side), when there is a conflicting key, then the right-side key
414             will override the left-side. This is usually the desired behaviour in
415             our said program as the system-wide config is there to provide
416             defaults, and the per-user config (and the command-line arguments)
417             allow a user to override those defaults.
418              
419             But suppose that the user wants to I<unset> a certain configuration
420             setting that is defined by the system-wide config? She can't do that
421             unless she edits the system-wide config (in which she might need admin
422             rights), or the program allows the user to disregard the system-wide
423             config. The latter is usually what's implemented by many Unix
424             programs, e.g. the C<-noconfig> command-line option in C<mplayer>. But
425             this has two drawbacks: a slightly added complexity in the program
426             (need to provide a special, extra comand-line option) and the user
427             loses all the default settings in the system-wide config. What she
428             needed in the first place was to just unset I<a single setting> (a
429             single key-value pair of the hash).
430              
431             L<Data::ModeMerge> comes to the rescue. It provides a so-called
432             C<DELETE mode>.
433              
434             mode_merge({foo=>1, bar=>2}, {"!foo"=>undef, bar=>3, baz=>1});
435              
436             will result ini:
437              
438             {bar=>3, baz=>1}
439              
440             The C<!> prefix tells Data::ModeMerge to do a DELETE mode merging. So
441             the final result will lack the C<foo> key.
442              
443             On the other hand, what if the system admin wants to I<protect> a
444             certain configuration setting from being overriden by the user or the
445             command-line? This is useful in a hosting or other retrictive
446             environment where we want to limit users' freedom to some levels. This
447             is possible via the KEEP mode merging.
448              
449             mode_merge({"^bar"=>2, "^baz"=>1}, {bar=>3, "!baz"=>0, qux=>7});
450              
451             will result in:
452              
453             {"^bar"=>2, "^baz"=>1, qux=>7}
454              
455             effectively protecting C<bar> and C<baz> from being
456             overriden/deleted/etc.
457              
458             Aside from the two mentioned modes, there are also a few others
459             available by default: ADD (prefix C<+>), CONCAT (prefix C<.>),
460             SUBTRACT (prefix C<->), as well as the plain ol' NORMAL/override
461             (optional prefix C<*>).
462              
463             You can add other modes by writing a mode handler module.
464              
465             You can change the default prefixes for each mode if you want. You can
466             disable each mode individually.
467              
468             You can default to always using a certain mode, like the NORMAL mode,
469             and ignore all the prefixes, in which case Data::ModeMerge will behave
470             like most other merge modules.
471              
472             There are a few other options like whether or not the right side is
473             allowed a "change the structure" of the left side (e.g. replacing a
474             scalar with an array/hash, destroying an existing array/hash with
475             scalar), maximum length of scalar/array/hash, etc.
476              
477             You can change default mode, prefixes, disable/enable modes, etc on a
478             per-hash basis using the so-called B<options key>. See the B<OPTIONS
479             KEY> section for more details.
480              
481             This module can handle (though not all possible cases)
482             circular/recursive references.
483              
484             =for Pod::Coverage ^(BUILD)$
485              
486             =head1 MERGING PREFIXES AND YOUR DATA
487              
488             Merging with this module means you need to be careful when your hash
489             keys might contain one of the mode prefixes characters by accident,
490             because it will trigger the wrong merge mode and moreover the prefix
491             characters will be B<stripped> from the final result (unless you
492             configure the module not to do so).
493              
494             A rather common case is when you have regexes in your hash
495             keys. Regexes often begins with C<^>, which coincidentally is a prefix
496             for the KEEP mode. Or perhaps you have dot filenames as hash keys,
497             where it clashes with the CONCAT mode. Or perhaps shell wildcards,
498             where C<*> is also used as the prefix for NORMAL mode.
499              
500             To avoid clashes, you can either:
501              
502             =over 4
503              
504             =item * exclude the keys using
505             C<exclude_merge>/C<include_merge>/C<exclude_parse>/C<include_parse>
506             config settings
507              
508             =item * turn off some modes which you don't want via the
509             C<disable_modes> config
510              
511             =item * change the prefix for that mode so that it doesn't clash with
512             your data via the C<set_prefix> config
513              
514             =item * disable prefix parsing altogether via setting C<parse_prefix>
515             config to 0
516              
517             =back
518              
519             You can do this via the configuration, or on a per-hash basis, using
520             the options key.
521              
522             See L<Data::ModeMerge::Config> for more details on configuration.
523              
524             =head1 OPTIONS KEY
525              
526             Aside from merging mode prefixes, you also need to watch out if your
527             hash contains a "" (empty string) key, because by default this is the
528             key used for options key.
529              
530             Options key are used to specify configuration on a per-hash basis.
531              
532             If your hash keys might contain "" keys which are not meant to be an
533             options key, you can either:
534              
535             =over 4
536              
537             =item * change the name of the key for options key, via setting
538             C<options_key> config to another string.
539              
540             =item * turn off options key mechanism,
541             by setting C<options_key> config to undef.
542              
543             =back
544              
545             See L<Data::ModeMerge::Config> for more details about options key.
546              
547             =head1 MERGING MODES
548              
549             =head2 NORMAL (optional '*' prefix on left/right side)
550              
551             mode_merge({ a =>11, b=>12}, { b =>22, c=>23}); # {a=>11, b=>22, c=>23}
552             mode_merge({"*a"=>11, b=>12}, {"*b"=>22, c=>23}); # {a=>11, b=>22, c=>23}
553              
554             =head2 ADD ('+' prefix on the right side)
555              
556             mode_merge({i=>3}, {"+i"=>4, "+j"=>1}); # {i=>7, j=>1}
557             mode_merge({a=>[1]}, {"+a"=>[2, 3]}); # {a=>[1, 2, 3]}
558              
559             Additive merge on hashes will be treated like a normal merge.
560              
561             =head2 CONCAT ('.' prefix on the right side)
562              
563             mode_merge({i=>3}, {".i"=>4, ".j"=>1}); # {i=>34, j=>1}
564              
565             Concative merge on arrays will be treated like additive merge.
566              
567             =head2 SUBTRACT ('-' prefix on the right side)
568              
569             mode_merge({i=>3}, {"-i"=>4}); # {i=>-1}
570             mode_merge({a=>["a","b","c"]}, {"-a"=>["b"]}); # {a=>["a","c"]}
571              
572             Subtractive merge on hashes behaves like a normal merge, except that
573             each key on the right-side hash without any prefix will be assumed to
574             have a DELETE prefix, i.e.:
575              
576             mode_merge({h=>{a=>1, b=>1}}, {-h=>{a=>2, "+b"=>2, c=>2}})
577              
578             is equivalent to:
579              
580             mode_merge({h=>{a=>1, b=>1}}, {h=>{"!a"=>2, "+b"=>2, "!c"=>2}})
581              
582             and will merge to become:
583              
584             {h=>{b=>3}}
585              
586             =head2 DELETE ('!' prefix on the right side)
587              
588             mode_merge({x=>WHATEVER}, {"!x"=>WHATEVER}); # {}
589              
590             =head2 KEEP ('^' prefix on the left/right side)
591              
592             If you add '^' prefix on the left side, it will be protected from
593             being replaced/deleted/etc.
594              
595             mode_merge({'^x'=>WHATEVER1}, {"x"=>WHATEVER2}); # {x=>WHATEVER1}
596              
597             For hashes, KEEP mode means that all keys on the left side will not be
598             replaced/modified/deleted, *but* you can still add more keys from the
599             right side hash.
600              
601             mode_merge({a=>1, b=>2, c=>3},
602             {a=>4, '^c'=>1, d=>5},
603             {default_mode=>'KEEP'});
604             # {a=>1, b=>2, c=>3, d=>5}
605              
606             Multiple prefixes on the right side is allowed, where the merging will
607             be done by precedence level (highest first):
608              
609             mode_merge({a=>[1,2]}, {'-a'=>[1], '+a'=>[10]}); # {a=>[2,10]}
610              
611             but not on the left side:
612              
613             mode_merge({a=>1, '^a'=>2}, {a=>3}); # error!
614              
615             Precedence levels (from highest to lowest):
616              
617             KEEP
618             NORMAL
619             SUBTRACT
620             CONCAT ADD
621             DELETE
622              
623             =head1 CREATING AND USING YOUR OWN MODE
624              
625             Let's say you want to add a mode named C<FOO>. It will have the prefix
626             '?'.
627              
628             Create the mode handler class,
629             e.g. C<Data::ModeMerge::Mode::FOO>. It's probably best to subclass
630             from L<Data::ModeMerge::Mode::Base>. The class must implement name(),
631             precedence_level(), default_prefix(), default_prefix_re(), and
632             merge_{SCALAR,ARRAY,HASH}_{SCALAR,ARRAY,HASH}(). For more details, see
633             the source code of Base.pm and one of the mode handlers
634             (e.g. NORMAL.pm).
635              
636             To use the mode, register it:
637              
638             my $mm = Data::ModeMerge->new;
639             $mm->register_mode('FOO');
640              
641             This will require C<Data::ModeMerge::Mode::FOO>. After that, define
642             the operations against other modes:
643              
644             # if there's FOO on the left and NORMAL on the right, what mode
645             # should the merge be done in (FOO), and what the mode should be
646             # after the merge? (NORMAL)
647             $mm->combine_rules->{"FOO+NORMAL"} = ["FOO", "NORMAL"];
648              
649             # we don't define FOO+ADD
650              
651             $mm->combine_rules->{"FOO+KEEP"} = ["KEEP", "KEEP"];
652              
653             # and so on
654              
655             =head1 FUNCTIONS
656              
657             =head2 mode_merge($l, $r[, $config_vars])
658              
659             A non-OO wrapper for merge() method. Exported by default. See C<merge>
660             method for more details.
661              
662             =head1 ATTRIBUTES
663              
664             =head2 config
665              
666             A hashref for config. See L<Data::ModeMerge::Config>.
667              
668             =head2 modes
669              
670             =head2 combine_rules
671              
672             =head2 path
673              
674             =head2 errors
675              
676             =head2 mem
677              
678             =head2 cur_mem_key
679              
680             =head1 METHODS
681              
682             For typical usage, you only need merge().
683              
684             =head2 push_error($errmsg)
685              
686             Used by mode handlers to push error when doing merge. End users
687             normally should not need this.
688              
689             =head2 register_mode($name_or_package_or_obj)
690              
691             Register a mode. Will die if mode with the same name already exists.
692              
693             =head2 check_prefix($hash_key)
694              
695             Check whether hash key has prefix for certain mode. Return the name of
696             the mode, or undef if no prefix is detected.
697              
698             =head2 check_prefix_on_hash($hash)
699              
700             This is like C<check_prefix> but performed on every key of the
701             specified hash. Return true if any of the key contain a merge prefix.
702              
703             =head2 add_prefix($hash_key, $mode)
704              
705             Return hash key with added prefix with specified mode. Log merge error
706             if mode is unknown or is disabled.
707              
708             =head2 remove_prefix($hash_key)
709              
710             Return hash key will any prefix removed.
711              
712             =head2 remove_prefix_on_hash($hash)
713              
714             This is like C<remove_prefix> but performed on every key of the
715             specified hash. Return the same hash but with prefixes removed.
716              
717             =head2 merge($l, $r)
718              
719             Merge two nested data structures. Returns the result hash: {
720             success=>0|1, error=>'...', result=>..., backup=>... }. The 'error'
721             key is set to contain an error message if there is an error. The merge
722             result is in the 'result' key. The 'backup' key contains replaced
723             elements from the original hash/array.
724              
725             =head1 FAQ
726              
727             =head2 What is this module good for? Why would I want to use this module instead of the other hash merge modules?
728              
729             If you just need to (deeply) merge two hashes, chances are you do not
730             need this module. Use, for example, L<Hash::Merge>, which is also
731             flexible enough because it allows you to set merging behaviour for
732             merging different types (e.g. SCALAR vs ARRAY).
733              
734             You might need this module if your data is recursive/self-referencing
735             (which, last time I checked, is not handled well by Hash::Merge), or
736             if you want to be able to merge differently (i.e. apply different
737             merging B<modes>) according to different prefixes on the key, or
738             through special key. In other words, you specify merging modes from
739             inside the hash itself.
740              
741             I originally wrote Data::ModeMerge this for L<Data::Schema> and
742             L<Config::Tree>. I want to reuse the "parent" schema (or
743             configuration) in more ways other than just override conflicting
744             keys. I also want to be able to allow the parent to protect certain
745             keys from being overriden. I found these two features lacking in all
746             merging modules that I've evaluated prior to writing Data::ModeMerge.
747              
748             =head1 HOMEPAGE
749              
750             Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
751              
752             =head1 SOURCE
753              
754             Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
755              
756             =head1 BUGS
757              
758             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
759              
760             When submitting a bug or request, please include a test-file or a
761             patch to an existing test-file that illustrates the bug or desired
762             feature.
763              
764             =head1 SEE ALSO
765              
766             L<Data::ModeMerge::Config>
767              
768             Other merging modules on CPAN: L<Data::Merger> (from Data-Utilities),
769             L<Hash::Merge>, L<Hash::Merge::Simple>
770              
771             L<Data::Schema> and L<Config::Tree> (among others, two modules which
772             use Data::ModeMerge)
773              
774             =head1 AUTHOR
775              
776             perlancar <perlancar@cpan.org>
777              
778             =head1 COPYRIGHT AND LICENSE
779              
780             This software is copyright (c) 2016 by perlancar@cpan.org.
781              
782             This is free software; you can redistribute it and/or modify it under
783             the same terms as the Perl 5 programming language system itself.
784              
785             =cut