diff --git a/dist.ini b/dist.ini index 99dc23e..59e6373 100644 --- a/dist.ini +++ b/dist.ini @@ -18,4 +18,5 @@ Test::Exception=0 perl=5.010000 Data::Clone=0 +Log::Any=0 Moo=0 diff --git a/lib/Data/ModeMerge.pm b/lib/Data/ModeMerge.pm index d67a1a7..2251a10 100644 --- a/lib/Data/ModeMerge.pm +++ b/lib/Data/ModeMerge.pm @@ -26,7 +26,6 @@ has modes => (is => 'rw', default => sub { {} }); has combine_rules => (is => 'rw'); # merging process state -has config_stack => (is => "rw"); has path => (is => "rw", default => sub { [] }); has errors => (is => "rw", default => sub { [] }); has mem => (is => "rw", default => sub { {} }); # for handling circular refs. {key=>{res=>[...], todo=>[sub1, ...]}, ...} @@ -34,7 +33,7 @@ has cur_mem_key => (is => "rw"); # for handling circular refs. instead of passin sub _dump { my ($self, $var) = @_; - Data::Dumper->new([$var])->Indent(0)->Terse(1)->Dump; + Data::Dumper->new([$var])->Indent(0)->Terse(1)->Sortkeys(1)->Dump; } sub _in($$) { @@ -221,21 +220,8 @@ sub remove_prefix_on_hash { $hash; } -sub save_config { - my ($self) = @_; - my %config = %{ $self->config() }; - push @{ $self->config_stack }, \%config; -} - -sub restore_config { - my ($self) = @_; - my $config = pop @{ $self->config_stack }; - $self->config(Data::ModeMerge::Config->new(%$config)); -} - sub merge { my ($self, $l, $r) = @_; - $self->config_stack([]); $self->path([]); $self->errors([]); $self->mem({}); @@ -644,8 +630,6 @@ A hashref for config. See L. =head2 combine_rules -=head2 config_stack - =head2 path =head2 errors @@ -692,17 +676,6 @@ Return hash key will any prefix removed. This is like C but performed on every key of the specified hash. Return the same hash but with prefixes removed. -=head2 save_config() - -Called by mode handlers to save configuration before recursive -merge. This is because many configuration settings can be overriden by -options key. - -=head2 restore_config() - -Called by mode handlers to restore configuration saved by -save_config(). - =head2 merge($l, $r) Merge two nested data structures. Returns the result hash: { diff --git a/lib/Data/ModeMerge/Mode/Base.pm b/lib/Data/ModeMerge/Mode/Base.pm index d241aa5..1507f42 100644 --- a/lib/Data/ModeMerge/Mode/Base.pm +++ b/lib/Data/ModeMerge/Mode/Base.pm @@ -1,6 +1,7 @@ package Data::ModeMerge::Mode::Base; use 5.010; +use Log::Any '$log'; use Moo; use Data::Clone qw/clone/; @@ -359,13 +360,15 @@ sub merge_HASH_HASH { my $mm = $self->merger; my $c = $mm->config; $mode //= $c->default_mode; - #print "DEBUG: entering merge_H_H(".$mm->_dump($l).", ".$mm->_dump($r).", $mode)\n"; + #print "DEBUG: entering merge_H_H(".$mm->_dump($l).", ".$mm->_dump($r).", $mode), config=($c)=",$mm->_dump($c),"\n"; + #$log->trace("using config($c)"); return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_hash; return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path); # STEP 1. MERGE LEFT & RIGHT OPTIONS KEY my $config_replaced; + my $orig_c = $c; my $ok = $c->options_key; { last unless defined $ok; @@ -393,9 +396,11 @@ sub merge_HASH_HASH { return; } last unless keys %$res; - #print "DEBUG: cloning config ...\n"; - #my $c2 = Storable::dclone($c); - my $c2 = clone($c); + #$log->tracef("cloning config ..."); + # Data::Clone by default does *not* deep-copy object + #my $c2 = clone($c); + my $c2 = bless({ %$c }, ref($c)); + for (keys %$res) { if ($c->allow_override) { my $re = $c->allow_override; @@ -421,11 +426,10 @@ sub merge_HASH_HASH { } $c2->$_($res->{$_}) unless $_ eq $ok; } - $mm->save_config; $mm->config($c2); $config_replaced++; $c = $c2; - #print "DEBUG: configuration now changed: ".$mm->_dump($c)."\n"; + #$log->trace("config now changed to $c2"); } my $sp = $c->set_prefix; @@ -550,7 +554,11 @@ sub merge_HASH_HASH { } } - $mm->restore_config if $config_replaced; + # restore config + if ($config_replaced) { + $mm->config($orig_c); + #print "DEBUG: Restored config, config=", $mm->_dump($mm->config), "\n"; + } #print "DEBUG: backup = ".Data::Dumper->new([$backup])->Indent(0)->Terse(1)->Dump."\n"; #print "DEBUG: leaving merge_H_H, result = ".$mm->_dump($res)."\n";