# HG changeset patch
# User sourcer
# Date 1305176239 -14400
# Node ID 1f7a6d762394001be78dab21ccc1fe344cf4a52e
# Parent  4267a2ac3d46f3573ecf78bd24b6635d7595fced
SQL schema in progress

diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/Class/declare.pm
--- a/Lib/IMPL/Class/declare.pm	Sat Apr 23 23:12:06 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-package IMPL::Class::declare;
-use strict;
-use IMPL::_core::version;
-
-sub import {
-	my ($self,$meta) = @_;	
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-=head1 SYNOPSIS
-
-=begin code
-
-package Foo;
-use IMPL::Class::declare {
-	base => [qw(Bar)],
-	properties => [
-		id => { get => public, set => protected, type => 'uuid', verify => \&_checkId },
-		name => { get => public, set => public },
-		info => { static => 1 }
-	],
-	methods => [
-		store => \&_storeImpl
-		get => \&_getImpl
-	],
-	attributes => [
-		new ClassId('class-foo-1')
-	]
-};
-
-=end code
-
-=head1 DESCRIPTION
-
-=cut
\ No newline at end of file
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/Object/List.pm
--- a/Lib/IMPL/Object/List.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/Object/List.pm	Thu May 12 08:57:19 2011 +0400
@@ -42,6 +42,10 @@
     return scalar @{$_[0]};
 }
 
+sub Item {
+	return $_[0]->[$_[1]];
+}
+
 sub InsertAt {
     my ($this,$index,@val) = @_;
     
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema.pm
--- a/Lib/IMPL/SQL/Schema.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema.pm	Thu May 12 08:57:19 2011 +0400
@@ -2,7 +2,9 @@
 package IMPL::SQL::Schema;
 
 use IMPL::_core::version;
-use IMPL::lang;
+
+use IMPL::lang qw(is :declare :constants);
+
 use parent qw(
 	IMPL::Object
 	IMPL::Object::Disposable
@@ -10,7 +12,6 @@
 	IMPL::Object::Clonable
 );
 
-use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
 require IMPL::SQL::Schema::Table;
@@ -18,9 +19,9 @@
 __PACKAGE__->PassThroughArgs;
 
 BEGIN {
-    public _direct property version => prop_get;
-    public _direct property name => prop_get;
-    private _direct property tables => prop_get;
+    public _direct property version => PROP_GET;
+    public _direct property name => PROP_GET;
+    private _direct property tables => PROP_GET;
 }
 
 sub AddTable {
@@ -66,10 +67,6 @@
 	UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$tables}{$table};
 }
 
