# HG changeset patch # User sergey # Date 1317736538 -14400 # Node ID d920d2b70230b43d8b91160bc20be2f065620483 # Parent aaab45153411427f4cdfdd721542cdec4b93ea97 minor changes diff -r aaab45153411 -r d920d2b70230 Lib/IMPL/Object/Abstract.pm --- 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; diff -r aaab45153411 -r d920d2b70230 Lib/IMPL/Object/Clonable.pm --- 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]); diff -r aaab45153411 -r d920d2b70230 Lib/IMPL/clone.pm --- 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; diff -r aaab45153411 -r d920d2b70230 Lib/IMPL/lang.pm --- 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; diff -r aaab45153411 -r d920d2b70230 _test/Test/Lang.pm --- 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