Mercurial > pub > Impl
diff Lib/IMPL/Object/Abstract.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 0004faa276dc |
children | 76b878ad6596 |
line wrap: on
line diff
--- a/Lib/IMPL/Object/Abstract.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/IMPL/Object/Abstract.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,136 +1,136 @@ -package IMPL::Object::Abstract; -use strict; -use warnings; - -use base qw(IMPL::Class::Meta); - -our $MemoryLeakProtection; -my $Cleanup = 0; - -my %cacheCTOR; - -my $t = 0; -sub cache_ctor { - my $class = shift; - - no strict 'refs'; - my @sequence; - - my $refCTORS = *{"${class}::CTOR"}{HASH}; - - foreach my $super ( @{"${class}::ISA"} ) { - my $superSequence = $cacheCTOR{$super} || cache_ctor($super); - - my $mapper = $refCTORS ? $refCTORS->{$super} : undef; - if (ref $mapper eq 'CODE') { - if ($mapper == *_pass_throgh_mapper{CODE}) { - push @sequence,@$superSequence; - } else { - push @sequence, sub { - my $this = shift; - $this->$_($mapper->(@_)) foreach @$superSequence; - }; - } - } else { - warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper; - push @sequence, sub { - my $this = shift; - $this->$_() foreach @$superSequence; - }; - } - } - - push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE}; - - $cacheCTOR{$class} = \@sequence; - return \@sequence; -} - -sub callCTOR { - my $self = shift; - my $class = ref $self; - - $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)}; -} - -sub superCTOR { - my $this = shift; - - warn "The mehod is deprecated, at " . caller; -} - -sub toString { - my $self = shift; - - return (ref $self || $self); -} - -sub isDisposed { - 0; -} - -#sub DESTROY { -# if ($MemoryLeakProtection and $Cleanup) { -# my $this = shift; -# warn sprintf("Object leaks: %s of type %s %s",$this->can('ToString') ? $this->ToString : $this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : ''); -# } -#} - -sub END { - $Cleanup = 1; -} - -sub _pass_throgh_mapper { - @_; -} - -sub PassArgs { - \&_pass_throgh_mapper; -} - -sub PassThroughArgs { - my $class = shift; - $class = ref $class || $class; - no strict 'refs'; - no warnings 'once'; - ${"${class}::CTOR"}{$_} = \&_pass_throgh_mapper foreach @{"${class}::ISA"}; -} - -package self; - -our $AUTOLOAD; -sub AUTOLOAD { - goto &{caller(). substr $AUTOLOAD,4}; -} - -package supercall; - -our $AUTOLOAD; -sub AUTOLOAD { - my $sub; - my $methodName = substr $AUTOLOAD,11; - no strict 'refs'; - $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'}; -} - -=pod -=h1 SYNOPSIS - -package MyBaseObject; -use base qw(IMPL::Object::Abstract); - -sub new { - # own implementation of the new opeator -} - -sub surrogate { - # own implementation of the surrogate operator -} - -=h1 DESCRIPTION - -Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов -создания экземпляров. -=cut - -1; +package IMPL::Object::Abstract; +use strict; +use warnings; + +use base qw(IMPL::Class::Meta); + +our $MemoryLeakProtection; +my $Cleanup = 0; + +my %cacheCTOR; + +my $t = 0; +sub cache_ctor { + my $class = shift; + + no strict 'refs'; + my @sequence; + + my $refCTORS = *{"${class}::CTOR"}{HASH}; + + foreach my $super ( @{"${class}::ISA"} ) { + my $superSequence = $cacheCTOR{$super} || cache_ctor($super); + + my $mapper = $refCTORS ? $refCTORS->{$super} : undef; + if (ref $mapper eq 'CODE') { + if ($mapper == *_pass_throgh_mapper{CODE}) { + push @sequence,@$superSequence; + } else { + push @sequence, sub { + my $this = shift; + $this->$_($mapper->(@_)) foreach @$superSequence; + }; + } + } else { + warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper; + push @sequence, sub { + my $this = shift; + $this->$_() foreach @$superSequence; + }; + } + } + + push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE}; + + $cacheCTOR{$class} = \@sequence; + return \@sequence; +} + +sub callCTOR { + my $self = shift; + my $class = ref $self; + + $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)}; +} + +sub superCTOR { + my $this = shift; + + warn "The mehod is deprecated, at " . caller; +} + +sub toString { + my $self = shift; + + return (ref $self || $self); +} + +sub isDisposed { + 0; +} + +#sub DESTROY { +# if ($MemoryLeakProtection and $Cleanup) { +# my $this = shift; +# warn sprintf("Object leaks: %s of type %s %s",$this->can('ToString') ? $this->ToString : $this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : ''); +# } +#} + +sub END { + $Cleanup = 1; +} + +sub _pass_throgh_mapper { + @_; +} + +sub PassArgs { + \&_pass_throgh_mapper; +} + +sub PassThroughArgs { + my $class = shift; + $class = ref $class || $class; + no strict 'refs'; + no warnings 'once'; + ${"${class}::CTOR"}{$_} = \&_pass_throgh_mapper foreach @{"${class}::ISA"}; +} + +package self; + +our $AUTOLOAD; +sub AUTOLOAD { + goto &{caller(). substr $AUTOLOAD,4}; +} + +package supercall; + +our $AUTOLOAD; +sub AUTOLOAD { + my $sub; + my $methodName = substr $AUTOLOAD,11; + no strict 'refs'; + $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'}; +} + +=pod +=h1 SYNOPSIS + +package MyBaseObject; +use base qw(IMPL::Object::Abstract); + +sub new { + # own implementation of the new opeator +} + +sub surrogate { + # own implementation of the surrogate operator +} + +=h1 DESCRIPTION + +Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов +создания экземпляров. +=cut + +1;