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;