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; |
