Mercurial > pub > Impl
view Lib/IMPL/Object/Abstract.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
author | sergey |
---|---|
date | Mon, 29 Oct 2012 03:15:22 +0400 |
parents | 6b1dda998839 |
children | ad93c9f4dd93 |
line wrap: on
line source
package IMPL::Object::Abstract; use strict; use warnings; use parent 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_through_mapper{CODE}) { push @sequence,@$superSequence; } else { push @sequence, sub { my $this = shift; $this->$_($mapper->(@_)) foreach @$superSequence; } if @$superSequence; } } elsif ($mapper and not ref $mapper and $mapper eq '@_') { push @sequence,@$superSequence; } else { warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper; push @sequence, sub { my $this = shift; $this->$_() foreach @$superSequence; } if @$superSequence; } } push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE}; $cacheCTOR{$class} = \@sequence; return \@sequence; } sub dump_ctor { my ($self) = @_; $self = ref $self || $self; warn "dumping $self .ctor"; warn "$_" foreach @{$cacheCTOR{$self}||[]}; } sub callCTOR { my $self = shift; my $class = ref $self; $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)}; } sub toString { my $self = shift; return (ref $self || $self); } sub typeof { ref $_[0] || $_[0]; } 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_through_mapper { @_; } sub PassArgs { \&_pass_through_mapper; } sub PassThroughArgs { my $class = shift; $class = ref $class || $class; no strict 'refs'; no warnings 'once'; ${"${class}::CTOR"}{$_} = \&_pass_through_mapper foreach @{"${class}::ISA"}; } package self; our $AUTOLOAD; sub AUTOLOAD { goto &{caller(). substr $AUTOLOAD,6}; } package supercall; our $AUTOLOAD; sub AUTOLOAD { my $sub; my $methodName = substr $AUTOLOAD,11; no strict 'refs'; $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'}; } 1; __END__ =pod =head1 SYNOPSIS package MyBaseObject; use parent qw(IMPL::Object::Abstract); sub new { # own implementation of the new opeator } sub surrogate { # own implementation of the surrogate operator } =head1 DESCRIPTION Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов создания экземпляров. =cut