annotate Lib/Common.pm @ 136:f6af119ac741

url routines for templates
author wizard
date Fri, 25 Jun 2010 16:45:56 +0400
parents 16ada169ca75
children 76515373dac0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
1 package Common;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
2 use strict;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
3 no strict 'refs';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
4
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
5 require Exporter;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
6
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
7 our @ISA = qw(Exporter);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
8 our @EXPORT = qw(&ACCESS_NONE &ACCESS_READ &ACCESS_WRITE &ACCESS_ALL &DeclareProperty &DumpCaller &PropertyList &CloneObject);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
9
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
10 our $Debug;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
11
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
12 $Debug = 1 if not defined $Debug;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
13
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
14 my %ListProperties;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
15 my %GlobalContext;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
16
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
17 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
18
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
19 sub ACCESS_NONE () { 0 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
20 sub ACCESS_READ () { 1 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
21 sub ACCESS_WRITE () { 2 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
22 sub ACCESS_ALL () {ACCESS_READ | ACCESS_WRITE}
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
23
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
24 sub PropertyList {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
25 return $ListProperties{ref($_[0]) || $_[0] || caller} || {};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
26 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
27
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
28 sub DeclareProperty {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
29 my ($attrName,$accessRights,%Mutators) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
30
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
31 my $Package = caller;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
32 my $Method = $Package.'::'.$attrName;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
33 my $fldName;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
34
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
35 my $getMutator = $Mutators{'get'};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
36 my $setMutator = $Mutators{'set'};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
37
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
38 ($fldName = $Method) =~ s/:+/_/g;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
39
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
40 $ListProperties{$Package} = {} if not exists $ListProperties{$Package};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
41 $ListProperties{$Package}->{$attrName} = $fldName;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
42
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
43 if ($Debug) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
44 *$Method = sub {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
45 my $this = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
46
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
47 die new Exception( 'too many args ['.scalar(@_).'\]' , "'$Method' called from: ".DumpCaller() ) if (@_ > 1);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
48
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
49 my $Rights = $accessRights;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
50 $Rights = ACCESS_ALL if $Package eq caller;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
51
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
52 if (@_){
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
53 die new Exception("access denied 'write $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_WRITE;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
54 if (defined $setMutator) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
55 &$setMutator($this,$fldName,shift);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
56 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
57 $this->{$fldName} = $_[0];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
58 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
59
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
60 } elsif (defined wantarray) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
61 die new Exception("access denied 'read $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_READ;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
62 if (defined $getMutator) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
63 &$getMutator($this,$fldName);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
64 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
65 if (wantarray){
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
66 if(ref $this->{$fldName} eq 'ARRAY' ) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
67 return @{$this->{$fldName}};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
68 } elsif (not exists $this->{$fldName}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
69 return;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
70 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
71 return $this->{$fldName};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
72 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
73 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
74 return $this->{$fldName};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
75 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
76 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
77 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
78 undef;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
79 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
80 };
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
81 *$Method = \$fldName;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
82 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
83 *$Method = sub {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
84 my $this = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
85 #return undef if @_ > 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
86 #my $Rights = $accessRights;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
87 #$Rights = ACCESS_ALL if $Package eq caller;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
88
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
89 if (@_){
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
90 # return undef if not $Rights & ACCESS_WRITE;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
91 if (defined $setMutator) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
92 &$setMutator($this,$fldName,shift);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
93 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
94 $this->{$fldName} = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
95 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
96 } elsif (defined wantarray) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
97 # return undef if not $Rights & ACCESS_READ;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
98 if (defined $getMutator) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
99 &$getMutator($this,$fldName);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
100 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
101 if (wantarray){
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
102 if(ref $this->{$fldName} eq 'ARRAY' ) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
103 return @{$this->{$fldName}};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
104 } elsif (not defined $this->{$fldName}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
105 return;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
106 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
107 return $this->{$fldName};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
108 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
109 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
110 return $this->{$fldName};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
111 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
112 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
113 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
114 undef;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
115 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
116 };
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
117 *$Method = \$fldName;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
118 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
119 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
120
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
121 sub DumpCaller {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
122 return join(" ",(caller($_[0]))[1,2],(caller($_[0]+1))[3]);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
123 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
124
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
125 sub Owner {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
126 return undef if not tied $_[0];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
127 return undef if not tied($_[0])->UNIVERSAL::can('owner');
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
128 return tied($_[0])->owner();
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
129 };
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
130
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
131 sub CloneObject {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
132 my $object = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
133 if (ref $object == undef) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
134 return $object;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
135 } elsif (ref $object eq 'SCALAR') {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
136 return \CloneObject(${$object});
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
137 } elsif (ref $object eq 'ARRAY') {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
138 return [map{CloneObject($_)}@{$object}];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
139 } elsif (ref $object eq 'HASH') {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
140 my %clone;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
141 while (my ($key,$value) = each %{$object}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
142 $clone{$key} = CloneObject($value);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
143 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
144 return \%clone;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
145 } elsif (ref $object eq 'REF') {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
146 return \CloneObject(${$object});
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
147 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
148 if ($object->can('Clone')) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
149 return $object->Clone();
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
150 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
151 die new Exception('Object doesn\'t supports cloning');
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
152 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
153 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
154 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
155
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
156 package Exception;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
157 use base qw(IMPL::Exception);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
158
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
159 package Persistent;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
160 import Common;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
161
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
162 sub newSurogate {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
163 my $class = ref($_[0]) || $_[0];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
164 return bless {}, $class;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
165 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
166 sub load {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
167 my ($this,$context) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
168 die new Exception("invalid deserialization context") if ref($context) ne 'ARRAY';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
169 die new Exception("This is not an object") if not ref $this;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
170
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
171 my %Props = (@{$context});
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
172 foreach my $BaseClass(@{ref($this).'::ISA'}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
173 while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
174 $this->{$value} = $Props{$value} if exists $Props{$value};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
175 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
176 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
177
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
178 while (my ($key,$value) = each %{PropertyList(ref($this))}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
179 $this->{$value} = $Props{$key} if exists $Props{$key};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
180 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
181 return 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
182 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
183 sub save {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
184 my ($this,$context) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
185
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
186 foreach my $BaseClass(@{ref($this).'::ISA'}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
187 while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
188 $context->AddVar($value,$this->{$value});
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
189 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
190 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
191
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
192 while (my ($key,$value) = each %{PropertyList(ref($this))}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
193 $context->AddVar($key,$this->{$value});
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
194 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
195 return 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
196 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
197
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
198 sub restore {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
199 my ($class,$context,$surogate) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
200 my $this = $surogate || $class->newNewSurogate;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
201 $this->load($context);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
202 return $this;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
203 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
204
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
205 package Object;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
206 import Common;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
207
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
208 sub new {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
209 my $class = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
210 my $self = bless {}, ref($class) || $class;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
211 $self->CTOR(@_);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
212 return $self;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
213 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
214
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
215 sub cast {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
216 return bless {}, ref $_[0] || $_[0];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
217 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
218
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
219 our %objects_count;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
220 our %leaked_objects;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
221
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
222 sub CTOR {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
223 my $this= shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
224 $objects_count{ref $this} ++ if $Debug;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
225 my %args = @_ if scalar (@_) > 0;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
226 return if scalar(@_) == 0;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
227
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
228 warn "invalid args in CTOR. type: ".(ref $this) if scalar(@_) % 2 != 0;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
229 my @packages = (ref($this));
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
230 my $countArgs = int(scalar(@_) / 2);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
231 #print "Set ", join(', ',keys %args), "\n";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
232 LOOP_PACKS: while(@packages) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
233 my $package = shift @packages;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
234 #print "\t$package\n";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
235 my $refProps = PropertyList($package);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
236 foreach my $name (keys %{$refProps}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
237 my $fld = $refProps->{$name};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
238 if (exists $args{$name}) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
239 $this->{$fld} = $args{$name};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
240 #print "\t$countArgs, $name\n";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
241 delete $args{$name};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
242 $countArgs --;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
243 last LOOP_PACKS if $countArgs < 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
244 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
245 #print "\t-$name ($fld)\n";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
246 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
247 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
248 push @packages, @{$package.'::ISA'};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
249 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
250 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
251
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
252 sub Dispose {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
253 my $this = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
254
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
255 if ($Debug and UNIVERSAL::isa($this,'HASH')) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
256 my @keys = grep { $this->{$_} and ref $this->{$_} } keys %{$this};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
257 warn "not all fields of the object were deleted\n".join("\n",@keys) if @keys;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
258 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
259
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
260 bless $this,'Object::Disposed';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
261 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
262
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
263 our $MemoryLeakProtection;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
264
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
265 sub DESTROY {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
266 if ($MemoryLeakProtection) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
267 my $this = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
268 warn sprintf("Object leaks: %s of type %s %s",$this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : '');
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
269 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
270 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
271
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
272 package Object::Disposed;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
273 our $AUTOLOAD;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
274 sub AUTOLOAD {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
275 return if $AUTOLOAD eq __PACKAGE__.'::DESTROY';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
276 die new Exception('Object have been disposed',$AUTOLOAD);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
277 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
278
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
279 END {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
280 $MemoryLeakProtection = 0 if not $Debug;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
281 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
282 1;