-sub Table {
-	goto &GetTable;
-}
-
 sub GetTable {
 	my ($this,$tableName) = @_;
 	return $this->{$tables}{$tableName};
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Column.pm
--- a/Lib/IMPL/SQL/Schema/Column.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Column.pm	Thu May 12 08:57:19 2011 +0400
@@ -2,15 +2,16 @@
 package IMPL::SQL::Schema::Column;
 use parent qw(IMPL::Object IMPL::Object::Autofill);
 
-use IMPL::Class::Property;
+use IMPL::lang qw( :DEFAULT :compare :declare :constants );
 use IMPL::Class::Property::Direct;
+use IMPL::Exception();
 
 BEGIN {
-    public _direct property name => prop_get;
-    public _direct property type => prop_get;
-    public _direct property isNullable => prop_get;
-    public _direct property defaultValue => prop_get;
-    public _direct property tag => prop_get;
+    public _direct property name => PROP_GET;
+    public _direct property type => PROP_GET;
+    public _direct property isNullable => PROP_GET;
+    public _direct property defaultValue => PROP_GET;
+    public _direct property tag => PROP_GET;
 }
 
 __PACKAGE__->PassThroughArgs;
@@ -18,43 +19,24 @@
 sub CTOR {
     my $this = shift;
     
-    $this->{$name} or die new IMPL::InvalidArgumentException('a column name is required');
-    $this->{$isNullable} = 0 if not exists $this->{$isNullable};
-    UNIVERSAL::isa($this->{$type},'IMPL::SQL::Schema::Type') or die new IMPL::InvalidArgumentException('a type is required for the column',$this->{$name});
-}
-
-sub isEqualsStr {
-    my ($a,$b) = @_;
+    $this->{$name} or
+    	die new IMPL::InvalidArgumentException('A column name is required');
     
-    if (defined $a and defined $b) {
-        return $a eq $b;
-    } else {
-        if (defined $a or defined $b) {
-            return 0;
-        } else {
-            return 1;
-        }
-    }
+    $this->{$isNullable} = 0 if not exists $this->{$isNullable};
+    
+    is( $this->{$type}, typeof IMPL::SQL::Schema::Type) or
+    	die new IMPL::InvalidArgumentException('a type is required for the column',$this->{$name});
 }
 
-sub isEquals {
-    my ($a,$b) = @_;
-    
-    if (defined $a and defined $b) {
-        return $a == $b;
-    } else {
-        if (defined $a or defined $b) {
-            return 0;
-        } else {
-            return 1;
-        }
-    }
-}
-
-sub isSame {
+sub SameValue {
     my ($this,$other) = @_;
     
-    return ($this->{$name} eq $other->{$name} and $this->{$isNullable} == $other->{$isNullable} and isEqualsStr($this->{$defaultValue}, $other->{$defaultValue}) and $this->{$type}->isSame($other->{$type}));
+    return (
+    	$this->{$name} eq $other->{$name}
+    	and $this->{$isNullable} == $other->{$isNullable}
+    	and equals_s($this->{$defaultValue}, $other->{$defaultValue})
+    	and $this->{$type}->SameValue($other->{$type})
+    );
 }
 
 1; 
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Constraint.pm
--- a/Lib/IMPL/SQL/Schema/Constraint.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint.pm	Thu May 12 08:57:19 2011 +0400
@@ -1,22 +1,27 @@
+package IMPL::SQL::Schema::Constraint;
 use strict;
-package IMPL::SQL::Schema::Constraint;
+use warnings;
+
+use IMPL::lang qw(:declare :constants is);
+
 use parent qw(IMPL::Object IMPL::Object::Disposable);
 
-use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public _direct property name => prop_get;
-    public _direct property table => prop_get;
-    public _direct property columns => prop_get;
+    public _direct property name => PROP_GET;
+    public _direct property table => PROP_GET;
 }
 
+public property columns => PROP_GET | PROP_LIST | PROP_OWNERSET;
+
 sub CTOR {
     my ($this,%args) = @_;
-    die new IMPL::InvalidArgumentException("The table argument must be an instance of a table object") if not UNIVERSAL::isa($args{'table'},'IMPL::SQL::Schema::Table');
+    is( $args{table}, typeof IMPL::SQL::Schema::Table ) or
+    	die new IMPL::InvalidArgumentException("table argument must be a table object");
     $this->{$name} = $args{'name'};
     $this->{$table} = $args{'table'};
-    $this->{$columns} = [map { ResolveColumn($this->table,$_) } @{$args{'columns'}}];
+    $this->columns( [map { ResolveColumn($this->table,$_) } @{$args{'columns'}}] );
 }
 
 sub ResolveColumn {
@@ -45,7 +50,22 @@
 sub Dispose {
     my ($this) = @_;
     
-    delete @$this{$table,$columns};
+    $this->columns([]);
+    
+    delete $$this{$table};
+    
     $this->SUPER::Dispose;
 }
+
+sub SameValue {
+	my ($this,$other) = @_;
+			
+	return 0 unless $this->columns->Count == $other->columns->Count;
+	
+	for ( my $i=0; $i < $this->columns->Count; $i++ ) {
+		return 0 unless $this->columns->[$i]->name eq $other->columns->[$i]->name;
+	}
+	
+	return 1;
+}
 1;
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm
--- a/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Thu May 12 08:57:19 2011 +0400
@@ -1,13 +1,17 @@
 package IMPL::SQL::Schema::Constraint::ForeignKey;
 use strict;
+use warnings;
+
+use IMPL::lang qw(:declare :constants is);
+
 use parent qw(IMPL::SQL::Schema::Constraint);
-use IMPL::Class::Property;
+
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public _direct property referencedPrimaryKey => prop_get;
-    public _direct property OnDelete => prop_get;
-    public _direct property OnUpdate => prop_get;
+    public _direct property referencedPrimaryKey => PROP_GET;
+    public _direct property OnDelete => PROP_GET;
+    public _direct property OnUpdate => PROP_GET;
 }
 
 __PACKAGE__->PassThroughArgs;
@@ -25,10 +29,10 @@
     scalar (@ReferencedColumns) == scalar(@{$this->columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns');
     my @ColumnsCopy = @ReferencedColumns;
     
-    die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->isSame((shift @ColumnsCopy)->type)} @{$this->columns};
+    die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->SameValue((shift @ColumnsCopy)->type)} @{$this->columns};
     
     @ColumnsCopy = @ReferencedColumns;
-    die new Exception('The foreign key must match to the primary key of the referenced table',$this->name) if grep { not $_->type->isSame(shift(@ColumnsCopy)->type)} @{$ForeingPK->columns};
+    die new Exception('The foreign key must match to the primary key of the referenced table',$this->name) if grep { not $_->type->SameValue(shift(@ColumnsCopy)->type)} @{$ForeingPK->columns};
     
     $this->{$referencedPrimaryKey} = $ForeingPK;
     
@@ -44,13 +48,13 @@
     $this->SUPER::Dispose;
 }
 
