# HG changeset patch
# User Sergey
# Date 1247823046 -14400
# Node ID 3b418b134d8ceb038c719d2d2661dfa2f0585e9d
# Parent  03e58a454b208a22e4b4ca287c68fd43942a03d3
ORM in progress

diff -r 03e58a454b20 -r 3b418b134d8c Lib/IMPL/DOM/Node.pm
--- a/Lib/IMPL/DOM/Node.pm	Tue Jul 14 12:54:37 2009 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Fri Jul 17 13:30:46 2009 +0400
@@ -8,6 +8,8 @@
 use IMPL::Class::Property::Direct;
 use Scalar::Util qw(weaken);
 
+use IMPL::Exception;
+
 __PACKAGE__->PassThroughArgs;
 
 BEGIN {
@@ -20,8 +22,9 @@
 }
 
 sub CTOR {
-    my $this = @_;
+    my ($this,$name) = @_;
     
+    $this->nodeName($name) or die new IMPL::InvalidArgumentException("A name is required");
     $this->_propertyMap({});
 }
 
diff -r 03e58a454b20 -r 3b418b134d8c Lib/IMPL/Object/Abstract.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/Abstract.pm	Fri Jul 17 13:30:46 2009 +0400
@@ -0,0 +1,149 @@
+package IMPL::Object::Abstract;
+use strict;
+use warnings;
+package IMPL::Object;
+use strict;
+
+use base qw(IMPL::Class::Meta);
+
+our $MemoryLeakProtection;
+my $Cleanup = 0;
+our $Debug;
+our %leaked_objects;
+
+my %cacheCTOR;
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, ref($class) || $class;
+    
+    $self->$_(@_) foreach @{$cacheCTOR{ref $self} || cache_ctor(ref $self)};
+  
+    $self;
+}
+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 surrogate {
+    bless {}, ref $_[0] || $_[0];
+}
+
+sub superCTOR {
+    my $this = shift;
+
+    warn "The mehod is deprecated, at " . caller;
+}
+
+sub toString {
+    my $self = shift;
+    
+    return (ref $self || $self);
+}
+
+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;
+    $MemoryLeakProtection = 0 unless $Debug;
+}
+
+sub _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
+
+Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов
+создания экземпляров.
+
+
+1;
+
+
+1;
diff -r 03e58a454b20 -r 3b418b134d8c Lib/IMPL/Object/ArrayBased.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/ArrayBased.pm	Fri Jul 17 13:30:46 2009 +0400
@@ -0,0 +1,19 @@
+package IMPL::Object::ArrayBased;
+use strict;
+use warnings;
+
+use base qw(IMPL::Object);
+
+sub new {
+    my $class = shift;
+    my $self = bless [], ref $class || $class;
+    $self->callCTOR(@_);
+    return $self;
+}
+    
+sub surrogate {
+    return bless [], ref $_[0] || $_;
+}
+
+1;
+
diff -r 03e58a454b20 -r 3b418b134d8c impl.kpf
--- a/impl.kpf	Tue Jul 14 12:54:37 2009 +0400
+++ b/impl.kpf	Fri Jul 17 13:30:46 2009 +0400
@@ -1,6 +1,8 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <!-- Komodo Project File - DO NOT EDIT -->
 <project id="66c7d414-175f-45b6-92fe-dbda51c64843" kpf_version="4" name="impl.kpf">
+<file id="91cab186-0c9b-4ed6-98e8-3de5c132e296" idref="66c7d414-175f-45b6-92fe-dbda51c64843/Lib/IMPL/Object" name="Node.pm" url="Lib/IMPL/DOM/Node.pm">
+</file>
 <preference-set idref="155f1fd9-8a20-46fe-90d5-8fbe879632d8">
 <preference-set id="Invocations">
 <preference-set id="default">
@@ -107,6 +109,7 @@
 </preference-set>
 <preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843">
   <boolean id="import_live">1</boolean>
+  <string relative="path" id="perlExtraPaths">Lib</string>
 </preference-set>
 <preference-set idref="7e7fa5c6-0123-4570-8540-b1366b09b7dd">
 <preference-set id="Invocations">