Mercurial > pub > Impl
comparison 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 |
comparison
equal
deleted
inserted
replaced
167:1f7a6d762394 | 168:6148f89bb7bf |
---|---|
40 ], | 40 ], |
41 compare => [ | 41 compare => [ |
42 qw( | 42 qw( |
43 &equals | 43 &equals |
44 &equals_s | 44 &equals_s |
45 &hashCompare | |
46 ) | |
47 ], | |
48 hash => [ | |
49 qw( | |
50 &hashApply | |
51 &hashMerge | |
52 &hashDiff | |
53 &hashCompare | |
45 ) | 54 ) |
46 ] | 55 ] |
47 ); | 56 ); |
48 | 57 |
49 our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } }; | 58 our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } }; |
127 | 136 |
128 return 1; | 137 return 1; |
129 } | 138 } |
130 } | 139 } |
131 | 140 |
141 sub hashDiff { | |
142 my ($src,$dst) = @_; | |
143 | |
144 $dst = { %$dst }; | |
145 | |
146 my %result; | |
147 | |
148 foreach my $key ( keys %$src ) { | |
149 if (exists $dst->{$key}) { | |
150 $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key}); | |
151 delete $dst->{$key}; | |
152 } else { | |
153 $result{"-$key"} = 1; | |
154 } | |
155 } | |
156 | |
157 $result{"+$_"} = $dst->{$_} foreach keys %$dst; | |
158 | |
159 return \%result; | |
160 } | |
161 | |
162 sub hashMerge { | |
163 return hashApply( { %{$_[0]} }, $_[1] ); | |
164 } | |
165 | |
166 sub hashApply { | |
167 my ($target,$diff) = @_; | |
168 | |
169 while ( my ($key,$value) = each %$diff) { | |
170 $key =~ /^(\+|-)?(.*)$/; | |
171 my $op = $1 || '+'; | |
172 $key = $2; | |
173 | |
174 if ($op eq '-') { | |
175 delete $target->{$key}; | |
176 } else { | |
177 $target->{$key} = $value; | |
178 } | |
179 } | |
180 | |
181 return $target; | |
182 } | |
183 | |
184 sub hashCompare { | |
185 my ($l,$r,$cmp) = @_; | |
186 | |
187 $cmp ||= \&equals_s; | |
188 | |
189 return 0 unless scalar keys %$l == scalar keys %$r; | |
190 &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l; | |
191 | |
192 return 1; | |
193 } | |
194 | |
132 1; | 195 1; |