-sub isSame {
+sub SameValue {
     my ($this,$other) = @_;
     
     uc $this->OnDelete eq uc $other->OnDelete or return 0;
     uc $this->OnUpdate eq uc $other->OnUpdate or return 0;
     
-    return $this->SUPER::isSame($other);
+    return $this->SUPER::SameValue($other);
 }
 
 
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Table.pm
--- a/Lib/IMPL/SQL/Schema/Table.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Table.pm	Thu May 12 08:57:19 2011 +0400
@@ -1,29 +1,28 @@
 use strict;
 package IMPL::SQL::Schema::Table;
 
-use IMPL::lang;
+use IMPL::lang qw(:declare :constants is);
 
 use parent qw(
 	IMPL::Object
 	IMPL::Object::Disposable
 );
 
-use IMPL::SQL::Schema::Column();
-use IMPL::SQL::Schema::Constraint();
-use IMPL::SQL::Schema::Constraint::PrimaryKey();
-use IMPL::SQL::Schema::Constraint::ForeignKey();
+require IMPL::SQL::Schema::Column;
+require IMPL::SQL::Schema::Constraint;
+require IMPL::SQL::Schema::Constraint::PrimaryKey;
+require IMPL::SQL::Schema::Constraint::ForeignKey;
 
-use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public _direct property name => prop_get;
-    public _direct property schema => prop_get;
-    public _direct property columns => prop_get;
-    public _direct property constraints => prop_get;
-    public _direct property columnsByName => prop_none;
-    public _direct property primaryKey => prop_get;
-    public _direct property tag => prop_all;
+    public _direct property name => PROP_GET;
+    public _direct property schema => PROP_GET;
+    public _direct property columns => PROP_GET;
+    public _direct property constraints => PROP_GET;
+    public _direct property columnsByName => 0;
+    public _direct property primaryKey => PROP_GET;
+    public _direct property tag => PROP_ALL;
 }
 
 sub CTOR {
@@ -101,13 +100,13 @@
     }
 }
 
