changeset 174:d920d2b70230

minor changes
author sergey
date Tue, 04 Oct 2011 17:55:38 +0400
parents aaab45153411
children 9057e4b95d10
files Lib/IMPL/Object/Abstract.pm Lib/IMPL/Object/Clonable.pm Lib/IMPL/clone.pm Lib/IMPL/lang.pm _test/Test/Lang.pm
diffstat 5 files changed, 32 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Object/Abstract.pm	Wed Sep 14 18:59:01 2011 +0400
+++ b/Lib/IMPL/Object/Abstract.pm	Tue Oct 04 17:55:38 2011 +0400
@@ -23,7 +23,7 @@
 		
 		my $mapper = $refCTORS ? $refCTORS->{$super} : undef;
 		if (ref $mapper eq 'CODE') {
-		    if ($mapper == *_pass_throgh_mapper{CODE}) {
+		    if ($mapper == *_pass_through_mapper{CODE}) {
 				push @sequence,@$superSequence;
 		    } else {
 				push @sequence, sub {
@@ -86,12 +86,12 @@
     $Cleanup = 1;
 }
 
-sub _pass_throgh_mapper {
+sub _pass_through_mapper {
     @_;
 }
 
 sub PassArgs {
-    \&_pass_throgh_mapper;
+    \&_pass_through_mapper;
 }
 
 sub PassThroughArgs {
@@ -99,7 +99,7 @@
     $class = ref $class || $class;
     no strict 'refs';
     no warnings 'once';
-    ${"${class}::CTOR"}{$_} = \&_pass_throgh_mapper foreach @{"${class}::ISA"};
+    ${"${class}::CTOR"}{$_} = \&_pass_through_mapper foreach @{"${class}::ISA"};
 }
 
 package self;
--- a/Lib/IMPL/Object/Clonable.pm	Wed Sep 14 18:59:01 2011 +0400
+++ b/Lib/IMPL/Object/Clonable.pm	Tue Oct 04 17:55:38 2011 +0400
@@ -1,7 +1,7 @@
 package IMPL::Object::Clonable;
 use strict;
 
-use Clone qw(clone);
+use IMPL::lang qw(clone);
 
 sub Clone {
 	 clone($_[0]);
--- a/Lib/IMPL/clone.pm	Wed Sep 14 18:59:01 2011 +0400
+++ b/Lib/IMPL/clone.pm	Tue Oct 04 17:55:38 2011 +0400
@@ -1,6 +1,6 @@
 package IMPL::clone;
 
-use Scalar::Util qw(blessed reftype);
+use Scalar::Util qw(blessed reftype refaddr);
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(&clone);
@@ -12,13 +12,13 @@
 			
 			my $new = {};
 			while (my ($key,$val) = each %{$_[0]}) {
-				$new->{$key} = clone($val);
+				$new->{$key} = clone($val,$_[1]);
 			}
 			$class ? bless $new, $class : $new;
 		},
 		ARRAY => sub {
 			my $class = blessed($_[0]);
-			$class ? bless( [ map clone($_), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ];
+			$class ? bless( [ map clone($_,$_[1]), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ];
 		},
 		SCALAR => sub {
 			my $class = blessed($_[0]);
@@ -28,7 +28,7 @@
 		},
 		REF => sub {
 			my $class = blessed($_[0]);
-			my $v = clone ( ${$_[0]} );
+			my $v = clone ( ${$_[0]},$_[1] );
 			$class ? bless \$v, $class : \$v;
 			
 		},
@@ -36,13 +36,15 @@
 			$_[0];
 		}
 	);
+	
 	sub clone {
 		return unless @_;
 		
 		return $_[0] unless ref $_[0];
 		
-		return ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]);
+		return $_[1]->{refaddr($_[0])} ||= ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]);
 	}
+	
 }
 
 1;
--- a/Lib/IMPL/lang.pm	Wed Sep 14 18:59:01 2011 +0400
+++ b/Lib/IMPL/lang.pm	Tue Oct 04 17:55:38 2011 +0400
@@ -195,4 +195,19 @@
 	return 1;
 }
 
+sub hashParse {
+	my ($s,$p,$d) = @_;
+	
+	$p = $p ? qr/$p/ : qr/\n+/;
+	$d = $d ? qr/$d/ : qr/\s*=\s*/;
+	
+	return {
+		map split($d,$_,2), split($p,$s)
+	};
+}
+
+sub hashSave {
+	
+}
+
 1;
--- a/_test/Test/Lang.pm	Wed Sep 14 18:59:01 2011 +0400
+++ b/_test/Test/Lang.pm	Tue Oct 04 17:55:38 2011 +0400
@@ -5,7 +5,7 @@
 use parent qw(IMPL::Test::Unit);
 
 use IMPL::Test qw(test failed assert);
-use IMPL::lang qw(:hash :compare);
+use IMPL::lang qw(:hash :compare clone);
 
 __PACKAGE__->PassThroughArgs;
 
@@ -74,4 +74,8 @@
 	
 };
 
+test clone => {
+	
+};
+
 1;
\ No newline at end of file