comparison Lib/IMPL/Object/Abstract.pm @ 2:78cd38551534

in develop
author Sergey
date Mon, 10 Aug 2009 17:39:08 +0400
parents 3b418b134d8c
children 7f00786f8210
comparison
equal deleted inserted replaced
1:3b418b134d8c 2:78cd38551534
1 package IMPL::Object::Abstract; 1 package IMPL::Object::Abstract;
2 use strict; 2 use strict;
3 use warnings; 3 use warnings;
4 package IMPL::Object;
5 use strict;
6 4
7 use base qw(IMPL::Class::Meta); 5 use base qw(IMPL::Class::Meta);
8 6
9 our $MemoryLeakProtection; 7 our $MemoryLeakProtection;
10 my $Cleanup = 0; 8 my $Cleanup = 0;
11 our $Debug;
12 our %leaked_objects;
13 9
14 my %cacheCTOR; 10 my %cacheCTOR;
15 11
16
17 sub new {
18 my $class = shift;
19 my $self = bless {}, ref($class) || $class;
20
21 $self->$_(@_) foreach @{$cacheCTOR{ref $self} || cache_ctor(ref $self)};
22
23 $self;
24 }
25 my $t = 0; 12 my $t = 0;
26 sub cache_ctor { 13 sub cache_ctor {
27 my $class = shift; 14 my $class = shift;
28 15
29 no strict 'refs'; 16 no strict 'refs';
64 my $class = ref $self; 51 my $class = ref $self;
65 52
66 $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)}; 53 $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)};
67 } 54 }
68 55
69 sub surrogate {
70 bless {}, ref $_[0] || $_[0];
71 }
72
73 sub superCTOR { 56 sub superCTOR {
74 my $this = shift; 57 my $this = shift;
75 58
76 warn "The mehod is deprecated, at " . caller; 59 warn "The mehod is deprecated, at " . caller;
77 } 60 }
89 } 72 }
90 } 73 }
91 74
92 sub END { 75 sub END {
93 $Cleanup = 1; 76 $Cleanup = 1;
94 $MemoryLeakProtection = 0 unless $Debug;
95 } 77 }
96 78
97 sub _pass_throgh_mapper { 79 sub _pass_throgh_mapper {
98 @_; 80 @_;
99 } 81 }
139 121
140 =h1 DESCRIPTION 122 =h1 DESCRIPTION
141 123
142 Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов 124 Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов
143 создания экземпляров. 125 создания экземпляров.
144 126 =cut
145 127
146 1; 128 1;
147
148
149 1;