-sub Column {
+sub GetColumn {
     my ($this,$name) = @_;
     
     return $this->{$columnsByName}->{$name};
 }
 
-sub ColumnAt {
+sub GetColumnAt {
     my ($this,$index) = @_;
     
     die new IMPL::InvalidArgumentException("The index is out of range")
@@ -167,6 +166,12 @@
 	return $this->{$constraints}{$name};
 }
 
+sub GetConstraints {
+	my ($this) = @_;
+	
+	return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}];
+}
+
 sub GetColumnConstraints {
     my ($this,@Columns) = @_;
     
@@ -186,7 +191,7 @@
     my ($this,$table,@ColumnList) = @_;
     $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key');
     my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList);
-    $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns));
+    $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => scalar $table->primaryKey->columns));
 }
 
 sub Dispose {
@@ -198,6 +203,31 @@
     $this->SUPER::Dispose();
 }
 
+sub SameValue {
+	my ($this,$other) = @_;
+	
+	return 0 unless is $other, typeof $this;
+	
+	return 0 unless $this->name eq $other->name;
+	return 0 unless $this->ColumnsCount eq $other->ColumnsCount;
+	
+	for (my $i = 0; $i < $this->ColumsCount; $i ++) {
+		return 0 unless $this->($i)->SameValue($other->GetColumnAt($i));
+	}
+	
+	my %thisConstraints = map { $_->name, $_ } $this->GetConstraints();
+	my %otherConstraints = map { $_->name, $_ } $other->GetConstraints();
+	
+	foreach my $name ( keys %thisConstraints ) {
+		return 0 unless $otherConstraints{$name};
+		return 0 unless $thisConstraints{$name}->SameValue(delete $otherConstraints{$name});
+	}
+	
+	return 0 if %otherConstraints;
+	
+	return 1;
+}
+
 1;
 
 
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Traits.pm
--- a/Lib/IMPL/SQL/Schema/Traits.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Traits.pm	Thu May 12 08:57:19 2011 +0400
@@ -58,19 +58,17 @@
 
 package IMPL::SQL::Schema::Traits::Constraint;
 use base qw(IMPL::Object::Fields);
-
+ 
 use fields qw(
 	name
-	tableName
 	columns
 );
 
 sub CTOR {
-	my ($this, $name, $tableName, $columns) = @_;
+	my ($this, $name, $columns) = @_;
 	
 	$this->{name} = $name;
-	$this->{tableName} = $tableName;
-	$$this->{columns} = $columns;
+	$$this->{columns} = $columns; # list of columnNames
 }
 
 ##################################################
@@ -108,11 +106,11 @@
 );
 
 our %CTOR = (
-	'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..2] }
+	'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] }
 );
 
 sub CTOR {
-	my ($this,$foreignTable,$foreignColumns) = @_[0,4,5];
+	my ($this,$foreignTable,$foreignColumns) = @_[0,3,4];
 	
 	$this->{foreignTable} = $foreignTable;
 	$this->{foreignColunms} = $foreignColumns;
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Traits/Diff.pm
--- a/Lib/IMPL/SQL/Schema/Traits/Diff.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Traits/Diff.pm	Thu May 12 08:57:19 2011 +0400
@@ -24,12 +24,110 @@
 		my $dstTable = delete $dstTables{$srcTable->name};
 		
 		if (not $dstTable) {
+			# if a source table doesn't have a corresponding destination table, it should be deleted
 			push @operations, new IMPL::SQL::Schema::Traits::DropTable()
 		} else {
-			
+			# a source table needs to be updated
+			push @operations, $self->_DiffTables($srcTable,$dstTable);
+		}
+		
+		foreach my $tbl ( values %dstTables ) {
+			push @operations, new IMPL::SQL::Schema::Traits::CreateTable(
+				new IMPL::SQL::Schema::Traits::Table(
+					$tbl->name,
+					[ map _Column2Traits($_), $tbl->columns ],
+					[ map _Constraint2Traits($_), $tbl->constraints],
+					$tbl->{tag}
+				)
+			)
 		}
 	
 	}  
 }
 
