--- a/Lib/Common.pm	Fri Feb 26 01:43:42 2010 +0300
+++ b/Lib/Common.pm	Fri Feb 26 10:49:21 2010 +0300
@@ -1,282 +1,282 @@
-package Common;
-use strict;
-no strict 'refs';
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-our @EXPORT = qw(&ACCESS_NONE &ACCESS_READ &ACCESS_WRITE &ACCESS_ALL &DeclareProperty &DumpCaller &PropertyList &CloneObject);
-
-our $Debug;
-
-$Debug = 1 if not defined $Debug;
-
-my %ListProperties;
-my %GlobalContext;
-
-1;
-
-sub ACCESS_NONE () { 0 }
-sub ACCESS_READ () { 1 }
-sub ACCESS_WRITE () { 2 }
-sub ACCESS_ALL () {ACCESS_READ | ACCESS_WRITE}
-
-sub PropertyList {
-	return $ListProperties{ref($_[0]) || $_[0] || caller} || {};
-}
-
-sub DeclareProperty {
-	my ($attrName,$accessRights,%Mutators) = @_;
-	
-	my $Package = caller;
-	my $Method = $Package.'::'.$attrName;
-	my $fldName;
-	
-	my $getMutator = $Mutators{'get'};
-	my $setMutator = $Mutators{'set'};
-	
-	($fldName = $Method) =~ s/:+/_/g;
-	
-	$ListProperties{$Package} = {} if not exists $ListProperties{$Package};
-	$ListProperties{$Package}->{$attrName} = $fldName;
-	
-	if ($Debug) {
-		*$Method = sub {
-			my $this = shift;
-			
-			die new Exception( 'too many args ['.scalar(@_).'\]' , "'$Method' called from: ".DumpCaller() ) if (@_ > 1);
-			
-			my $Rights = $accessRights;
-			$Rights = ACCESS_ALL if $Package eq caller;
-			
-			if (@_){
-				die new Exception("access denied 'write $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_WRITE;
-				if (defined $setMutator) {
-					&$setMutator($this,$fldName,shift);
-				} else {
-					$this->{$fldName} = $_[0];
-				}
-				
-			} elsif (defined wantarray) {
-				die new Exception("access denied 'read $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_READ;
-				if (defined $getMutator) {
-					&$getMutator($this,$fldName);
-				} else {
-					if (wantarray){
-						if(ref $this->{$fldName} eq 'ARRAY' ) {
-							return @{$this->{$fldName}};
-						} elsif (not exists $this->{$fldName}) {
-							return;
-						} else {
-							return $this->{$fldName};
-						}
-					} else {
-						return $this->{$fldName};
-					}
-				}
-			} else {
-				undef;
-			}
-		};
-		*$Method = \$fldName;
-	} else {
-		*$Method = sub {
-			my $this = shift;
-			#return undef if @_ > 1;
-			#my $Rights = $accessRights;
-			#$Rights = ACCESS_ALL if $Package eq caller;
-			
-			if (@_){
-			#	return undef if not $Rights & ACCESS_WRITE;
-				if (defined $setMutator) {
-					&$setMutator($this,$fldName,shift);
-				} else {
-					$this->{$fldName} = shift;
-				}
-			} elsif (defined wantarray) {
-			#	return undef if not $Rights & ACCESS_READ;
-				if (defined $getMutator) {
-					&$getMutator($this,$fldName);
-				} else {
-					if (wantarray){
-						if(ref $this->{$fldName} eq 'ARRAY' ) {
-							return @{$this->{$fldName}};
-						} elsif (not defined $this->{$fldName}) {
-							return;
-						} else {
-							return $this->{$fldName};
-						}
-					} else {
-						return $this->{$fldName};
-					}
-				}
-			} else {
-				undef;
-			}
-		};
-		*$Method = \$fldName;
-	}
-}
-
-sub DumpCaller {
-	return join(" ",(caller($_[0]))[1,2],(caller($_[0]+1))[3]);
-}
-
-sub Owner {
-	return undef if not tied $_[0];
-	return undef if not tied($_[0])->UNIVERSAL::can('owner');
-	return tied($_[0])->owner();
-};
-
-sub CloneObject {
-	my $object = shift;
-	if (ref $object == undef) {
-		return $object;
-	} elsif (ref $object eq 'SCALAR') {
-		return \CloneObject(${$object});
-	} elsif (ref $object eq 'ARRAY') {
-		return [map{CloneObject($_)}@{$object}];
-	} elsif (ref $object eq 'HASH') {
-		my %clone;
-		while (my ($key,$value) = each %{$object}) {
-			$clone{$key} = CloneObject($value);
-		}
-		return \%clone;
-	} elsif (ref $object eq 'REF') {
-		return \CloneObject(${$object});
-	} else {
-		if ($object->can('Clone')) {
-			return $object->Clone();
-		} else {
-			die new Exception('Object doesn\'t supports cloning');
-		}
-	}
-}
-
-package Exception;
-use base qw(IMPL::Exception);
-
-package Persistent;
-import Common;
-
-sub newSurogate {
-	my $class = ref($_[0]) || $_[0];
-	return bless {}, $class;
-}
-sub load {
-	my ($this,$context) = @_;
-	die new Exception("invalid deserialization context") if ref($context) ne 'ARRAY';
-	die new Exception("This is not an object") if not ref $this;
-	
-	my %Props = (@{$context});
-	foreach my $BaseClass(@{ref($this).'::ISA'}) {
-		while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
-			$this->{$value} = $Props{$value} if exists $Props{$value};
-		}
-	}
-	
-	while (my ($key,$value) = each %{PropertyList(ref($this))}) {
-		$this->{$value} = $Props{$key} if exists $Props{$key};
-	}
-	return 1;
-}
-sub save {
-	my ($this,$context) = @_;
-	
-	foreach my $BaseClass(@{ref($this).'::ISA'}) {
-		while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
-			$context->AddVar($value,$this->{$value});
-		}
-	}
-	
-	while (my ($key,$value) = each %{PropertyList(ref($this))}) {
-		$context->AddVar($key,$this->{$value});
-	}
-	return 1;
-}
-
-sub restore {
-    my ($class,$context,$surogate) = @_;
-    my $this = $surogate || $class->newNewSurogate;
-    $this->load($context);
-    return $this;
-}
-
-package Object;
-import Common;
-
-sub new {
-  my $class = shift;
-  my $self = bless {}, ref($class) || $class;
-  $self->CTOR(@_);
-  return $self;
-}
-
-sub cast {
-  return bless {}, ref $_[0] || $_[0];
-}
-
-our %objects_count;
-our %leaked_objects;
-
-sub CTOR {
-	my $this= shift;
-	$objects_count{ref $this} ++ if $Debug;
-	my %args = @_ if scalar (@_) > 0;
-	return if scalar(@_) == 0;
-	
-	warn "invalid args in CTOR. type: ".(ref $this) if scalar(@_) % 2 != 0;
-	my @packages = (ref($this));
-	my $countArgs = int(scalar(@_) / 2);
-	#print "Set ", join(', ',keys %args), "\n";
-	LOOP_PACKS: while(@packages) {
-		my $package = shift @packages;
-		#print "\t$package\n";
-		my $refProps = PropertyList($package);
-		foreach my $name (keys %{$refProps}) {
-			my $fld = $refProps->{$name}; 
-			if (exists $args{$name}) {
-				$this->{$fld} = $args{$name};
-				#print "\t$countArgs, $name\n";
-				delete $args{$name};
-				$countArgs --;
-				last LOOP_PACKS if $countArgs < 1;
-			} else {
-				#print "\t-$name ($fld)\n";
-			}
-		}
-		push @packages, @{$package.'::ISA'};
-	}
-}
-
-sub Dispose {
-	my $this = shift;
-	
-	if ($Debug and UNIVERSAL::isa($this,'HASH')) {
-		my @keys = grep { $this->{$_} and ref $this->{$_} } keys %{$this};
-		warn "not all fields of the object were deleted\n".join("\n",@keys) if @keys;
-	}
-	
-	bless $this,'Object::Disposed';
-}
-
-our $MemoryLeakProtection;
-
-sub DESTROY {
-	if ($MemoryLeakProtection) {
-		my $this = shift;
-		warn sprintf("Object leaks: %s of type %s %s",$this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : '');
-	}
-}
-
-package Object::Disposed;
-our $AUTOLOAD;
-sub AUTOLOAD {
-	return if $AUTOLOAD eq __PACKAGE__.'::DESTROY';
-	die new Exception('Object have been disposed',$AUTOLOAD);
-}
-
-END {
-	$MemoryLeakProtection = 0 if not $Debug;
-}
-1;
\ No newline at end of file
+package Common;
+use strict;
+no strict 'refs';
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(&ACCESS_NONE &ACCESS_READ &ACCESS_WRITE &ACCESS_ALL &DeclareProperty &DumpCaller &PropertyList &CloneObject);
+
+our $Debug;
+
+$Debug = 1 if not defined $Debug;
+
+my %ListProperties;
+my %GlobalContext;
+
+1;
+
+sub ACCESS_NONE () { 0 }
+sub ACCESS_READ () { 1 }
+sub ACCESS_WRITE () { 2 }
+sub ACCESS_ALL () {ACCESS_READ | ACCESS_WRITE}
+
+sub PropertyList {
+	return $ListProperties{ref($_[0]) || $_[0] || caller} || {};
+}
+
+sub DeclareProperty {
+	my ($attrName,$accessRights,%Mutators) = @_;
+	
+	my $Package = caller;
+	my $Method = $Package.'::'.$attrName;
+	my $fldName;
+	
+	my $getMutator = $Mutators{'get'};
+	my $setMutator = $Mutators{'set'};
+	
+	($fldName = $Method) =~ s/:+/_/g;
+	
+	$ListProperties{$Package} = {} if not exists $ListProperties{$Package};
+	$ListProperties{$Package}->{$attrName} = $fldName;
+	
+	if ($Debug) {
+		*$Method = sub {
+			my $this = shift;
+			
+			die new Exception( 'too many args ['.scalar(@_).'\]' , "'$Method' called from: ".DumpCaller() ) if (@_ > 1);
+			
+			my $Rights = $accessRights;
+			$Rights = ACCESS_ALL if $Package eq caller;
+			
+			if (@_){
+				die new Exception("access denied 'write $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_WRITE;
+				if (defined $setMutator) {
+					&$setMutator($this,$fldName,shift);
+				} else {
+					$this->{$fldName} = $_[0];
+				}
+				
+			} elsif (defined wantarray) {
+				die new Exception("access denied 'read $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_READ;
+				if (defined $getMutator) {
+					&$getMutator($this,$fldName);
+				} else {
+					if (wantarray){
+						if(ref $this->{$fldName} eq 'ARRAY' ) {
+							return @{$this->{$fldName}};
+						} elsif (not exists $this->{$fldName}) {
+							return;
+						} else {
+							return $this->{$fldName};
+						}
+					} else {
+						return $this->{$fldName};
+					}
+				}
+			} else {
+				undef;
+			}
+		};
+		*$Method = \$fldName;
+	} else {
+		*$Method = sub {
+			my $this = shift;
+			#return undef if @_ > 1;
+			#my $Rights = $accessRights;
+			#$Rights = ACCESS_ALL if $Package eq caller;
+			
+			if (@_){
+			#	return undef if not $Rights & ACCESS_WRITE;
+				if (defined $setMutator) {
+					&$setMutator($this,$fldName,shift);
+				} else {
+					$this->{$fldName} = shift;
+				}
+			} elsif (defined wantarray) {
+			#	return undef if not $Rights & ACCESS_READ;
+				if (defined $getMutator) {
+					&$getMutator($this,$fldName);
+				} else {
+					if (wantarray){
+						if(ref $this->{$fldName} eq 'ARRAY' ) {
+							return @{$this->{$fldName}};
+						} elsif (not defined $this->{$fldName}) {
+							return;
+						} else {
+							return $this->{$fldName};
+						}
+					} else {
+						return $this->{$fldName};
+					}
+				}
+			} else {
+				undef;
+			}
+		};
+		*$Method = \$fldName;
+	}
+}
+
+sub DumpCaller {
+	return join(" ",(caller($_[0]))[1,2],(caller($_[0]+1))[3]);
+}
+
+sub Owner {
+	return undef if not tied $_[0];
+	return undef if not tied($_[0])->UNIVERSAL::can('owner');
+	return tied($_[0])->owner();
+};
+
+sub CloneObject {
+	my $object = shift;
+	if (ref $object == undef) {
+		return $object;
+	} elsif (ref $object eq 'SCALAR') {
+		return \CloneObject(${$object});
+	} elsif (ref $object eq 'ARRAY') {
+		return [map{CloneObject($_)}@{$object}];
+	} elsif (ref $object eq 'HASH') {
+		my %clone;
+		while (my ($key,$value) = each %{$object}) {
+			$clone{$key} = CloneObject($value);
+		}
+		return \%clone;
+	} elsif (ref $object eq 'REF') {
+		return \CloneObject(${$object});
+	} else {
+		if ($object->can('Clone')) {
+			return $object->Clone();
+		} else {
+			die new Exception('Object doesn\'t supports cloning');
+		}
+	}
+}
+
+package Exception;
+use base qw(IMPL::Exception);
+
+package Persistent;
+import Common;
+
+sub newSurogate {
+	my $class = ref($_[0]) || $_[0];
+	return bless {}, $class;
+}
+sub load {
+	my ($this,$context) = @_;
+	die new Exception("invalid deserialization context") if ref($context) ne 'ARRAY';
+	die new Exception("This is not an object") if not ref $this;
+	
+	my %Props = (@{$context});
+	foreach my $BaseClass(@{ref($this).'::ISA'}) {
+		while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
+			$this->{$value} = $Props{$value} if exists $Props{$value};
+		}
+	}
+	
+	while (my ($key,$value) = each %{PropertyList(ref($this))}) {
+		$this->{$value} = $Props{$key} if exists $Props{$key};
+	}
+	return 1;
+}
+sub save {
+	my ($this,$context) = @_;
+	
+	foreach my $BaseClass(@{ref($this).'::ISA'}) {
+		while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
+			$context->AddVar($value,$this->{$value});
+		}
+	}
+	
+	while (my ($key,$value) = each %{PropertyList(ref($this))}) {
+		$context->AddVar($key,$this->{$value});
+	}
+	return 1;
+}
+
+sub restore {
+    my ($class,$context,$surogate) = @_;
+    my $this = $surogate || $class->newNewSurogate;
+    $this->load($context);
+    return $this;
+}
+
+package Object;
+import Common;
+
+sub new {
+  my $class = shift;
+  my $self = bless {}, ref($class) || $class;
+  $self->CTOR(@_);
+  return $self;
+}
+
+sub cast {
+  return bless {}, ref $_[0] || $_[0];
+}
+
+our %objects_count;
+our %leaked_objects;
+
+sub CTOR {
+	my $this= shift;
+	$objects_count{ref $this} ++ if $Debug;
+	my %args = @_ if scalar (@_) > 0;
+	return if scalar(@_) == 0;
+	
+	warn "invalid args in CTOR. type: ".(ref $this) if scalar(@_) % 2 != 0;
+	my @packages = (ref($this));
+	my $countArgs = int(scalar(@_) / 2);
+	#print "Set ", join(', ',keys %args), "\n";
+	LOOP_PACKS: while(@packages) {
+		my $package = shift @packages;
+		#print "\t$package\n";
+		my $refProps = PropertyList($package);
+		foreach my $name (keys %{$refProps}) {
+			my $fld = $refProps->{$name}; 
+			if (exists $args{$name}) {
+				$this->{$fld} = $args{$name};
+				#print "\t$countArgs, $name\n";
+				delete $args{$name};
+				$countArgs --;
+				last LOOP_PACKS if $countArgs < 1;
+			} else {
+				#print "\t-$name ($fld)\n";
+			}
+		}
+		push @packages, @{$package.'::ISA'};
+	}
+}
+
+sub Dispose {
+	my $this = shift;
+	
+	if ($Debug and UNIVERSAL::isa($this,'HASH')) {
+		my @keys = grep { $this->{$_} and ref $this->{$_} } keys %{$this};
+		warn "not all fields of the object were deleted\n".join("\n",@keys) if @keys;
+	}
+	
+	bless $this,'Object::Disposed';
+}
+
+our $MemoryLeakProtection;
+
+sub DESTROY {
+	if ($MemoryLeakProtection) {
+		my $this = shift;
+		warn sprintf("Object leaks: %s of type %s %s",$this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : '');
+	}
+}
+
+package Object::Disposed;
+our $AUTOLOAD;
+sub AUTOLOAD {
+	return if $AUTOLOAD eq __PACKAGE__.'::DESTROY';
+	die new Exception('Object have been disposed',$AUTOLOAD);
+}
+
+END {
+	$MemoryLeakProtection = 0 if not $Debug;
+}
+1;