Mercurial > pub > Impl
comparison Lib/IMPL/SQL/Schema/Traits/mysql.pm @ 44:32d2350fccf9
ORM
*Minor fixes
*Working tarnsform to sql
*Fixes to the sql traits
| author | Sergey |
|---|---|
| date | Mon, 11 Jan 2010 01:42:00 +0300 |
| parents | 56cef8e3cda6 |
| children | 16ada169ca75 |
comparison
equal
deleted
inserted
replaced
| 43:009aa9ca2e48 | 44:32d2350fccf9 |
|---|---|
| 3 use base qw(IMPL::Object); | 3 use base qw(IMPL::Object); |
| 4 use IMPL::Class::Property; | 4 use IMPL::Class::Property; |
| 5 use IMPL::Class::Property::Direct; | 5 use IMPL::Class::Property::Direct; |
| 6 | 6 |
| 7 BEGIN { | 7 BEGIN { |
| 8 public _direct property SqlBatch => prop_none; | 8 public _direct property SqlBatch => prop_all; |
| 9 } | 9 } |
| 10 | 10 |
| 11 sub formatTypeNameInteger { | 11 sub formatTypeNameInteger { |
| 12 my ($type) = @_; | 12 my ($type) = @_; |
| 13 | 13 |
| 233 my ($table,$level,%options) = @_; | 233 my ($table,$level,%options) = @_; |
| 234 | 234 |
| 235 my @sql; | 235 my @sql; |
| 236 | 236 |
| 237 # table body | 237 # table body |
| 238 push @sql, map { formatColumn($_,$level+1) } $table->Columns ; | 238 push @sql, map { formatColumn($_,$level+1) } @{$table->Columns} ; |
| 239 if ($options{'skip_foreign_keys'}) { | 239 if ($options{'skip_foreign_keys'}) { |
| 240 push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints}; | 240 push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints}; |
| 241 } else { | 241 } else { |
| 242 push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints}; | 242 push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints}; |
| 243 } | 243 } |
| 301 | 301 |
| 302 sub formatIndex { | 302 sub formatIndex { |
| 303 my ($constraint,$level) = @_; | 303 my ($constraint,$level) = @_; |
| 304 | 304 |
| 305 my $name = quote_names($constraint->Name); | 305 my $name = quote_names($constraint->Name); |
| 306 my $columns = join(',',map quote_names($_->Name),$constraint->Columns); | 306 my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); |
| 307 | 307 |
| 308 if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { | 308 if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { |
| 309 return "\t"x$level."PRIMARY KEY ($columns)"; | 309 return "\t"x$level."PRIMARY KEY ($columns)"; |
| 310 } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') { | 310 } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') { |
| 311 return "\t"x$level."UNIQUE $name ($columns)"; | 311 return "\t"x$level."UNIQUE $name ($columns)"; |
| 319 | 319 |
| 320 sub formatForeignKey { | 320 sub formatForeignKey { |
| 321 my ($constraint,$level) = @_; | 321 my ($constraint,$level) = @_; |
| 322 | 322 |
| 323 my $name = quote_names($constraint->Name); | 323 my $name = quote_names($constraint->Name); |
| 324 my $columns = join(',',map quote_names($_->Name),$constraint->Columns); | 324 my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); |
| 325 | 325 |
| 326 not $constraint->OnDelete or grep { uc $constraint->OnDelete eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON DELETE reference',$constraint->OnDelete); | 326 not $constraint->OnDelete or grep { uc $constraint->OnDelete eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON DELETE reference',$constraint->OnDelete); |
| 327 not $constraint->OnUpdate or grep { uc $constraint->OnUpdate eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON UPDATE reference',$constraint->OnUpdate); | 327 not $constraint->OnUpdate or grep { uc $constraint->OnUpdate eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON UPDATE reference',$constraint->OnUpdate); |
| 328 | 328 |
| 329 my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name); | 329 my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name); |
| 330 my $refcolumns = join(',',map quote_names($_->Name),$constraint->ReferencedPrimaryKey->Columns); | 330 my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns}); |
| 331 return ( | 331 return ( |
| 332 "\t"x$level. | 332 "\t"x$level. |
| 333 "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)". | 333 "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)". |
| 334 ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : ''). | 334 ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : ''). |
| 335 ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '') | 335 ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '') |
| 459 } | 459 } |
| 460 | 460 |
| 461 sub Sql { | 461 sub Sql { |
| 462 my ($this) = @_; | 462 my ($this) = @_; |
| 463 if (wantarray) { | 463 if (wantarray) { |
| 464 $this->SqlBatch; | 464 @{$this->SqlBatch || []}; |
| 465 } else { | 465 } else { |
| 466 return join("\n",$this->SqlBatch); | 466 return join("\n",$this->SqlBatch); |
| 467 } | 467 } |
| 468 } | 468 } |
| 469 | 469 |
| 475 | 475 |
| 476 BEGIN { | 476 BEGIN { |
| 477 public _direct property PendingConstraints => prop_none; | 477 public _direct property PendingConstraints => prop_none; |
| 478 } | 478 } |
| 479 | 479 |
| 480 sub CTOR { | 480 our %CTOR = ( |
| 481 my ($this,%args) = @_; | 481 'IMPL::SQL::Schema::Traits' => sub { |
| 482 | 482 my %args = @_; |
| 483 $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler; | 483 $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler; |
| 484 $this->SUPER::CTOR(%args); | 484 %args; |
| 485 } | 485 } |
| 486 ); | |
| 486 | 487 |
| 487 sub DropConstraint { | 488 sub DropConstraint { |
| 488 my ($this,$constraint) = @_; | 489 my ($this,$constraint) = @_; |
| 489 | 490 |
| 490 if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) { | 491 if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) { |