+sub _DiffTables {
+	my ($self,$src,$dst) = @_;
+	
+	my @dropConstraints;
+	my @createConstraints;
+	
+	my %srcConstraints = map { $_->name, $_ } $src->GetConstraints();
+	my %dstConstraints = map { $_->name, $_ } $dst->GetConstraints();
+	
+	foreach my $cnSrcName (keys %srcConstraints) {
+		if ( my $cnDst = delete $dstConstraints{$cnSrcName} ) {
+			unless ( $srcConstraints{$cnSrcName}->SameValue($cnDst) ) {
+				push @dropConstraints,
+					IMPL::SQL::Schema::Traits::AlterTableDropConstraint->new( $src->name, $cnSrcName );
+				push @createConstraints,
+					IMPL::SQL::Schema::Traits::AlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
+			}
+		} else {
+			push @dropConstraints, IMPL::SQL::Schema::Traits::AlterTableDropConstrait->new( $src->name, $cnSrcName );
+		}
+	}
+	
+	foreach my $cnDst (values %dstConstraints) {
+		push @createConstraints,
+		IMPL::SQL::Schema::Traits::AlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
+	}
+	
+	my @deleteColumns;
+	my @addColumns;
+	my @updateColumns;
+	
+	my %dstColumnIndexes = map {
+		my $col = $dst->GetColumnAt($_);
+		($col->name, { column => $col, index => $_ })
+	} 0 .. $dst->ColumnsCount-1;
+	
+	# get changed and
+	
+	my @columns;
+	
+	for( my $i=0; $i < $src->ColumnsCount; $i++) {
+		my $colSrc = $src->GetColumnAt($i);
+		
+		if ( my $infoDst = delete $dstColumnIndexes{$colSrc->name} ) {
+			$infoDst->{update} = 1 unless $infoDst->{column}->SameValue($colSrc);
+			push @columns,$infoDst;
+		} else {
+			push @deleteColumns, IMPL::SQL::Schema::Traits::AlterTableDropColumn($src->name,$colSrc->name);
+		}
+	}
+	
+	splice(@columns,$_->{index},0,$_) foreach ( sort { $a->{index} <=> $b->{index} } values %dstColumnIndexes );
+	
+	for(my $i =0; $i< @columns; $i ++) {
+		
+	}
+	
+	# determine constraints to be dropped,
+	# drop columns
+	# create columns
+	# update/reorder columns
+	# create constraints
+}
+
+sub _Column2Traits {
+	my ($column) = @_;
+	
+	return new IMPL::SQL::Schema::Traits::Columns(
+		$column->name,
+		$column->type,
+		$column->isNullable,
+		$column->defaultValue,
+		$column->tag
+	);
+}
+
+sub _Constraint2Traits {
+	my ($constraint) = @_;
+	
+	return new IMPL::SQL::Schema::Traits::Constraint(
+		$constraint->name,
+		[ map $_->name, $_->columns ]
+	)
+}
+
 1;
\ No newline at end of file
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/SQL/Schema/Type.pm
--- a/Lib/IMPL/SQL/Schema/Type.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Type.pm	Thu May 12 08:57:19 2011 +0400
@@ -1,16 +1,20 @@
 use strict;
+use warnings;
 package IMPL::SQL::Schema::Type;
+
 use parent qw(IMPL::Object IMPL::Object::Autofill);
-use IMPL::Class::Property;
+
+use IMPL::lang qw( :declare :constants :compare );
+
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public _direct property name => prop_get;
-    public _direct property maxLength => prop_get;
-    public _direct property scale => prop_get;
-    public _direct property unsigned => prop_get;
-    public _direct property zerofill => prop_get;
-    public _direct property tag => prop_get;
+    public _direct property name => PROP_GET;
+    public _direct property maxLength => PROP_GET;
+    public _direct property scale => PROP_GET;
+    public _direct property unsigned => PROP_GET;
+    public _direct property zerofill => PROP_GET;
+    public _direct property tag => PROP_GET;
 }
 
 __PACKAGE__->PassThroughArgs;
@@ -21,24 +25,14 @@
     $this->{$scale} = 0 if not $this->{$scale};
 }
 
