Mercurial > pub > Impl
changeset 167:1f7a6d762394
SQL schema in progress
author | sourcer |
---|---|
date | Thu, 12 May 2011 08:57:19 +0400 |
parents | 4267a2ac3d46 |
children | 6148f89bb7bf |
files | Lib/IMPL/Class/declare.pm Lib/IMPL/Object/List.pm Lib/IMPL/SQL/Schema.pm Lib/IMPL/SQL/Schema/Column.pm Lib/IMPL/SQL/Schema/Constraint.pm Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm Lib/IMPL/SQL/Schema/Table.pm Lib/IMPL/SQL/Schema/Traits.pm Lib/IMPL/SQL/Schema/Traits/Diff.pm Lib/IMPL/SQL/Schema/Type.pm Lib/IMPL/Web/DOM/FileNode.pm Lib/IMPL/lang.pm Lib/IMPL/template.pm _test/Test/SQL/Traits.pm _test/temp.pl |
diffstat | 15 files changed, 403 insertions(+), 163 deletions(-) [+] |
line wrap: on
line diff
--- 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
--- 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) = @_;
--- 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};
--- 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;
--- 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;
--- 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); }
--- 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;
--- 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;
--- 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
--- 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;
--- 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;
--- 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;
--- 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 ); }
--- 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') );
--- 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"; +