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;