-sub isEquals {
-    my ($a,$b) = @_;
-    
-    if (defined $a and defined $b) {
-        return $a == $b;
-    } else {
-        if (defined $a or defined $b) {
-            return 0;
-        } else {
-            return 1;
-        }
-    }
-}
-
-sub isSame {
+sub SameValue {
     my ($this,$other) = @_;
     
-    return ($this->{$name} eq $other->{$name} and isEquals($this->{$maxLength},$other->{$maxLength}) and isEquals($this->{$scale},$other->{$scale}));
+    return (
+    	$this->{$name} eq $other->name
+    	and equals($this->{$maxLength},$other->{$maxLength})
+    	and equals($this->{$scale},$other->{$scale})
+    );
 }
 
 1;
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/Web/DOM/FileNode.pm
--- a/Lib/IMPL/Web/DOM/FileNode.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/Web/DOM/FileNode.pm	Thu May 12 08:57:19 2011 +0400
@@ -1,5 +1,5 @@
 package IMPL::Web::DOM::FileNode;
-use IMPL::base qw(IMPL::DOM::Node);
+use parent qw(IMPL::DOM::Node);
 
 __PACKAGE__->PassThroughArgs;
 
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/lang.pm
--- a/Lib/IMPL/lang.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/lang.pm	Thu May 12 08:57:19 2011 +0400
@@ -5,11 +5,128 @@
 use parent qw(Exporter);
 use IMPL::_core::version;
 
+require IMPL::Class::PropertyInfo;
 
-our @EXPORT = qw(&is);
+our @EXPORT      = qw(&is);
+our %EXPORT_TAGS = (
+	base => [
+		qw(
+		  &is
+		  )
+	],
+	constants => [
+		qw(
+		  &ACCESS_PUBLIC
+		  &ACCESS_PROTECTED
+		  &ACCESS_PRIVATE
+		  &PROP_GET
+		  &PROP_SET
+		  &PROP_OWNERSET
+		  &PROP_LIST
+		  &PROP_ALL
+		  )
+	],
+
+	declare => [
+		qw(
+		  &public
+		  &protected
+		  &private
+		  &virtual
+		  &property
+		  &static
+		  &property
+		  )
+	],
+	compare => [
+		qw(
+		  &equals
+		  &equals_s
+		  )
+	]
+);
+
+our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };
+
+use constant {
+	ACCESS_PUBLIC    => 1,
+	ACCESS_PROTECTED => 2,
+	ACCESS_PRIVATE   => 3,
+	PROP_GET         => 1,
+	PROP_SET         => 2,
+	PROP_OWNERSET    => 10,
+	PROP_LIST        => 4,
+	PROP_ALL         => 3
+};
 
 sub is($$) {
-	eval { $_[0]->isa($_[1]) }
+	eval { $_[0]->isa( $_[1] ) };
+}
+
+sub virtual($) {
+	$_[0]->Virtual(1);
+	$_[0];
+}
+
+sub public($) {
+	$_[0]->Access(ACCESS_PUBLIC);
+	$_[0]->Implement;
+	$_[0];
+}
+
+sub private($) {
+	$_[0]->Access(ACCESS_PRIVATE);
+	$_[0]->Implement;
+	$_[0];
+}
+
+sub protected($) {
+	$_[0]->Access(ACCESS_PROTECTED);
+	$_[0]->Implement;
+	$_[0];
 }
 
