Mercurial > pub > Impl
diff Lib/IMPL/lang.pm @ 168:6148f89bb7bf
IMPL::SQL::Schema::Traits::Diff alfa version
IMPL::lang added hash traits
author | sourcer |
---|---|
date | Mon, 16 May 2011 04:30:38 +0400 |
parents | 1f7a6d762394 |
children | fd92830036c3 |
line wrap: on
line diff
--- a/Lib/IMPL/lang.pm Thu May 12 08:57:19 2011 +0400 +++ b/Lib/IMPL/lang.pm Mon May 16 04:30:38 2011 +0400 @@ -42,6 +42,15 @@ qw( &equals &equals_s + &hashCompare + ) + ], + hash => [ + qw( + &hashApply + &hashMerge + &hashDiff + &hashCompare ) ] ); @@ -129,4 +138,58 @@ } } +sub hashDiff { + my ($src,$dst) = @_; + + $dst = { %$dst }; + + my %result; + + foreach my $key ( keys %$src ) { + if (exists $dst->{$key}) { + $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key}); + delete $dst->{$key}; + } else { + $result{"-$key"} = 1; + } + } + + $result{"+$_"} = $dst->{$_} foreach keys %$dst; + + return \%result; +} + +sub hashMerge { + return hashApply( { %{$_[0]} }, $_[1] ); +} + +sub hashApply { + my ($target,$diff) = @_; + + while ( my ($key,$value) = each %$diff) { + $key =~ /^(\+|-)?(.*)$/; + my $op = $1 || '+'; + $key = $2; + + if ($op eq '-') { + delete $target->{$key}; + } else { + $target->{$key} = $value; + } + } + + return $target; +} + +sub hashCompare { + my ($l,$r,$cmp) = @_; + + $cmp ||= \&equals_s; + + return 0 unless scalar keys %$l == scalar keys %$r; + &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l; + + return 1; +} + 1;