-1;
\ No newline at end of file
+sub property($$;$) {
+	my ( $propName, $mutators, $attributes ) = @_;
+	my $Info = new IMPL::Class::PropertyInfo(
+		{
+			Name       => $propName,
+			Mutators   => $mutators,
+			Class      => scalar(caller),
+			Attributes => $attributes
+		}
+	);
+	return $Info;
+}
+
+sub static($$) {
+	my ( $name, $value ) = @_;
+	my $class = caller;
+	$class->static_accessor( $name, $value );
+}
+
+sub equals {
+	if (defined $_[0]) {
+		return 0 if (not defined $_[1]);
+		
+		return $_[0] == $_[1];
+	}  else {
+		return 0 if defined $_[1];
+		
+		return 1;
+	}
+}
+
+sub equals_s {
+	if (defined $_[0]) {
+		return 0 if (not defined $_[1]);
+		
+		return $_[0] eq $_[1];
+	}  else {
+		return 0 if defined $_[1];
+		
+		return 1;
+	}
+}
+
+1;
diff -r 4267a2ac3d46 -r 1f7a6d762394 Lib/IMPL/template.pm
--- a/Lib/IMPL/template.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/template.pm	Thu May 12 08:57:19 2011 +0400
@@ -10,7 +10,7 @@
 	
 	my $class = caller;
 	
-	my @paramNames = grep /\w+/, @{$args{parameters} || []}; 
+	my @paramNames = grep m/\w+/, @{$args{parameters} || []}; 
 	my $declare = $args{declare};
 	my @isa = (@{$args{base} || []}, $class);
 	my %instances;
@@ -91,7 +91,7 @@
 		my ($class) = @_;
 		my $item_t = spec KeyValuePair($class->TKey,$class->TValue);
 		
-		public $class->CreateProperty(items => prop_get | prop_list, { type => $item_t } )
+		public $class->CreateProperty(items => prop_get | prop_list, { type => $item_t } );
 		
 		$class->static_accessor( ItemType => $item_t );
 	}
diff -r 4267a2ac3d46 -r 1f7a6d762394 _test/Test/SQL/Traits.pm
--- a/_test/Test/SQL/Traits.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/_test/Test/SQL/Traits.pm	Thu May 12 08:57:19 2011 +0400
@@ -48,7 +48,7 @@
 	my $column = $table->Column('id') or failed "Column not found";
 	
 	assert( $column->name eq 'id');
-	assert( $column->type->isSame(Integer()) );
+	assert( $column->type->SameValue(Integer()) );
 	assert( not $column->isNullable );
 	assert( $column->tag->{auto_increment} );
 	
@@ -62,7 +62,7 @@
 	
 	assert($column);
 	assert($column->name eq 'name');
-	assert($column->type->isSame(Varchar(255)));
+	assert($column->type->SameValue(Varchar(255)));
 	assert($column->isNullable);
 };
 
@@ -82,7 +82,7 @@
 	assert( $table->ColumnsCount == 3 );
 	
 	assert( my $column = $table->Column('id') );
-	assert($column->type->isSame(Varchar(64)));
+	assert($column->type->SameValue(Varchar(64)));
 	assert(not $column->isNullable);
 	
 	assert( $column = $table->Column('role') );
diff -r 4267a2ac3d46 -r 1f7a6d762394 _test/temp.pl
--- a/_test/temp.pl	Sat Apr 23 23:12:06 2011 +0400
+++ b/_test/temp.pl	Thu May 12 08:57:19 2011 +0400
@@ -1,6 +1,44 @@
 #!/usr/bin/perl
 use strict;
+use Time::HiRes qw(gettimeofday tv_interval);
 
-use DateTime::TimeZone;
+sub func {
+	1;
+}
+
+my $t0 = [gettimeofday()];
+
+for(my $i = 0; $i < 1000000; $i++) {
+	func(1);
+}
+
+print tv_interval($t0),"\n";
+
+my $fn = sub { 1; };
+
+$t0 = [gettimeofday()];
+
+for(my $i = 0; $i < 1000000; $i++) {
+	&$fn(1);
+}
 
-print "$_\n" foreach DateTime::TimeZone->names_in_category('America');
\ No newline at end of file
+print tv_interval($t0),"\n";
+
+sub dummy() { 0; }
+
+$t0 = [gettimeofday()];
+
+for(my $i = 0; $i < 1000000; $i++) {
+	dummy;
+}
+
+print tv_interval($t0),"\n";
+
+$t0 = [gettimeofday()];
+
+for(my $i = 0; $i < 1000000; $i++) {
+	1;
+}
+
+print tv_interval($t0),"\n";
+