Alzabo-0.92/0000755000175000017500000000000010721343231012510 5ustar autarchautarchAlzabo-0.92/t/0000755000175000017500000000000010721343227012760 5ustar autarchautarchAlzabo-0.92/t/05a-rules-mysql.t0000444000175000017500000001061110721343227016022 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create; unless ( eval { require DBD::mysql } && ! $@ ) { plan skip_all => 'needs DBD::mysql'; exit; } plan tests => 26; my $new_schema; eval_ok( sub { $new_schema = Alzabo::Create::Schema->new( name => 'hello there', rdbms => 'MySQL' ) }, "Make a new MySQL schema named 'hello there'" ); { eval { Alzabo::Create::Schema->new( name => 'hello:there', rdbms => 'MySQL' ); }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exceptiont thrown from attempt to create a MySQL schema named 'hello:there'" ); } { eval { $new_schema->make_table( name => 'x' x 65 ) }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown from attempt to create a table in MySQL with a 65 character name" ); } my $table; { $table = $new_schema->make_table( name => 'quux' ); $table->make_column( name => 'foo', type => 'int', attributes => [ 'unsigned' ], null => 1, ); my $sql = join '', $new_schema->rules->table_sql($table); like( $sql, qr/int(?:eger)\s+unsigned/i, "Unsigned attribute should come right after type" ); } { eval { $table->make_column( name => 'foo2', type => 'text', length => 1, ); }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown from attempt to make 'text' column with a length parameter" ); } { eval { $table->make_column( name => 'var_no_len', type => 'varchar' ) }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown from attempt to make 'varchar' column with no length parameter" ); } { foreach my $type ( qw( DATE DATETIME TIMESTAMP ) ) { my $col = $table->make_column( name => "col_$type", type => $type, ); ok( $col->is_date, "$type is date" ); }; } { foreach my $type ( qw( DATETIME TIMESTAMP ) ) { my $col = $table->make_column( name => "col2_$type", type => $type, ); ok( $col->is_datetime, "$type is date" ); }; } { foreach my $type ( qw( DECIMAL NUMERIC FLOAT DOUBLE REAL ) ) { my $col = $table->make_column( name => "col2_$type", type => $type, ); ok( $col->is_numeric, "$type is numeric" ); ok( $col->is_floating_point, "$type is floating point" ); }; } { my $col = $table->make_column( name => 'int1', type => 'integer', default => 27, ); is( $new_schema->rules->_default_for_column($col), 27, 'default is 27' ); } { my $col = $table->make_column( name => 'vc1', type => 'varchar', length => 20, default => 'hello', ); is( $new_schema->rules->_default_for_column($col), q|"hello"|, 'default is "hello" (with quotes)' ); } { my $col = $table->make_column( name => 'dt1', type => 'datetime', default => 'NOW()', default_is_raw => 1, ); is( $new_schema->rules->_default_for_column($col), q|NOW()|, 'default is NOW()' ); } { my $col = eval { $table->make_column( name => 'vb1', type => 'varbinary', ) }; like( $@, qr/must have a length/, 'length is required for (var)binary' ); } { my $col = $table->make_column( name => 'vb2', type => 'varbinary', length => 10, ); is( $col->length, 10, 'column length is 10' ); } Alzabo-0.92/t/18-debug-null-bug.t0000444000175000017500000000267410721343227016213 0ustar autarchautarch#!/usr/bin/perl -w # # There was a bug which occurred when SQL debugging was on, which # caused bound parameters that were explicitly set to undef to be # converted to the string 'NULL'. # use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); BEGIN { $ENV{ALZABO_DEBUG} = 'SQL' } use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } plan tests => 2; Alzabo::Test::Utils->remove_all_schemas; # doesn't matter which RDBMS is used my $rdbms = $rdbms_names[0]; Alzabo::Test::Utils->make_schema($rdbms); my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); $s->connect( Alzabo::Test::Utils->connect_params_for($rdbms) ); Test::More::diag( 'This test will produce a lot of debugging output. Please ignore it' ); my $dep = $s->table('department')->insert( values => { name => 'department' } ); my $emp; eval_ok ( sub { $emp = $s->table('employee')->insert ( values => { name => 'Bubba', cash => undef, dep_id => $dep->select('department_id'), } ) }, 'insert with explicit cash => undef while debugging is on' ); is( $emp->select('cash'), undef, 'cash is undef' ); Alzabo-0.92/t/19-schema-name.t0000444000175000017500000000303410721343227015550 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } my $tests_per_run = 4; my $test_count = $tests_per_run * @rdbms_names; plan tests => $test_count; Alzabo::Test::Utils->remove_all_schemas; foreach my $rdbms (@rdbms_names) { my $s = Alzabo::Test::Utils->make_schema( $rdbms, 1 ); my $name = $s->name . '_2'; my $config = Alzabo::Test::Utils->test_config_for($rdbms); $config->{schema_name} = $name; delete $config->{rdbms}; eval_ok( sub { $s->create(%$config) }, "call create() for $rdbms with name parameter" ); my %schemas = ( map { $_ => 1 } $s->driver->schemas( Alzabo::Test::Utils->connect_params_for($rdbms) ) ); ok( $schemas{$name}, "schema with new name ($name) was created for $rdbms" ); my $t = $s->make_table( name => 'just_a_table' ); $t->make_column( name => 'jat_pk', type => 'integer', primary_key => 1, ); my $sql = join "\n", $s->sync_backend_sql(%$config); like( $sql, qr/CREATE TABLE[\s"'`]+just_a_table/i, "create new table in sync SQL for $rdbms" ); unlike( $sql, qr/CREATE TABLE.+CREATE_TABLE/is, "do not create other new tables in sync SQL for $rdbms" ); } Alzabo::Test::Utils->remove_all_schemas; Alzabo-0.92/t/04-rev-engineer.t0000444000175000017500000000250110721343227015750 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } my $tests_per_run = 2; plan tests => $tests_per_run * @rdbms_names; Alzabo::Test::Utils->remove_all_schemas; foreach my $rdbms (@rdbms_names) { Test::More::diag( "Running $rdbms reverse engineering tests" ); my $s1 = Alzabo::Test::Utils->make_schema($rdbms); my $config = Alzabo::Test::Utils->test_config_for($rdbms); delete $config->{schema_name}; $config->{name} = $s1->name; $config->{rdbms} = $s1->driver->driver_id; my $s2; eval_ok( sub { $s2 = Alzabo::Create::Schema->reverse_engineer(%$config) }, "Reverse engineer the @{[$s1->name]} schema with @{[$s1->driver->driver_id]}" ); if ( ref $s2 ) { my @diff = $s1->rules->schema_sql_diff( old => $s1, new => $s2 ); my $sql = join "\n", @diff; is ( $sql, '', "Reverse engineered schema's SQL should be the same as the original's" ); $s1->delete; } else { ok( 0, "Reverse engineering failed, cannot do diff" ); } } Alzabo-0.92/t/98-schema-diff.t0000444000175000017500000001061110721343227015546 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } my $tests_per_run = 11; my $mysql_tests = 2; my $pg_tests = 2; my $tests = $tests_per_run * @rdbms_names; $tests += $mysql_tests if grep { $_ eq 'mysql' } @rdbms_names; $tests += $pg_tests if grep { $_ eq 'pg' } @rdbms_names; plan tests => $tests; Alzabo::Test::Utils->remove_all_schemas; foreach my $rdbms (@rdbms_names) { my $s = Alzabo::Test::Utils->make_schema($rdbms); my %connect = Alzabo::Test::Utils->connect_params_for($rdbms); $s->table('employee')->delete_column( $s->table('employee')->column('name') ); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with one column deleted" ); $s->table('department')->make_column( name => 'foo', type => 'int', nullable => 1 ); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with one column added" ); $s->delete_table( $s->table('department') ); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with one table deleted" ); $s->make_table( name => 'cruft' ); $s->table('cruft')->make_column( name => 'cruft_id', type => 'int', primary_key => 1, ); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with one table added" ); my $idx = ($s->table('project')->indexes)[0]; $s->table('project')->delete_index($idx); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with one index deleted" ); $s->table('cruft')->make_column( name => 'cruftiness', type => 'int', nullable => 1, default => 10 ); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with one column (null and with a default) added" ); $s->driver->handle->do( 'INSERT INTO cruft (cruft_id, cruftiness) VALUES (1, 2)' ); $s->driver->handle->do( 'INSERT INTO cruft (cruft_id, cruftiness) VALUES (2, 4)' ); my $float_type = $rdbms eq 'pg' ? 'float8' : 'float'; $s->table('cruft')->column('cruftiness')->set_type($float_type); $s->table('cruft')->set_name('new_cruft'); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with a table name change and column type change" ); my ($val) = $s->driver->handle->selectrow_array( 'SELECT cruftiness FROM new_cruft WHERE cruft_id = 2' ); is( $val, 4, "Data should be preserved across table name change" ); $s->table('new_cruft')->column('cruft_id')->set_name('new_cruft_id'); eval_ok( sub { $s->create(%connect) }, "Create schema (via diff) with a column name change" ); ($val) = $s->driver->handle->selectrow_array( 'SELECT cruftiness FROM new_cruft WHERE new_cruft_id = 2' ); is( $val, 4, "Data should be preserved across column name change" ); { # Test table rename followed by drop column my $table = $s->table('employee'); $table->set_name('new_emp_table'); $table->delete_column( $table->column('smell') ); my $sql = join "\n", $s->make_sql; if ( $rdbms eq 'mysql' ) { like( $sql, qr/RENAME TABLE\s+employee\s+TO\s+new_emp_table/i, 'SQL should include rename to new table name' ); like( $sql, qr/ALTER TABLE\s+new_emp_table/i, 'ALTER TABLE should refer to new table name' ); } elsif ( $rdbms eq 'pg' ) { like( $sql, qr/DROP TABLE\s+"employee"/i, 'SQL should include dropping table with old name' ); like( $sql, qr/CREATE TABLE\s+"new_emp_table"/i, 'SQL should include creation of table with new name' ); } } { # will instantiate with renamed table from above block $s->create(%connect); # a bug (which should be fixed) caused bogus SQL to be # generated when comparing this schema to a live DB with the # rename already done. my $sql = join "\n", $s->sync_backend_sql(%connect); $sql ||= ''; is( $sql, '', 'No SQL should be generated when syncing to a backend after instantiating' . ' with a renamed table' ); } } Alzabo-0.92/t/09-storable.t0000444000175000017500000000431710721343227015211 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } plan tests => 9; Alzabo::Test::Utils->remove_all_schemas; # doesn't matter which RDBMS is used my $rdbms = $rdbms_names[0]; Alzabo::Test::Utils->make_schema($rdbms); my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); $s->connect( Alzabo::Test::Utils->connect_params_for($rdbms) ); { my $emp_t = $s->table('employee'); $s->table('department')->insert( values => { department_id => 1, name => 'borging' } ); $emp_t->insert( values => { employee_id => 98765, name => 'bob98765', smell => 'bb', dep_id => 1 } ); my $ser; eval_ok( sub { my $row = $emp_t->row_by_pk( pk => 98765 ); $ser = Storable::freeze($row) }, "Freeze employee" ); my $eid; eval_ok( sub { my $row = Storable::thaw($ser); $eid = $row->select('employee_id') }, "Thaw employee" ); is( $eid, 98765, "Employee survived freeze & thaw" ); eval_ok( sub { my $row = $emp_t->row_by_pk( pk => 98765 ); $ser = Storable::nfreeze($row) }, "NFreeze employee" ); my $smell; eval_ok( sub { my $row = Storable::thaw($ser); $smell = $row->select('smell') }, "Thaw employee" ); is( $smell, 'bb', "Employee survived nfreeze & thaw" ); eval_ok( sub { my $p_row = $emp_t->potential_row( values => { name => 'Alice' } ); $ser = Storable::freeze($p_row) }, "Freeze potential employee" ); my $name; eval_ok( sub { my $p_row = Storable::thaw($ser); $name = $p_row->select('name') }, "Thaw potential employee" ); is( $name, 'Alice', "Potential employee survived freeze & thaw" ); } Alzabo-0.92/t/02-create.t0000444000175000017500000006443410721343227014640 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create; use Alzabo::Config; my @db; my $tests = 0; my $shared_tests = 150; my $mysql_only_tests = 7; my $pg_only_tests = 8; if ( eval { require DBD::mysql } && ! $@ ) { push @db, 'MySQL'; $tests += $shared_tests; $tests += $mysql_only_tests; } if ( eval { require DBD::Pg } && ! $@ ) { push @db, 'PostgreSQL'; $tests += $shared_tests; $tests += $pg_only_tests; } unless ($tests) { plan skip_all => 'no database drivers available'; exit; } plan tests => $tests; foreach my $db (@db) { my $s = Alzabo::Create::Schema->new( name => "foo_$db", rdbms => $db, ); ok( $s && ref $s, "Create a schema object" ); ok( $s->name eq "foo_$db", "Make sure schema name is " . $s->name ); isa_ok( $s->rules,"Alzabo::RDBMSRules::$db", "Schema's rules object" ); isa_ok( $s->driver,"Alzabo::Driver::$db", "Schema's driver object" ); my $dir = Alzabo::Config->schema_dir; { eval_ok( sub { $s->save_to_file }, "Call schema's save_to_file method" ); my $base = File::Spec->catdir( $dir, $s->name ); my $name = $s->name; ok( -d $base, "'$base' should exist" ); ok( -e "$base/$name.create.alz", "'$base/$name.create.alz' file should exist" ); ok( -e "$base/$name.runtime.alz", "'$base/$name.runtime.alz' file should exist" ); ok( -e "$base/$name.rdbms", "'$base/$name.rdbms' file should exist" ); } eval_ok( sub { $s->make_table( name => 'footab' ) } , "Make table 'footab'" ); my $t1; eval_ok( sub { $t1 = $s->table('footab') }, "Retrieve 'footab' table from schema" ); isa_ok( $t1, 'Alzabo::Create::Table', "Object returned from \$s->table" ); my $att = $db eq 'MySQL' ? 'unsigned' : 'check > 5'; eval_ok( sub { $t1->make_column( name => 'foo_pk', type => 'int', attributes => [ $att ], sequenced => 1, nullable => 0, ) }, "Make column 'foo_pk' in 'footab'" ); eval { $s->tables( 'footab', 'does not exist' ) }; like( $@, qr/Table does not exist doesn't exist/, "Make sure tables method catches missing tables" ); eval { $s->table( 'does not exist' ) }; isa_ok( $@, 'Alzabo::Exception::Params', "Make sure table() method catches missing tables" ); eval { $t1->columns( 'foo_pk', 'does not exist' ) }; like( $@, qr/Column does not exist doesn't exist/, "Make sure columns method catches missing columns" ); my $t1_c1; eval_ok( sub { $t1_c1 = $t1->column('foo_pk') }, "Retrieve 'foo_pk' from 'footab'" ); isa_ok( $t1_c1, 'Alzabo::Create::Column', "Object returned from \$table->column" ); is( $t1_c1->type, 'INTEGER', "foo_pk type should be 'INTEGER'" ); is( scalar @{[$t1_c1->attributes]}, 1, "foo_pk should have one attribute" ); is( ($t1_c1->attributes)[0], $att, "foo_pk's attribute should be $att" ); ok( $t1_c1->has_attribute( attribute => uc $att ), "foo_pk should have attribute '\U$att\E' (case-insensitive check)" ); ok( ! $t1_c1->has_attribute( attribute => uc $att, case_sensitive => 1 ), "foo_pk should _not_ have attribute '\U$att\E' (case-sensitive check)" ); ok( ! $t1_c1->nullable, "foo_pk should not be nullable" ); eval_ok( sub { $t1->add_primary_key($t1_c1) }, "Make 'foo_pk' a primary key for 'footab'" ); ok( $t1_c1->is_primary_key, "'foo_pk' should be a primary key" ); eval_ok( sub { $s->make_table( name => 'bartab' ) }, "Make table 'bartab'" ); my $t2; eval_ok( sub { $t2 = $s->table('bartab') }, "Retrieve table 'bartab'" ); isa_ok( $t2, 'Alzabo::Create::Table', "'bartab'" ); eval_ok( sub { $t2->make_column( name => 'bar_pk', type => 'int', default => 10, sequenced => 1, nullable => 0, ) }, "Add 'bar_pk' to 'bartab'" ); my $t2_c1; eval_ok( sub { $t2_c1 = $t2->column('bar_pk') }, "Retrieve 'bar_pk' from 'bartab'" ); isa_ok( $t2_c1, 'Alzabo::Create::Column', "'bar_pk'" ); is( $t2_c1->default, '10', "bar_pk default should be '10'" ); eval_ok( sub { $t2->add_primary_key($t2_c1) }, "Make 'bar_pk' a primary key for 'bartab'" ); eval_ok( sub { $s->add_relationship( table_from => $t1, table_to => $t2, cardinality => ['n', 'n'], from_is_dependent => 0, to_is_dependent => 0, ) }, "Add many to many relationship from 'footab' to 'bartab'" ); my $link; eval_ok( sub { $link = $s->table('footab_bartab') }, "Retrieve linking table 'footab_bartab'" ); isa_ok( $link, 'Alzabo::Create::Table', "'footab_bartab'" ); my @t1_fk; eval_ok( sub { @t1_fk = $t1->foreign_keys( table => $link, column => $t1_c1 ) }, "Retrieve foreign keys to linking table from 'footab'" ); is( scalar @t1_fk, 1, "One and only one foreign key returned from 'footab'" ); my $t1_fk = $t1_fk[0]; isa_ok( $t1_fk, 'Alzabo::Create::ForeignKey', "Return value from footab->foreign_keys" ); is( $t1_fk->columns_from->name, 'foo_pk', "The foreign key from footab to the footab_bartab table's columns_from value should be 'foo_pk'" ); is( $t1_fk->columns_from->table->name, 'footab', "The foreign key columns_from for the footab table should belong to the footab table" ); is( $t1_fk->columns_to->name, 'foo_pk', "The foreign key from footab to the footab_bartab table's columns_to value should be 'foo_pk'" ); is( $t1_fk->columns_to->table->name, 'footab_bartab', "The foreign key columns_to for the footab table should belong to the footab_bartab table" ); is( $t1_fk->table_from->name, 'footab', "The table_from for the foreign key should be footab" ); is( $t1_fk->table_to->name, 'footab_bartab', "The table_to for the foreign key should be footab_bartab" ); my @t2_fk; eval_ok( sub { @t2_fk = $t2->foreign_keys( table => $link, column => $t2_c1 ) }, "Retrieve foreign keys from 'bartab' to linking table" ); is( scalar @t2_fk, 1, "Only one foreign key should be returned from 'bartab'" ); my $t2_fk = $t2_fk[0]; isa_ok( $t2_fk, 'Alzabo::Create::ForeignKey', "Return value from bartab->foreign_keys" ); is( $t2_fk->columns_from->name, 'bar_pk', "The foreign key from bartab to the table's columns_from value should be 'bar_pk'" ); is( $t2_fk->columns_from->table->name, 'bartab', "The foreign key columns_from for the bartab table should belong to the bartab table" ); is( $t2_fk->columns_to->name, 'bar_pk', "The foreign key from bartab to the linking table's columns_to value should be 'bar_pk'" ); is( $t2_fk->columns_to->table->name, 'footab_bartab', "The foreign key columns_to for the bartab table should belong to the footab_bartab table" ); is( $t2_fk->table_from->name, 'bartab', "The table_from for the foreign key should be bartab" ); is( $t2_fk->table_to->name, 'footab_bartab', "The table_to for the foreign key should be footab_bartab" ); my @link_fk; eval_ok( sub { @link_fk = $link->foreign_keys( table => $t1, column => $link->column('foo_pk') ) }, "Retrieve foreign keys from 'footab_bartab' to 'footab'" ); is( scalar @link_fk, 1, "Only one foreign key should be returned from 'footab_bartab'" ); my $link_fk = $link_fk[0]; is( $link_fk->columns_from->name, 'foo_pk', "The foreign key from footab_bartab to the table's columns_from value should be 'foo_pk'" ); is( $link_fk->columns_from->table->name, 'footab_bartab', "The foreign key columns_from for the footab_bartab table should belong to the footab_bartab table" ); is( $link_fk->columns_to->name, 'foo_pk', "The foreign key from footab_bartab to the linking table's columns_to value should be 'foo_pk'" ); is( $link_fk->columns_to->table->name, 'footab', "The foreign key columns_to for the footab_bartab table should belong to the footab table" ); is( $link_fk->table_from->name, 'footab_bartab', "The table_from for the foreign key should be footab_bartab" ); is( $link_fk->table_to->name, 'footab', "The table_to for the foreign key should be footab" ); eval_ok( sub { @link_fk = $link->foreign_keys( table => $t2, column => $link->column('bar_pk') ) }, "Retrieve foreign keys from 'footab_bartab' to 'bartab'" ); $link_fk = $link_fk[0]; is( $link_fk[0]->columns_from->name, 'bar_pk', "The foreign key from footab_bartab to the table's columns_from value should be 'bar_pk'" ); is( $link_fk[0]->columns_from->table->name, 'footab_bartab', "The foreign key columns_from for the footab_bartab table should belong to the footab_bartab table" ); is( $link_fk[0]->columns_to->name, 'bar_pk', "The foreign key from footab_bartab to the linking table's columns_to value should be 'bar_pk'" ); is( $link_fk[0]->columns_to->table->name, 'bartab', "The foreign key columns_to for the footab_bartab table should belong to the bartab table" ); is( $link_fk[0]->table_from->name, 'footab_bartab', "The table_from for the foreign key should be footab_bartab" ); is( $link_fk[0]->table_to->name, 'bartab', "The table_to for the foreign key should be bartab" ); eval_ok( sub { $s->add_relationship( table_from => $t1, table_to => $t2, cardinality => [ 'n', 1 ], from_is_dependent => 0, to_is_dependent => 0, ) }, "Create a many to one relation from 'footab' to 'bartab'" ); my $new_col; eval_ok( sub { $new_col = $t1->column('bar_pk') }, "Retrieve the newly create 'bar_pk' column from 'footab'" ); is( $new_col->definition, $t2->column('bar_pk')->definition, "bar_pk columns in footab and bartab should share the same definition object" ); my @fk; eval { @fk = $t1->foreign_keys( table => $t2, column => $new_col ); }; ok( @fk, "footab should have a foreign key to bartab from bar_pk" ); ok( @fk, "footab should only have one foreign key to bartab from bar_pk" ); eval { @fk = $t2->foreign_keys( table => $t1, column => $t2->column('bar_pk') ); }; ok( @fk, "bartab should have a foreign key to footab from bar_pk" ); ok( @fk, "bartab should only have one foreign key to footab from bar_pk" ); eval_ok( sub { $s->add_relationship( table_from => $t1, table_to => $t2, cardinality => [ 1, 'n' ], from_is_dependent => 0, to_is_dependent => 0, ) }, "Create a second relation (this time one to many) from footab to bartab" ); eval_ok( sub { $new_col = $t2->column('foo_pk') }, "Retrieve the newly created foo_pk column from bartab" ); is( $new_col->definition, $t1->column('foo_pk')->definition, "foo_pk columns in footab and bartab should share the same definition object" ); eval { @fk = $t2->foreign_keys( table => $t1, column => $new_col ); }; ok( @fk, "bartab should have a foreign key to bartab from foo_pk" ); ok( @fk, "bartab should only have one foreign key to bartab from foo_pk" ); eval { @fk = $t1->foreign_keys( table => $t2, column => $t1->column('foo_pk') ); }; ok( @fk, "footab should have a foreign key to bartab from foo_pk" ); ok( @fk, "footab should only have one foreign key to bartab from foo_pk" ); $s->make_table( name => 'baztab' ); my $t3 = $s->table('baztab'); eval_ok( sub { $s->add_relationship( table_from => $t1, table_to => $t3, cardinality => [ 1, 'n' ], from_is_dependent => 0, to_is_dependent => 0, ) }, "Add one to many relation from footab to baztab" ); eval_ok( sub { $new_col = $t3->column('foo_pk') }, "Retrieve the foo_pk column from baztab" ); is( $new_col->definition, $t1->column('foo_pk')->definition, "foo_pk columns in footab and baztab should share the same definition object" ); eval { @fk = $t3->foreign_keys( table => $t1, column => $new_col ); }; ok( @fk, "baztab should have a foreign key to footab from foo_pk" ); is( scalar @fk, 1, "baztab should only have one foreign key to footab from foo_ok" ); eval { @fk = $t1->foreign_keys( table => $t3, column => $t1->column('foo_pk') ); }; ok( @fk, "footab should have foreign key to baztab from foo_pk" ); is( scalar @fk, 1, "footab should only have one foreign key to baztab from foo_ok" ); eval_ok( sub { $s->delete_table($link) }, "Delete foo_tab from schema" ); @fk = $t1->all_foreign_keys; is( scalar @fk, 3, "footab table should have 3 foreign key after deleting footab_bartab table" ); @fk = $t2->all_foreign_keys; is( scalar @fk, 2, "bartab table should have 2 foreign keys after deleting footab_bartab" ); $s->delete_table($t1); @fk = $t3->all_foreign_keys; is( scalar @fk, 0, "baztab table should have 0 foreign keys after deleting footab table" ); ok( ! exists $t2->{fk}{footab}, "The \$t2 object's internal {fk} hash should not have a {footab} entry" ); my $tc = $s->make_table( name => 'two_col_pk' ); $tc->make_column( name => 'pk1', type => 'int', primary_key => 1 ); eval_ok( sub { $tc->make_column( name => 'pk2', type => 'int', primary_key => 1 ) }, "Add a second primary column to two_col_pk" ); my @pk = $tc->primary_key; is( scalar @pk, 2, "two_col_pk has two primary keys" ); is( $pk[0]->name, 'pk1', "First primary column should be pk1" ); is( $pk[1]->name, 'pk2', "Second primary column should be pk2" ); $tc->make_column( name => 'non_pk', type => 'varchar', length => 2 ); my $other = $s->make_table( name => 'other' ); $other->make_column( name => 'other_pk', type => 'int', primary_key => 1 ); $other->make_column( name => 'somethin', type => 'text' ); eval_ok( sub { $s->add_relationship( table_from => $tc, table_to => $other, cardinality => [ 1, 'n' ], from_is_dependent => 0, to_is_dependent => 0, ) }, "Add a one to many relationship from two_col_pk to other" ); my @cols; eval_ok( sub { @cols = $other->columns( 'pk1', 'pk2' ) }, "Retrieve pk1 and pk2 column objects from other" ); my $fk; eval_ok( sub { $fk = $other->foreign_keys( table => $tc, column => $tc->column('pk1') ) }, "Retrieve the foreign from other to two_col_pk" ); @cols = $fk->columns_from; is( scalar @cols, 2, "Foreign key object columns_from should return two objects" ); is( $cols[0]->name, 'pk1', "The first column object should be pk1" ); is( $cols[1]->name, 'pk2', "The second column object should be pk2" ); is( $cols[0]->table->name, 'other', "The first column should belong to the other table" ); is( $cols[1]->table->name, 'other', "The second column should belong to the other table" ); @cols = $fk->columns_to; is( scalar @cols, 2, "Foreign key object columns_to should return two objects" ); is( $cols[0]->name, 'pk1', "The first column object should be pk1" ); is( $cols[1]->name, 'pk2', "The second column object should be pk2" ); is( $cols[0]->table->name, 'two_col_pk', "The first column should belong to the two_col_pk table" ); is( $cols[1]->table->name, 'two_col_pk', "The second column should belong to the two_col_pk table" ); my @pairs = $fk->column_pairs; is( scalar @pairs, 2, "column_pairs method should return a two value array" ); is( $pairs[0]->[0]->table->name, 'other', "\$pairs[0]->[0] should belong to other" ); is( $pairs[0]->[0]->name, 'pk1', "\$pairs[0]->[0] should be pk1" ); is( $pairs[0]->[1]->table->name, 'two_col_pk', "\$pairs[0]->[1] should belong to two_col_pk" ); is( $pairs[0]->[1]->name, 'pk1', "\$pairs[0]->[1] should be pk1" ); is( $pairs[1]->[0]->table->name, 'other', "\$pairs[1]->[0] should belong to other" ); is( $pairs[1]->[0]->name, 'pk2', "\$pairs[1]->[0] should be pk2" ); is( $pairs[1]->[1]->table->name, 'two_col_pk', "\$pairs[1]->[1] should belong to two_col_pk" ); is( $pairs[1]->[1]->name, 'pk2', "\$pairs[1]->[1] should be pk2" ); my $tbi = $t1->make_column( name => 'tbi', type => 'int', nullable => 0 ); my $index; eval_ok( sub { $index = $t1->make_index( columns => [ { column => $tbi } ] ) }, "Make an index on tbi column in footab" ); eval_ok( sub { $t1->set_name('newt1') }, "Change footab's name to newt1" ); eval{ $t1->set_name('bartab') }; like( $@, qr/Table bartab already exists/, "Make sure two tables cannot have the same name" ); my $index2; eval_ok( sub { $index2 = $t1->index($index->id) }, "Retrieve index object from table based on \$index->id" ); is( $index, $index2, "The index retrieved from newt1 should be the same as the one made earlier"); $t1->column('foo_pk')->alter( type => 'varchar', length => 20 ); if ($db eq 'MySQL') { ok( ! $t1->column('foo_pk')->attributes, "The unsigned attribute should not have survived the change from 'int' to 'varchar'" ); } if ($db eq 'MySQL') { eval { $t1->column('foo_pk')->set_type('text') }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown from attempt to set a primary key column to the 'text' type" ); } if ($db eq 'PostgreSQL') { eval { $t1->column('tbi')->set_attributes('unique') }; ok( ! $@, "Postgres should allow a column to have a UNIQUE attribute" ); } $tbi->alter( type => 'varchar', length => 20 ); $tbi->set_type('text'); ok( ! defined $tbi->length, "Length should be undef after switching column type from 'varchar' to 'text'" ); $tbi->alter( type => 'varchar', length => 20 ); $tbi->set_type('char'); ok( $tbi->length, "Length should remain defined after switching column type from 'varchar' to 'char'" ); is( $tbi->length, 20, "Length should remain set to 20 after switching column type from 'varchar' to 'char'" ); eval_ok( sub { my @t = $s->tables( qw( bartab baztab ) ) }, "Retrieving two tables via the schema's tables method" ); eval_ok( sub { $s->move_table( table => $other, before => $s->table('bartab') ) }, "Move other table before bartab" ); my @t = $s->tables; my $order_ok = 0; for (my $x = 0; $x < @t; $x++) { if ($t[$x]->name eq 'other') { $order_ok = 1 if $t[$x+1] && $t[$x+1]->name eq 'bartab'; last; } } ok( $order_ok, "The move_table method should actually move the tables" ); eval_ok( sub { $other->move_column( column => $other->column('somethin'), before => $other->column('other_pk') ) }, "Move a column in the other table" ); my @c = $other->columns; $order_ok = 0; for (my $x = 0; $x < @c; $x++) { if ($c[$x]->name eq 'somethin') { $order_ok = 1 if $c[$x+1] && $c[$x+1]->name eq 'other_pk'; last; } } ok( $order_ok, "The move_column method should actually move the columns" ); eval_ok( sub { $tbi->set_name('newname') }, "Set tbi column name to newname" ); eval{ $tbi->set_name('foo_pk') }; like( $@, qr/Column foo_pk already exists/, "Make sure two column cannot have the same name" ); eval_ok( sub { $s->make_table( name => 'YAtable', before => scalar $s->table('other') ) }, "Call the make_table method on the schema with a before parameter" ); eval_ok( sub { $other->make_column( name => 'othertest', type => 'int', before => scalar $other->column('other_pk') ) }, "Call the make_column method with a before parameter" ); eval { $other->make_column( name => 'bad name', type => 'int' ) }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown making a column with a bad name" ); ok( $other->column('othertest')->is_numeric, "Should return true from is_numeric" ); ok( $other->column('othertest')->is_integer, "Should return true from is_integer" ); is( $other->column('othertest')->generic_type, 'integer', "Should return 'integer' from generic_type" ); eval_ok( sub { $s->add_relationship( columns_from => [ $tc->primary_key ], columns_to => [ $other->primary_key ], cardinality => [ 'n', 'n' ], from_is_dependent => 0, to_is_dependent => 0, ) }, "Add a many to many relationship without specifying tables" ); { my $s2 = Alzabo::Create::Schema->new( name => "foo_$db", rdbms => $db, ); my $t1 = $s2->make_table( name => 't1' ); my $t2 = $s2->make_table( name => 't2' ); my $t3 = $s2->make_table( name => 't3' ); $t1->make_column( name => 't1_pk', type => 'integer', primary_key => 1 ); $t2->make_column( name => 't2_pk', type => 'integer', primary_key => 1 ); $t3->make_column( name => 't3_pk', type => 'integer', primary_key => 1 ); $s2->add_relationship( table_from => $t1, table_to => $t2, cardinality => [ 'n', '1' ], from_is_dependent => 0, to_is_dependent => 0, ); $s2->add_relationship( table_from => $t3, table_to => $t2, cardinality => [ 'n', '1' ], from_is_dependent => 0, to_is_dependent => 0, ); $t1->delete_column( $t1->column('t2_pk') ); my @fk = $t2->all_foreign_keys; is( scalar @fk, 1, "t2 should still have one foreign key" ); } # test for bug when creating a relationship between two tables, # where one table has a VARCHAR/CHAR PK. bug caused length of # created column to be undef. { my $s2 = Alzabo::Create::Schema->new( name => "foo_$db", rdbms => $db, ); my $t1 = $s2->make_table( name => 't1' ); my $t2 = $s2->make_table( name => 't2' ); my $t3 = $s2->make_table( name => 't3' ); $t1->make_column( name => 't1_pk', type => 'varchar', length => 50, primary_key => 1 ); $t2->make_column( name => 't2_pk', type => 'integer', primary_key => 1 ); eval_ok( sub { $s2->add_relationship( table_from => $t1, table_to => $t2, cardinality => [ '1', 'n' ], from_is_dependent => 0, to_is_dependent => 0, ) }, 'Add a relationship between two columns where one has a VARCHAR pk', ); ok( $t2->column('t1_pk'), 't2 now has a column called t1_pk' ); } { my $t = $s->make_table( name => 'no_pk_table' ); $t->make_column( name => 'not_a_pk', type => 'integer', ); eval_ok( sub { my $pk = $t->primary_key }, "Calling primary_key on a table without a primary key should not fail" ); my @pk = $t->primary_key; is( scalar @pk, 0, "Return val from primary_key on a table without a primary key should be an empty list" ); } { my $t1 = $s->make_table( name => 'fk_table1' ); my $t2 = $s->make_table( name => 'fk_table2' ); $t1->make_column( name => 'fk_table1_pk', type => 'int', primary_key => 1, ); $t2->make_column( name => 'fk_table2_pk', type => 'int', primary_key => 1, ); $t2->make_column( name => 'fk_table1_pk', type => 'int', ); eval { $s->add_relationship( table_from => $t1, table_to => $t2, cardinality => [ '1', 'n' ], from_is_dependent => 0, to_is_dependent => 1, ) }; ok( ! $@, "call add_relationship where column in table_to already exists" ); } if ( $db eq 'MySQL' ) { $t1->set_attributes( 'TYPE = INNODB' ); my @att = $t1->attributes; is( @att, 1, 't1 has 1 attribute' ); is( $att[0], 'TYPE = INNODB', 'attribute is "TYPE = INNODB"' ); my $att_t = $s->make_table( name => 'has_attributes', attributes => [ 'TYPE = INNODB', 'PACK_KEYS = 1 ' ], ); @att = $att_t->attributes; is( @att, 2, 't1 has 2 attributes' ); is( $att[0], 'TYPE = INNODB', 'first attribute is "TYPE = INNODB"' ); is( $att[1], 'PACK_KEYS = 1', 'second attribute is "PACK_KEYS = 1"' ); } else { $t1->set_attributes( 'WITH OIDS' ); my @att = $t1->attributes; is( @att, 1, 't1 has 1 attribute' ); is( $att[0], 'WITH OIDS', 'attribute is "WITH OIDS"' ); my $att_t = $s->make_table( name => 'has_attributes', attributes => [ 'WITH OIDS', 'INHERITS footab' ], ); @att = $att_t->attributes; is( @att, 2, 't1 has 2 attributes' ); is( $att[0], 'WITH OIDS', 'first attribute is "WITH OIDS"' ); is( $att[1], 'INHERITS footab', 'second attribute is "INHERITS footab"' ); my $i; eval_ok( sub { $i = $tc->make_index( columns => [ $tc->column('non_pk') ], function => 'LOWER(non_pk)', ) }, "make a function index" ); is( $i->function, 'LOWER(non_pk)', "index function is LOWER(non_pk)" ); } } Alzabo-0.92/t/01-compile.t0000444000175000017500000000124310721343227015011 0ustar autarchautarch#!/usr/bin/perl -w use strict; use Test::More tests => 1; # This is just to test whether this stuff compiles. use Alzabo::Config; use Alzabo::ChangeTracker; use Alzabo; use Alzabo::Create; use Alzabo::Runtime; use Alzabo::Runtime::UniqueRowCache; use Alzabo::SQLMaker; use Alzabo::SQLMaker::MySQL; use Alzabo::SQLMaker::PostgreSQL; use Alzabo::Driver; use Alzabo::RDBMSRules; if ( eval { require DBD::mysql } && ! $@ ) { require Alzabo::Driver::MySQL; require Alzabo::RDBMSRules::MySQL; } if ( eval { require DBD::Pg } && ! $@ ) { require Alzabo::Driver::PostgreSQL; require Alzabo::RDBMSRules::PostgreSQL; } require Alzabo::MethodMaker; ok(1); Alzabo-0.92/t/17-insert-handle.t0000444000175000017500000000763710721343227016142 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create; use Alzabo::Config; use Alzabo::Runtime; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } plan tests => 25; Alzabo::Test::Utils->remove_all_schemas; # doesn't matter which RDBMS is used my $rdbms = $rdbms_names[0]; if ( $rdbms eq 'mysql' ) { # prevent subroutine redefinition warnings local $^W = 0; eval 'use Alzabo::SQLMaker::MySQL qw(:all)'; } elsif ( $rdbms eq 'pg' ) { local $^W = 0; eval 'use Alzabo::SQLMaker::PostgreSQL qw(:all)'; } Alzabo::Test::Utils->make_schema($rdbms); my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); $s->connect( Alzabo::Test::Utils->connect_params_for($rdbms) ); my $department = $s->table('department')->insert( values => { name => 'D 1' } ); my $dep_id = $department->select('department_id'); { my $handle = $s->table('employee')->insert_handle ( columns => [ $s->table('employee')->columns( 'name', 'dep_id' ) ] ); foreach my $name ( qw( Faye Jet Maggie ) ) { my $row = $handle->insert( values => { name => $name, dep_id => $dep_id, } ); ok( $row->select('employee_id'), 'row has an employee id' ); is( $row->select('name'), $name, "name is $name" ); is( $row->select('dep_id'), $dep_id, "dep_id is $dep_id" ); is( $row->select('smell'), 'grotesque', 'smell is default value' ); } eval { $handle->insert( values => { name => 'Dave', dep_id => $dep_id, smell => 'geeky', } ) }; like( $@, qr/cannot provide a value.+\(smell\)/i, 'try to insert with a bad column' ); } { my $handle = $s->table('employee')->insert_handle ( columns => [ $s->table('employee')->columns( 'name', 'dep_id' ) ], values => { smell => LOWER('GOOD') }, ); my $row = $handle->insert( values => { name => 'Cecilia', dep_id => $dep_id, } ); ok( $row->select('employee_id'), 'row has an employee id' ); is( $row->select('name'), 'Cecilia', "name is Cecilia" ); is( $row->select('dep_id'), $dep_id, "dep_id is $dep_id" ); is( $row->select('smell'), 'good', 'smell is "good"' ); } { my $handle = $s->table('employee')->insert_handle ( columns => [ $s->table('employee')->columns( 'name', 'dep_id' ) ], values => { smell => 'good' }, ); my $row = $handle->insert( values => { name => 'Cecilia', dep_id => $dep_id, } ); ok( $row->select('employee_id'), 'row has an employee id' ); is( $row->select('name'), 'Cecilia', "name is Cecilia" ); is( $row->select('dep_id'), $dep_id, "dep_id is $dep_id" ); is( $row->select('smell'), 'good', 'smell is "good"' ); # override a static value $row = $handle->insert( values => { name => 'Cecilia', dep_id => $dep_id, smell => 'great', } ); ok( $row->select('employee_id'), 'row has an employee id' ); is( $row->select('name'), 'Cecilia', "name is Cecilia" ); is( $row->select('dep_id'), $dep_id, "dep_id is $dep_id" ); is( $row->select('smell'), 'great', 'smell is "great"' ); } Alzabo-0.92/t/21-row_by_pk-exception.t0000444000175000017500000000122010721343227017345 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Runtime; use Alzabo::Test::Utils; use Test::More; Alzabo::Test::Utils->remove_all_schemas; my $schema = Alzabo::Test::Utils->any_connected_runtime_schema; if ($schema) { plan tests => 2; } else { plan skip_all => 'no test config provided'; exit; } my $emp_t = $schema->table('employee'); # value of pk is irrelevant, as long as it doesn't exist my $row = eval { $emp_t->row_by_pk( pk => 1258125 ) }; is( $row, undef, 'no row matched the given pk' ); is( $@, '', 'no exception was thrown with invalid pk' ); Alzabo-0.92/t/15-alias-ref.t0000444000175000017500000000160010721343227015226 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Runtime; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } plan tests => 1; Alzabo::Test::Utils->remove_all_schemas; # doesn't matter which RDBMS is used my $rdbms = $rdbms_names[0]; Alzabo::Test::Utils->make_schema($rdbms); my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); my $destroy = 0; sub Alzabo::Runtime::Table::DESTROY { $destroy++ } { my $employee_t = $s->table('employee'); { my $alias1 = $employee_t->alias; $alias1->primary_key; } is( $destroy, 1, 'alias should go out of scope' ); } Alzabo-0.92/t/05b-rules-pg.t0000444000175000017500000000622210721343227015267 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create; unless ( eval { require DBD::Pg } && ! $@ ) { plan skip_all => 'needs DBD::Pg'; exit; } plan tests => 13; my $new_schema; eval_ok( sub { $new_schema = Alzabo::Create::Schema->new( name => 'hello_there', rdbms => 'PostgreSQL' ) }, "Make a new PostgreSQL schema named 'hello_there'" ); { eval { Alzabo::Create::Schema->new( name => "hello'there", rdbms => 'PostgreSQL' ); }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exceptiont thrown from attempt to create a PostgreSQL schema named hello\'there" ); } { eval { $new_schema->make_table( name => 'x' x 65 ) }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown from attempt to create a table in PostgreSQL with a 65 character name" ); } my $table = $new_schema->make_table( name => 'quux' ); { eval { $table->make_column( name => 'foo2', type => 'text', length => 1, ); }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::RDBMSRules', "Exception thrown from attempt to make 'text' column with a length parameter" ); } { foreach my $type ( qw( DATE TIMESTAMP TIMESTAMPTZ ) ) { my $col = $table->make_column( name => "col_$type", type => $type, ); ok( $col->is_date, "$type is date" ); }; } { foreach my $type ( qw( TIMESTAMP TIMESTAMPTZ ) ) { my $col = $table->make_column( name => "col2_$type", type => $type, ); ok( $col->is_datetime, "$type is date" ); }; } { my $col = $table->make_column( name => 'col_INTERVAL', type => 'INTERVAL', ); ok( $col->is_time_interval, 'INTERVAL is a time interval' ); } { my $col = $table->make_column( name => 'int1', type => 'integer', default => 27, ); is( $new_schema->rules->_default_for_column($col), 27, 'default is 27' ); } { my $col = $table->make_column( name => 'vc1', type => 'varchar', length => 20, default => 'hello', ); is( $new_schema->rules->_default_for_column($col), q|'hello'|, "default is 'hello' (with quotes)" ); } { my $col = $table->make_column( name => 'dt1', type => 'timestamp', default => 'NOW()', default_is_raw => 1, ); is( $new_schema->rules->_default_for_column($col), q|NOW()|, 'default is NOW()' ); } Alzabo-0.92/t/99-cleanup.t0000444000175000017500000000032310721343227015027 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More tests => 1; Alzabo::Test::Utils->cleanup; ok(1);Alzabo-0.92/t/99-pod.t0000444000175000017500000000072110721343227014164 0ustar autarchautarch#!/usr/bin/perl -w use strict; use vars qw( @files ); BEGIN { eval "require File::Find::Rule"; if ($@) { print "1..1\nok 1 # skip File::Find::Rule not installed\n"; exit; } @files = File::Find::Rule->file()->name( '*.pm', '*.pod' )->in( 'blib/lib' ); } use Test::More tests => scalar @files; eval "use Test::Pod 0.95"; SKIP: { skip "Test::Pod 0.95 not installed.", scalar @files if $@; pod_file_ok( $_ ) for @files; } Alzabo-0.92/t/14-unique-row-cache.t0000444000175000017500000000554310721343227016550 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create; use Alzabo::Config; use Alzabo::Runtime::UniqueRowCache; use Alzabo::Runtime; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } plan tests => 12; Alzabo::Test::Utils->remove_all_schemas; # doesn't matter which RDBMS is used my $rdbms = $rdbms_names[0]; Alzabo::Test::Utils->make_schema($rdbms); my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); $s->connect( Alzabo::Test::Utils->connect_params_for($rdbms) ); { my $dep1 = $s->table('department')->insert( values => { name => 'dep1' } ); my $pk = $dep1->select('department_id'); my $dep1_copy = $s->table('department')->row_by_pk( pk => $pk ); is( "$dep1", "$dep1_copy", "There should only be one reference for a given row" ); $dep1->delete; ok( $dep1->is_deleted, 'copy is deleted' ); ok( $dep1_copy->is_deleted, 'copy is deleted' ); my $new_dep1 = $s->table('department') ->insert( values => { department_id => $pk, name => 'a new dep1' } ); ok( ! $new_dep1->is_deleted, 'new dep1 is not deleted' ); } { my $dep2 = $s->table('department')->insert( values => { name => 'dep2' } ); my $dep2_copy = $s->table('department')->row_by_pk( pk => $dep2->select('department_id') ); $dep2->update( name => 'foo' ); is( $dep2_copy->select('name'), 'foo', 'name in copy is foo' ); $s->driver->do( sql => 'UPDATE department SET name = ? WHERE department_id = ?', bind => [ 'bar', $dep2->select('department_id') ], ); $dep2->refresh; is( $dep2->select('name'), 'bar', 'refresh works for cached rows' ); is( $dep2_copy->select('name'), 'bar', 'refresh works for cached rows' ); my $old_id = $dep2->id_as_string; { my $updated = $dep2->update( department_id => 1000 ); ok( $updated, 'update() did change values' ); } { my $updated = $dep2->update( department_id => 1000 ); ok( ! $updated, 'update() did not change values' ); } ok( Alzabo::Runtime::UniqueRowCache->row_in_cache ( $dep2->table->name, $dep2->id_as_string ), 'row is still in cache after updating primary key' ); ok( ! Alzabo::Runtime::UniqueRowCache->row_in_cache( $dep2->table->name, $old_id ), 'old id is not in cache' ); my $dep2_copy_2 = $s->table('department')->row_by_pk( pk => $dep2->select('department_id'), no_cache => 1 ); is( $dep2_copy_2->{state}, 'Alzabo::Runtime::RowState::Live', 'row state is live, not cached' ); } Alzabo-0.92/t/lib/0000755000175000017500000000000010721343227013526 5ustar autarchautarchAlzabo-0.92/t/lib/Alzabo/0000755000175000017500000000000010721343227014736 5ustar autarchautarchAlzabo-0.92/t/lib/Alzabo/Test/0000755000175000017500000000000010721343227015655 5ustar autarchautarchAlzabo-0.92/t/lib/Alzabo/Test/Utils.pm0000444000175000017500000003415310721343227017317 0ustar autarchautarchpackage Alzabo::Test::Utils; use strict; use Alzabo::Config; use Cwd (); use File::Path (); use File::Spec; use Module::Build; # This should always happen whenever the module is loaded __PACKAGE__->create_test_schema_dir; # Used in a number of test files sub main::eval_ok (&$) { my ( $code, $name ) = @_; eval { $code->() }; if ( my $e = $@ ) { Test::More::ok( 0, $name ); Test::More::diag(" got error: $e\n" ); } else { Test::More::ok( 1, $name ); } } sub create_test_schema_dir { my $class = shift; my $schema_dir = $class->_schema_dir; unless ( -d $schema_dir ) { mkdir $schema_dir, 0755 or die "Can't make dir $schema_dir for testing: $!\n"; } } sub _schema_dir { my $class = shift; return File::Spec->catdir( $class->_root_dir, 'schemas' ); } sub _root_dir { my $cwd = Cwd::cwd(); my $root_dir = File::Spec->catdir( $cwd, 't' ); Alzabo::Config::root_dir($root_dir); return $root_dir; } sub rdbms_names { my $class = shift; my %c = $class->test_config; return sort keys %c; } sub rdbms_count { my $class = shift; return scalar $class->rdbms_names; } sub test_config { my $build = Module::Build->current; my $tests = $build->notes('test_config'); return map { $_->{rdbms} => $_ } @$tests; } sub mysql_test_config { my $class = shift; my %t = $class->test_config; return $t{mysql}; } sub pg_test_config { my $class = shift; my %t = $class->test_config; return $t{pg}; } sub test_config_for { my $class = shift; my $rdbms = shift; my $meth = "${rdbms}_test_config"; return $class->$meth(); } sub connect_params_for { my $class = shift; my $config = $class->test_config_for( shift ); return ( map { defined $config->{$_} ? ( $_ => $config->{$_} ) : () } qw( user password host port ) ); } sub cleanup { my $class = shift; $class->remove_schema_dir; $class->remove_all_schemas; } sub remove_schema_dir { my $class = shift; my $dir = $class->_schema_dir; Test::More::diag( "Removing test schema directory: $dir" ); File::Path::rmtree( $dir, $Test::Harness::verbose, 0 ); } sub remove_all_schemas { my $class = shift; $class->remove_schema($_) foreach 'mysql', 'pg'; } sub remove_schema { my $class = shift; my $rdbms = shift; my $meth = "remove_${rdbms}_schema"; $class->$meth(); } sub remove_mysql_schema { my $class = shift; my $config = $class->mysql_test_config(); return unless keys %$config; Test::More::diag( "Removing MySQL database $config->{schema_name}" ); my $s = $class->_load_or_create( name => $config->{schema_name}, rdbms => 'MySQL' ); delete @{ $config }{ 'schema_name', 'rdbms' }; eval { $s->drop( %$config ) }; eval { $s->drop( %$config, schema_name => $s->name . '_2' ) }; $s->delete if $s->is_saved; } sub remove_pg_schema { my $class = shift; my $config = $class->pg_test_config(); return unless keys %$config; Test::More::diag( "Removing PostgreSQL database $config->{schema_name}" ); my $s = $class->_load_or_create( name => $config->{schema_name}, rdbms => 'PostgreSQL' ); delete @{ $config }{ 'schema_name', 'rdbms' }; eval { $s->drop(%$config) }; eval { $s->drop( %$config, schema_name => $s->name . '_2' ) }; $s->delete if $s->is_saved; } sub _load_or_create { my $class = shift; my %p = @_; require Alzabo::Create::Schema; my $s; $s = eval { Alzabo::Create::Schema->load_from_file( name => $p{name} ) }; return $s if $s; return Alzabo::Create::Schema->new(%p); } sub any_connected_runtime_schema { my $class = shift; my $rdbms = ( $class->rdbms_names )[0]; return unless $rdbms; my $s = $class->make_schema($rdbms); my $r = Alzabo::Runtime::Schema->load_from_file( name => $s->name ); $r->connect( $class->connect_params_for($rdbms) ); return $r; } sub any_schema_name { my $class = shift; my $rdbms = ( $class->rdbms_names )[0]; my $s = $class->make_schema($rdbms); return $s->name; } sub make_schema { my $class = shift; my $rdbms = shift; my $skip_create = shift; my $meth = "make_${rdbms}_schema"; return $class->$meth($skip_create); } sub make_mysql_schema { my $class = shift; my $skip_create = shift; my $config = $class->mysql_test_config; my $s = Alzabo::Create::Schema->new( name => $config->{schema_name}, rdbms => 'MySQL', ); $s->make_table( name => 'employee', attributes => [ 'TYPE=MYISAM' ], ); my $emp_t = $s->table('employee'); $emp_t->make_column( name => 'employee_id', type => 'int', sequenced => 1, primary_key => 1, ); $emp_t->make_column( name => 'name', type => 'varchar', length => 200, ); $emp_t->make_column( name => 'smell', type => 'varchar', length => 200, nullable => 0, default => 'grotesque', ); $emp_t->make_column( name => 'cash', type => 'float', length => 6, precision => 2, nullable => 1, ); $emp_t->make_column( name => 'tstamp', type => 'integer', nullable => 1, ); # only here to test that making an enum works - not used in tests $emp_t->make_column( name => 'test_enum', type => "enum('foo','bar')", nullable => 1 ); $emp_t->make_index( columns => [ { column => $emp_t->column('name'), prefix => 10 }, { column => $emp_t->column('smell') }, ] ); # Having a fulltext index tests handling of mysql fulltext index # sub_part bug when reverse engineering $emp_t->make_index( columns => [ { column => $emp_t->column('name') } ], fulltext => 1 ); $s->make_table( name => 'department', attributes => [ 'TYPE=MYISAM' ], ); my $dep_t = $s->table('department'); $dep_t->make_column( name => 'department_id', type => 'int', sequenced => 1, primary_key => 1, ); $dep_t->make_column( name => 'name', type => 'varchar', length => 200, ); $dep_t->make_column( name => 'manager_id', type => 'int', length => 200, nullable => 1, ); $s->add_relationship( table_from => $dep_t, table_to => $emp_t, columns_from => $dep_t->column('manager_id'), columns_to => $emp_t->column('employee_id'), cardinality => [1, 1], from_is_dependent => 0, to_is_dependent => 0, ); $s->add_relationship( table_from => $emp_t, table_to => $dep_t, cardinality => ['n', 1], from_is_dependent => 1, to_is_dependent => 0, ); $s->make_table( name => 'project', attributes => [ 'TYPE=MYISAM' ], ); my $proj_t = $s->table('project'); $proj_t->make_column( name => 'project_id', type => 'int', sequenced => 1, primary_key => 1, ); $proj_t->make_column( name => 'name', type => 'varchar', length => 200, ); $proj_t->make_index( columns => [ { column => $proj_t->column('name'), prefix => 20 } ] ); $proj_t->make_column( name => 'blobby', type => 'text', nullable => 1, ); $s->add_relationship( table_from => $proj_t, table_to => $dep_t, cardinality => ['n', 1], from_is_dependent => 1, to_is_dependent => 0, ); $emp_t->column('department_id')->set_name('dep_id'); $s->add_relationship( table_from => $emp_t, table_to => $proj_t, cardinality => ['n', 'n'], from_is_dependent => 0, to_is_dependent => 0, ); $s->table('employee_project')->set_attributes( 'TYPE=MYISAM' ); my $char_pk_t = $s->make_table( name => 'char_pk', attributes => [ 'TYPE=MYISAM' ], ); $char_pk_t->make_column( name => 'char_col', type => 'varchar', length => 40, primary_key => 1 ); my $outer_1_t = $s->make_table( name => 'outer_1', attributes => [ 'TYPE=MYISAM' ], ); $outer_1_t->make_column( name => 'outer_1_pk', type => 'int', sequenced => 1, primary_key => 1, ); $outer_1_t->make_column( name => 'outer_1_name', type => 'varchar', length => 40, ); $outer_1_t->make_column( name => 'outer_2_pk', type => 'int', nullable => 1, ); my $outer_2_t = $s->make_table( name => 'outer_2', attributes => [ 'TYPE=MYISAM' ], ); $outer_2_t->make_column( name => 'outer_2_pk', type => 'int', sequenced => 1, primary_key => 1, ); $outer_2_t->make_column( name => 'outer_2_name', type => 'varchar', length => 20, ); $s->add_relationship( table_from => $outer_1_t, table_to => $outer_2_t, columns_from => $outer_1_t->column('outer_2_pk'), columns_to => $outer_2_t->column('outer_2_pk'), cardinality => [1, 1], from_is_dependent => 0, to_is_dependent => 0, ); my $u = $s->make_table( name => 'user', attributes => [ 'TYPE=MYISAM' ], ); $u->make_column( name => 'user_id', type => 'integer', primary_key => 1 ); unless ($skip_create) { delete @{ $config }{'rdbms', 'schema_name'}; $s->create(%$config); $s->driver->disconnect; } $s->save_to_file; return $s; } # make sure to use native types or Postgres converts them and then the # reverse engineering tests fail. sub make_pg_schema { my $class = shift; my $skip_create = shift; my $config = $class->pg_test_config; my $s = Alzabo::Create::Schema->new( name => $config->{schema_name}, rdbms => 'PostgreSQL', ); $s->make_table( name => 'employee' ); my $emp_t = $s->table('employee'); $emp_t->make_column( name => 'employee_id', type => 'serial', sequenced => 1, primary_key => 1, ); $emp_t->make_column( name => 'name', type => 'varchar', length => 200, ); $emp_t->make_column( name => 'smell', type => 'varchar', length => 200, nullable => 1, default => 'grotesque', ); $emp_t->make_column( name => 'cash', type => 'numeric', length => 6, precision => 2, nullable => 1, ); $emp_t->make_column( name => 'tstamp', type => 'integer', nullable => 1, ); $emp_t->make_index( columns => [ { column => $emp_t->column('name') } ] ); $emp_t->make_index( columns => [ { column => $emp_t->column('smell') } ], function => 'lower(smell)', ); $s->make_table( name => 'department'); my $dep_t = $s->table('department'); $dep_t->make_column( name => 'department_id', type => 'int4', sequenced => 1, primary_key => 1, ); $dep_t->make_column( name => 'name', type => 'varchar', length => 200, ); $dep_t->make_column( name => 'manager_id', type => 'int4', nullable => 1, ); $s->add_relationship( table_from => $dep_t, table_to => $emp_t, columns_from => $dep_t->column('manager_id'), columns_to => $emp_t->column('employee_id'), cardinality => [ 1, 1 ], from_is_dependent => 0, to_is_dependent => 0, ); $s->add_relationship( table_from => $emp_t, table_to => $dep_t, cardinality => ['n', 1], from_is_dependent => 1, to_is_dependent => 0, ); $s->make_table( name => 'project' ); my $proj_t = $s->table('project'); $proj_t->make_column( name => 'project_id', type => 'int4', sequenced => 1, primary_key => 1, ); $proj_t->make_column( name => 'name', type => 'varchar', length => 200, ); $proj_t->make_column( name => 'blobby', type => 'text', nullable => 1, ); $s->add_relationship( table_from => $emp_t, table_to => $proj_t, cardinality => ['n', 'n'], from_is_dependent => 0, to_is_dependent => 0, ); $proj_t->make_index( columns => [ { column => $proj_t->column('name') } ] ); $emp_t->column('department_id')->set_name('dep_id'); $s->add_relationship( table_from => $proj_t, table_to => $dep_t, cardinality => ['n', 1], from_is_dependent => 1, to_is_dependent => 0, ); my $char_pk_t = $s->make_table( name => 'char_pk' ); $char_pk_t->make_column( name => 'char_col', type => 'varchar', length => 20, primary_key => 1 ); $char_pk_t->make_column( name => 'fixed_char', type => 'char', nullable => 1, length => 5 ); my $outer_1_t = $s->make_table( name => 'outer_1' ); $outer_1_t->make_column( name => 'outer_1_pk', type => 'int', sequenced => 1, primary_key => 1, ); $outer_1_t->make_column( name => 'outer_1_name', type => 'varchar', length => 40, ); $outer_1_t->make_column( name => 'outer_2_pk', type => 'int', nullable => 1, ); my $outer_2_t = $s->make_table( name => 'outer_2' ); $outer_2_t->make_column( name => 'outer_2_pk', type => 'int', sequenced => 1, primary_key => 1, ); $outer_2_t->make_column( name => 'outer_2_name', type => 'varchar', length => 40, ); $s->add_relationship( table_from => $outer_1_t, table_to => $outer_2_t, columns_from => $outer_1_t->column('outer_2_pk'), columns_to => $outer_2_t->column('outer_2_pk'), cardinality => [1, 1], from_is_dependent => 0, to_is_dependent => 0, ); my $mixed = $s->make_table( name => 'MixEDCasE' ); $mixed->make_column( name => 'mixed_CASE_Pk', type => 'integer', primary_key => 1 ); my $name = $config->{schema_name}; unless ($skip_create) { delete @{ $config }{'rdbms', 'schema_name'}; $s->create(%$config); $s->driver->disconnect; } $s->save_to_file; return $s; } 1; __END__ =head1 DESCRIPTION Alzabo::Test::Utils - Utility module for Alzabo test suite =head1 SYNOPSIS use Alzabo::Test::Utils; Alzabo::Test::Utils-> =cut Alzabo-0.92/t/20-rev-engineer-pg-now.t0000444000175000017500000000430010721343227017152 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create::Schema; my $config = Alzabo::Test::Utils->test_config_for('pg'); unless ( keys %$config ) { plan skip_all => 'no Postgres test config provided'; exit; } { package FakeSchema; sub new { return bless { name => $_[1] }, $_[0] } sub db_schema_name { $_[0]->{name} } } require DBD::Pg; require Alzabo::Driver::PostgreSQL; plan tests => 6; Alzabo::Test::Utils->remove_schema('pg'); my $schema_name = delete $config->{schema_name}; delete $config->{rdbms}; { # This seems to help avoid those damn 'source database "template1" # is being accessed by other users' errors. Freaking Postgres! sleep 1; # We create a couple of tables *without* using Alzabo, then see # whether it can reverse-engineer them and preserve foreign key # relationships. my $driver = Alzabo::Driver->new( rdbms => 'PostgreSQL', schema => FakeSchema->new('template1'), ); $driver->connect( %$config ); my $dbh = $driver->handle; $dbh->do("CREATE DATABASE $schema_name"); $dbh->disconnect; ok( 1, 'drop and create database' ); $driver = Alzabo::Driver->new( rdbms => 'PostgreSQL', schema => FakeSchema->new($schema_name), ); $driver->connect( %$config ); $dbh = $driver->handle; $dbh->do( q{CREATE TABLE foobar ( foo_ts timestamp default now() primary key ) }); $dbh->disconnect; ok( 1, 'create tables to be reverse engineered' ); } my $schema = Alzabo::Create::Schema->reverse_engineer ( name => $schema_name, rdbms => 'PostgreSQL', %$config, ); ok( $schema, 'schema was created via reverse engineering' ); { my $t = $schema->table('foobar'); ok( $t, 'found foobar table' ); my $c = $t->column('foo_ts'); ok( $c->default_is_raw(), 'default is raw for foobar.foo_ts' ); is( $c->default(), 'now()', 'default is now() for foobar.foo_ts' ); } Alzabo-0.92/t/01-driver.t0000444000175000017500000000156710721343227014665 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Driver; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } my $tests_per_run = 2; plan tests => $tests_per_run * @rdbms_names; my %rdbms = ( mysql => 'MySQL', pg => 'PostgreSQL' ); foreach my $rdbms (@rdbms_names) { my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $driver = Alzabo::Driver->new( rdbms => $rdbms{$rdbms} ); my @schemas; eval_ok( sub { @schemas = $driver->schemas( Alzabo::Test::Utils->connect_params_for($rdbms) ) }, "Schema method for $rdbms{ $config->{rdbms} }" ); ok( scalar @schemas, 'schemas were found' ); } Alzabo-0.92/t/12-rev-engineer-pg-fk.t0000444000175000017500000001435710721343227016765 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; use Alzabo::Create::Schema; my $config = Alzabo::Test::Utils->test_config_for('pg'); unless ( keys %$config ) { plan skip_all => 'no Postgres test config provided'; exit; } { package FakeSchema; sub new { return bless { name => $_[1] }, $_[0] } sub db_schema_name { $_[0]->{name} } } require DBD::Pg; require Alzabo::Driver::PostgreSQL; plan tests => 29; Alzabo::Test::Utils->remove_schema('pg'); my $schema_name = delete $config->{schema_name}; delete $config->{rdbms}; { # This seems to help avoid those damn 'source database "template1" # is being accessed by other users' errors. Freaking Postgres! sleep 1; # We create a couple of tables *without* using Alzabo, then see # whether it can reverse-engineer them and preserve foreign key # relationships. my $driver = Alzabo::Driver->new( rdbms => 'PostgreSQL', schema => FakeSchema->new('template1'), ); $driver->connect( %$config ); my $dbh = $driver->handle; $dbh->do("CREATE DATABASE $schema_name"); $dbh->disconnect; ok( 1, 'drop and create database' ); $driver = Alzabo::Driver->new( rdbms => 'PostgreSQL', schema => FakeSchema->new($schema_name), ); $driver->connect( %$config ); $dbh = $driver->handle; $dbh->do( q{CREATE TABLE foo_people -- one-column primary key ( id SERIAL PRIMARY KEY, name VARCHAR(30) ) }); $dbh->do( q{CREATE TABLE foo_dogs -- two-column primary key ( id INTEGER NOT NULL, tag_number INTEGER NOT NULL, PRIMARY KEY (id, tag_number) ) }); $dbh->do( q{CREATE TABLE foo_main ( id SERIAL PRIMARY KEY, foo_person INTEGER NOT NULL, FOREIGN KEY (foo_person) REFERENCES foo_people(id), foo_dog_id INTEGER NULL, foo_dog_tag INTEGER NULL, FOREIGN KEY (foo_dog_id, foo_dog_tag) REFERENCES foo_dogs(id, tag_number) ) }); $dbh->do( q{CREATE TABLE foo_cats ( id SERIAL PRIMARY KEY, name VARCHAR(30) ) }); $dbh->do( q{CREATE TABLE cat_owner -- linking table ( person_id INTEGER NOT NULL, cat_id INTEGER NOT NULL, has_check CHAR(1) CHECK (has_check = 'Q' OR has_check = 'P'), FOREIGN KEY (person_id) REFERENCES foo_people (id), FOREIGN KEY (cat_id) REFERENCES foo_cats (id), PRIMARY KEY (person_id, cat_id) ) }); $dbh->disconnect; ok( 1, 'create tables to be reverse engineered' ); } my $schema = Alzabo::Create::Schema->reverse_engineer ( name => $schema_name, rdbms => 'PostgreSQL', %$config, ); ok( $schema, 'schema was created via reverse engineering' ); { my $t = $schema->table('foo_main'); ok( $t, 'found foo_main table' ); my @fk = $t->all_foreign_keys; is( scalar @fk, 2, 'found 2 foreign keys' ); my $people_fk = $t->foreign_keys_by_column( $t->column('foo_person') ); ok( $people_fk, 'found fk to foo_person' ); is( $people_fk->table_from->name, 'foo_main', 'fk is from foo_main' ); is( $people_fk->table_to->name, 'foo_people', 'fk is to foo_people' ); is( scalar @{[$people_fk->columns_from]}, 1, 'one column is involved in fk' ); ok( $people_fk->is_many_to_one, 'fk is many to one' ); ok( $people_fk->from_is_dependent, 'from is dependent' ); my $dog_fk = $t->foreign_keys_by_column( $t->column('foo_dog_id') ); ok( $dog_fk, 'found fk to foo_dogs' ); is( $dog_fk->table_from->name, 'foo_main', 'fk is from foo_main' ); is( $dog_fk->table_to->name, 'foo_dogs', 'fk is to foo_dogs' ); is( scalar @{[$dog_fk->columns_from]}, 2, '2 columns are involved in fk' ); ok( $dog_fk->is_many_to_one, 'fk is many to one' ); ok( ! $dog_fk->from_is_dependent, 'from is not dependent' ); } { my $att = join '', $schema->table('cat_owner')->column('has_check')->attributes; like( $att, qr/CHECK/, 'cat_owner.has_check has a constraint' ); } { my @fk = $schema->table('foo_dogs')->all_foreign_keys; @fk = grep $_->from_is_dependent, @fk; is( scalar @fk, 0, 'No dependent foreign keys from referenced table' ); @fk = $schema->table('foo_people')->all_foreign_keys; @fk = grep $_->from_is_dependent, @fk; is( scalar @fk, 0, 'No dependent foreign keys from referenced table' ); my $people_t = $schema->table('foo_people'); @fk = $people_t->foreign_keys_by_column($people_t->column('id')); is @fk, 2, 'Table is involved in 2 relationships'; my ($linking_fk) = grep {$_->table_to->name eq 'cat_owner'} @fk; ok $linking_fk, 'foo_people is linked to cat_owner'; is $linking_fk->to_is_dependent, 1, 'cat_owner depends on foo_people'; } { $schema->save_to_file; $schema = 'Alzabo::Runtime::Schema'->load_from_file(name => $schema_name); $schema->connect( Alzabo::Test::Utils->connect_params_for('pg') ); my $p = $schema->table('foo_people'); is( $p->primary_key->sequenced, 1, 'sequence for primary key was detected' ); my $person = $p->insert( values => { } ); ok( $person, 'can insert values using the primary key sequence' ); my $d = $schema->table('foo_dogs'); is( $d->primary_key->sequenced, 0, "this PK isn't sequenced" ); my $dog = $d->insert( values => {id => 1, tag_number => 5} ); ok( $dog, 'can insert values specifying primary key explicitly' ); my $m = $schema->table('foo_main'); is( $m->primary_key->sequenced, 1, 'sequence for primary key was detected' ); my $main = $m->insert( values => { foo_person => $person->select('id'), foo_dog_id => $dog->select('id'), foo_dog_tag => $dog->select('tag_number') } ); ok( $main, 'can insert values using the primary key sequence' ); } Alzabo-0.92/t/03-runtime.t0000444000175000017500000017335010721343227015057 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } my $tests_per_run = 340; my $test_count = $tests_per_run * @rdbms_names; my %SINGLE_RDBMS_TESTS = ( mysql => 23, pg => 11, ); foreach my $rdbms ( keys %SINGLE_RDBMS_TESTS ) { next unless grep { $_ eq $rdbms } @rdbms_names; $test_count += $SINGLE_RDBMS_TESTS{$rdbms}; } plan tests => $test_count; Alzabo::Test::Utils->remove_all_schemas; foreach my $rdbms (@rdbms_names) { if ( $rdbms eq 'mysql' ) { # prevent subroutine redefinition warnings local $^W = 0; eval 'use Alzabo::SQLMaker::MySQL qw(:all)'; } elsif ( $rdbms eq 'pg' ) { local $^W = 0; eval 'use Alzabo::SQLMaker::PostgreSQL qw(:all)'; } Alzabo::Test::Utils->make_schema($rdbms); run_tests($rdbms); Alzabo::Test::Utils->remove_schema($rdbms); } sub run_tests { my $rdbms = shift; my $config = Alzabo::Test::Utils->test_config_for($rdbms); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); # tests setting basic parameters and connecting to RDBMS { eval_ok( sub { $s->set_user('foo') }, "Set user for schema to foo" ); eval_ok( sub { $s->set_password('foo') }, "Set password for schema to foo" ); eval_ok( sub { $s->set_host('foo') }, "Set host for schema to foo" ); eval_ok( sub { $s->set_port(1234) }, "Set port for schema to 1234" ); $s->$_(undef) foreach qw( set_user set_password set_host set_port ); $s->connect( Alzabo::Test::Utils->connect_params_for($rdbms) ); $s->set_referential_integrity(1); } { my $dbh = $s->driver->handle; isa_ok( $dbh, ref $s->driver->{dbh}, "Object returned by \$s->driver->handle method" ); eval_ok( sub { $s->driver->handle($dbh) }, "Set \$s->driver->handle" ); } my $emp_t = $s->table('employee'); my $dep_t = $s->table('department'); my $proj_t = $s->table('project'); my $emp_proj_t = $s->table('employee_project'); my %dep; eval_ok( sub { $dep{borg} = $dep_t->insert( values => { name => 'borging' } ) }, "Insert borging row into department table" ); is( $dep{borg}->select('name'), 'borging', "The borg department name should be 'borging'" ); { my @all = $dep{borg}->select; is( @all, 3, "select with no columns should return all the values" ); is( $all[1], 'borging', "The second value should be the department name" ); my %all = $dep{borg}->select_hash; is( keys %all, 3, "select_hash with no columns should return two keys" ); ok( exists $all{department_id}, "The returned hash should have a department_id key" ); ok( exists $all{name}, "The returned hash should have a department_id key" ); is( $all{name}, 'borging', "The value of the name key be the department name" ); } $dep{lying} = $dep_t->insert( values => { name => 'lying to the public' } ); my $borg_id = $dep{borg}->select('department_id'); delete $dep{borg}; eval_ok( sub { $dep{borg} = $dep_t->row_by_pk( pk => $borg_id ) }, "Retrieve borg department row via row_by_pk method" ); isa_ok( $dep{borg}, 'Alzabo::Runtime::Row', "Borg department" ); is( $dep{borg}->select('name'), 'borging', "Department's name should be 'borging'" ); eval { $dep_t->insert( values => { name => 'will break', manager_id => 1 } ); }; my $e = $@; isa_ok( $e, 'Alzabo::Exception::ReferentialIntegrity', "Exception thrown from attempt to insert a non-existent manager_id into department" ); my %emp; eval_ok( sub { $emp{bill} = $emp_t->insert( values => { name => 'Big Bill', dep_id => $borg_id, smell => 'robotic', cash => 20.2, } ) }, "Insert Big Bill into employee table" ); my %data = $emp{bill}->select_hash( 'name', 'smell' ); is( $data{name}, 'Big Bill', "select_hash - check name key" ); is( $data{smell}, 'robotic', "select_hash - check smell key" ); is( $emp{bill}->is_live, 1, "->is_live should be true for real row" ); eval { $emp_t->insert( values => { name => undef, dep_id => $borg_id, smell => 'robotic', cash => 20.2, } ); }; $e = $@; isa_ok( $e, 'Alzabo::Exception::NotNullable', "Exception thrown from inserting a non-nullable column as NULL" ); is( $e->table_name, 'employee', "NotNullable exceptions contain table name" ); is( $e->schema_name, $config->{schema_name}, "NotNullable exceptions contain schema name" ); { my $new_emp; eval_ok( sub { $new_emp = $emp_t->insert( values => { name => 'asfalksf', dep_id => $borg_id, smell => undef, cash => 20.2, } ) }, "Inserting a NULL into a non-nullable column that has a default should not produce an exception" ); eval_ok( sub { $new_emp->delete }, "Delete a just-created employee" ); } eval { $emp_t->insert( values => { name => 'YetAnotherTest', dep_id => undef, cash => 1.1, } ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::Params', "Exception thrown from attempt to insert a NULL into dep_id for an employee" ); eval { $emp{bill}->update( dep_id => undef ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::Params', "Exception thrown from attempt to update dep_id to NULL for an employee" ); { my $updated = $emp{bill}->update( cash => undef, smell => 'hello!' ); ok( $updated, 'update() did change values' ); ok( ! defined $emp{bill}->select('cash'), "Bill has no cash" ); } { my $updated = $emp{bill}->update( cash => undef, smell => 'hello!' ); ok( ! $updated, 'update() did not change values' ); } ok( $emp{bill}->select('smell') eq 'hello!', "smell for bill should be 'hello!'" ); eval { $emp{bill}->update( name => undef ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::NotNullable', "Exception thrown from attempt to update a non-nullable column to NULL" ); eval_ok( sub { $dep{borg}->update( manager_id => $emp{bill}->select('employee_id') ) }, "Set manager_id column for borg department" ); eval_ok( sub { $emp{2} = $emp_t->insert( values => { name => 'unit 2', smell => 'good', dep_id => $dep{lying}->select('department_id') } ) }, "Create employee 'unit 2'" ); my $emp2_id = $emp{2}->select('employee_id'); delete $emp{2}; my $cursor; my $x = 0; eval_ok( sub { $cursor = $emp_t->rows_where ( where => [ $emp_t->column('employee_id'), '=', $emp2_id ] ); while ( my $row = $cursor->next ) { $x++; $emp{2} = $row; } }, "Retrieve 'unit 2' employee via rows_where method and cursor" ); is( $x, 1, "Check count of rows found where employee_id == $emp2_id" ); is( $cursor->count, 1, "Make sure cursor's count() is accurate" ); is( $emp{2}->select('name'), 'unit 2', "Check that row found has name of 'unit 2'" ); { my $row; eval_ok( sub { $row = $emp_t->one_row ( where => [ $emp_t->column('employee_id'), '=', $emp2_id ] ) }, "Retrieve 'unit 2' employee via one_row method" ); is( $row->select('name'), 'unit 2', "Check that the single row returned has the name 'unit 2'" ); } { my $row; eval_ok( sub { $row = $emp_t->one_row ( where => [ $emp_t->column('employee_id'), '=', $emp2_id ], quote_identifiers => 1, ) }, "Retrieve 'unit 2' employee via one_row method with quote_identifiers" ); is( $row->select('name'), 'unit 2', "Check that the single row returned has the name 'unit 2'" ); } my %proj; $proj{extend} = $proj_t->insert( values => { name => 'Extend', department_id => $dep{borg}->select('department_id') } ); $proj{embrace} = $proj_t->insert( values => { name => 'Embrace', department_id => $dep{borg}->select('department_id') } ); $emp_proj_t->insert( values => { employee_id => $emp{bill}->select('employee_id'), project_id => $proj{extend}->select('project_id') } ); $emp_proj_t->insert( values => { employee_id => $emp{bill}->select('employee_id'), project_id => $proj{embrace}->select('project_id') } ); my $fk = $emp_t->foreign_keys_by_table($emp_proj_t); my @emp_proj; my @cursor_counts; eval_ok( sub { $cursor = $emp{bill}->rows_by_foreign_key( foreign_key => $fk ); while ( my $row = $cursor->next ) { push @emp_proj, $row; push @cursor_counts, $cursor->count; } }, "Fetch rows via ->rows_by_foreign_key method (expect cursor)" ); is( scalar @emp_proj, 2, "Check that only two rows were returned" ); is( $emp_proj[0]->select('employee_id'), $emp{bill}->select('employee_id'), "Check that employee_id in employee_project is same as bill's" ); is( $emp_proj[0]->select('project_id'), $proj{extend}->select('project_id'), "Check that project_id in employee_project is same as extend project" ); foreach (1..2) { is( $cursor_counts[$_ - 1], $_, "cursor->count should be 1..2" ); } my $emp_proj = $emp_proj[0]; $fk = $emp_proj_t->foreign_keys_by_table($emp_t); my $emp; eval_ok( sub { $emp = $emp_proj->rows_by_foreign_key( foreign_key => $fk ) }, "Fetch rows via ->rows_by_foreign_key method (expect row)" ); is( $emp->select('employee_id'), $emp_proj->select('employee_id'), "The returned row should have bill's employee_id" ); $x = 0; my @rows; eval_ok( sub { $cursor = $emp_t->all_rows; $x++ while $cursor->next }, "Fetch all rows from employee table" ); is( $x, 2, "Only 2 rows should be found" ); $cursor->reset; my $count = $cursor->all_rows; is( $x, 2, "Only 2 rows should be found after cursor reset" ); { my $cursor; eval_ok( sub { $cursor = $s->join( join => [ $emp_t, $emp_proj_t, $proj_t ], where => [ $emp_t->column('employee_id'), '=', $emp{bill}->select('employee_id') ], order_by => $proj_t->column('project_id'), quote_identifiers => 1, ) }, "Join employee, employee_project, and project tables where employee_id = bill's employee id with quote_identifiers" ); my @rows = $cursor->next; is( scalar @rows, 3, "3 rows per cursor ->next call" ); is( $rows[0]->table->name, 'employee', "First row is from employee table" ); is( $rows[1]->table->name, 'employee_project', "Second row is from employee_project table" ); is( $rows[2]->table->name, 'project', "Third row is from project table" ); my $first_proj_id = $rows[2]->select('project_id'); @rows = $cursor->next; my $second_proj_id = $rows[2]->select('project_id'); ok( $first_proj_id < $second_proj_id, "Order by clause should cause project rows to come back" . " in ascending order of project id" ); } { my $cursor; eval_ok( sub { $cursor = $s->join( join => [ $emp_t, $emp_proj_t, $proj_t ], where => [ [ $proj_t->column('project_id'), '=', $proj{extend}->select('project_id') ], 'or', [ $proj_t->column('project_id'), '=', $proj{embrace}->select('project_id') ], ], order_by => $proj_t->column('project_id') ) }, "Join employee, employee_project, and project tables with OR in where clause" ); 1 while $cursor->next; is( $cursor->count, 2, "join with OR in where clause should return two sets of rows" ); } # Alias code { my $e_alias; eval_ok( sub { $e_alias = $emp_t->alias }, "Create an alias object for the employee table" ); my $p_alias; eval_ok( sub { $p_alias = $proj_t->alias }, "Create an alias object for the project table" ); eval_ok( sub { $cursor = $s->join( join => [ $e_alias, $emp_proj_t, $p_alias ], where => [ $e_alias->column('employee_id'), '=', 1 ], order_by => $p_alias->column('project_id'), ) }, "Join employee, employee_project, and project tables where" . " employee_id = 1 using aliases" ); my @rows = $cursor->next; is( scalar @rows, 3, "3 rows per cursor ->next call" ); is( $rows[0]->table->name, 'employee', "First row is from employee table" ); is( $rows[1]->table->name, 'employee_project', "Second row is from employee_project table" ); is( $rows[2]->table->name, 'project', "Third row is from project table" ); } # Alias code & multiple joins to the same table { my $p_alias = $proj_t->alias; eval_ok( sub { $cursor = $s->join( select => [ $p_alias, $proj_t ], join => [ $p_alias, $emp_proj_t, $proj_t ], where => [ [ $p_alias->column('project_id'), '=', 1 ], [ $proj_t->column('project_id'), '=', 1 ] ], ) }, "Join employee_project and project table (twice) using aliases" ); my @rows = $cursor->next; is( scalar @rows, 2, "2 rows per cursor ->next call" ); is( $rows[0]->table->name, 'project', "First row is from project table" ); is( $rows[1]->table->name, 'project', "Second row is from project table" ); is( $rows[0]->table, $rows[1]->table, "The two rows should share the same table object (the alias should be gone at this point)" ); } { my @rows; eval_ok( sub { @rows = $s->one_row( tables => [ $emp_t, $emp_proj_t, $proj_t ], where => [ $emp_t->column('employee_id'), '=', 1 ], order_by => $proj_t->column('project_id') ) }, "Join employee, employee_project, and project tables where employee_id = 1 using one_row method" ); is( $rows[0]->table->name, 'employee', "First row is from employee table" ); is( $rows[1]->table->name, 'employee_project', "Second row is from employee_project table" ); is( $rows[2]->table->name, 'project', "Third row is from project table" ); } $cursor = $s->join( join => [ $emp_t, $emp_proj_t, $proj_t ], where => [ $emp_t->column('employee_id'), '=', 1 ], order_by => [ $proj_t->column('project_id'), 'desc' ] ); @rows = $cursor->next; my $first_proj_id = $rows[2]->select('project_id'); @rows = $cursor->next; my $second_proj_id = $rows[2]->select('project_id'); ok( $first_proj_id > $second_proj_id, "Order by clause should cause project rows to come back in descending order of project id" ); $cursor = $s->join( join => [ $emp_t, $emp_proj_t, $proj_t ], where => [ $emp_t->column('employee_id'), '=', 1 ], order_by => [ $proj_t->column('project_id'), 'desc' ] ); @rows = $cursor->next; $first_proj_id = $rows[2]->select('project_id'); @rows = $cursor->next; $second_proj_id = $rows[2]->select('project_id'); ok( $first_proj_id > $second_proj_id, "Order by clause (alternate form) should cause project rows to come back in descending order of project id" ); eval_ok( sub { $cursor = $s->join( select => [ $emp_t, $emp_proj_t, $proj_t ], join => [ [ $emp_t, $emp_proj_t ], [ $emp_proj_t, $proj_t ] ], where => [ $emp_t->column('employee_id'), '=', 1 ] ) }, "Join with join as arrayref of arrayrefs" ); @rows = $cursor->next; is( scalar @rows, 3, "3 rows per cursor ->next call" ); is( $rows[0]->table->name, 'employee', "First row is from employee table" ); is( $rows[1]->table->name, 'employee_project', "Second row is from employee_project table" ); is( $rows[2]->table->name, 'project', "Third row is from project table" ); { my $cursor; eval_ok( sub { $cursor = $s->join( join => [ [ $emp_t, $emp_proj_t ], [ $emp_proj_t, $proj_t ] ], where => [ $emp_t->column('employee_id'), '=', 1 ] ) }, "Same join with no select parameter" ); my @rows = $cursor->next; @rows = sort { $a->table->name cmp $b->table->name } @rows; is( scalar @rows, 3, "3 rows per cursor ->next call" ); is( ( grep { $_->table->name eq 'employee' } @rows ), 1, "First row is from employee table" ); is( ( grep { $_->table->name eq 'employee_project' } @rows ), 1, "Second row is from employee_project table" ); is( ( grep { $_->table->name eq 'project' } @rows ), 1, "Third row is from project table" ); } eval { $s->join( select => [ $emp_t, $emp_proj_t, $proj_t ], join => [ [ $emp_t, $emp_proj_t ], [ $emp_proj_t, $proj_t ], [ $s->tables( 'outer_1', 'outer_2' ) ] ], where => [ $emp_t->column('employee_id'), '=', 1 ] ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::Logic', "Exception thrown from join with table map that does not connect" ); eval_ok( sub { @rows = $s->join( join => $emp_t, where => [ $emp_t->column('employee_id'), '=', 1 ] )->all_rows }, "Join with a single table" ); is( @rows, 1, "Only one row should be returned" ); is( $rows[0]->select('employee_id'), 1, "Returned employee should be employee number one" ); { $s->table('outer_2')->insert( values => { outer_2_name => 'will match something', outer_2_pk => 1 }, ); $s->table('outer_2')->insert( values => { outer_2_name => 'will match nothing', outer_2_pk => 99 }, ); $s->table('outer_1')->insert( values => { outer_1_name => 'test1 (has matching join row)', outer_2_pk => 1 }, ); $s->table('outer_1')->insert( values => { outer_1_name => 'test2 (has no matching join row)', outer_2_pk => undef }, ); { my $cursor; eval_ok( sub { $cursor = $s->join ( select => [ $s->tables( 'outer_1', 'outer_2' ) ], join => [ left_outer_join => $s->tables( 'outer_1', 'outer_2' ) ] ) }, "Do a left outer join" ); my @sets = $cursor->all_rows; is( scalar @sets, 2, "Left outer join should return 2 sets of rows" ); # re-order so that the set with 2 valid rows is always first unless ( defined $sets[0]->[1] ) { my $set = shift @sets; push @sets, $set; } is( $sets[0]->[0]->select('outer_1_name'), 'test1 (has matching join row)', "The first row in the first set should have the name 'test1 (has matching join row)'" ); is( $sets[0]->[1]->select('outer_2_name'), 'will match something', "The second row in the first set should have the name 'will match something'" ); is( $sets[1]->[0]->select('outer_1_name'), 'test2 (has no matching join row)', "The first row in the second set should have the name 'test12 (has no matching join row)'" ); ok( ! defined $sets[1]->[1], "The second row in the second set should not be defined" ); } { my $cursor; eval_ok( sub { $cursor = $s->join ( select => [ $s->tables( 'outer_1', 'outer_2' ) ], join => [ [ left_outer_join => $s->tables( 'outer_1', 'outer_2' ), [ $s->table('outer_2')->column( 'outer_2_pk' ), '!=', 1 ], ] ], order_by => $s->table('outer_1')->column('outer_1_name') ) }, "Do a left outer join" ); my @sets = $cursor->all_rows; is( scalar @sets, 2, "Left outer join should return 2 sets of rows" ); is( $sets[0]->[0]->select('outer_1_name'), 'test1 (has matching join row)', "The first row in the first set should have the name 'test1 (has matching join row)'" ); is( $sets[0]->[1], undef, "The second row in the first set should be undef" ); is( $sets[1]->[0]->select('outer_1_name'), 'test2 (has no matching join row)', "The first row in the second set should have the name 'test1 (has matching join row)'" ); is( $sets[1]->[1], undef, "The second row in the second set should be undef" ); } { my $fk = $s->table('outer_1')->foreign_keys_by_table( $s->table('outer_2') ); my $cursor; eval_ok( sub { $cursor = $s->join ( select => [ $s->tables( 'outer_1', 'outer_2' ) ], join => [ [ left_outer_join => $s->tables( 'outer_1', 'outer_2' ), $fk, [ $s->table('outer_2')->column( 'outer_2_pk' ), '!=', 1 ], ] ], order_by => $s->table('outer_1')->column('outer_1_name') ) }, "Do a left outer join" ); my @sets = $cursor->all_rows; is( scalar @sets, 2, "Left outer join should return 2 sets of rows" ); is( $sets[0]->[0]->select('outer_1_name'), 'test1 (has matching join row)', "The first row in the first set should have the name 'test1 (has matching join row)'" ); is( $sets[0]->[1], undef, "The second row in the first set should be undef" ); is( $sets[1]->[0]->select('outer_1_name'), 'test2 (has no matching join row)', "The first row in the second set should have the name 'test1 (has matching join row)'" ); is( $sets[1]->[1], undef, "The second row in the second set should be undef" ); } { my $cursor; eval_ok( sub { $cursor = $s->join ( select => [ $s->tables( 'outer_1', 'outer_2' ) ], join => [ [ right_outer_join => $s->tables( 'outer_1', 'outer_2' ) ] ] ) }, "Attempt a right outer join" ); my @sets = $cursor->all_rows; is( scalar @sets, 2, "Right outer join should return 2 sets of rows" ); # re-order so that the set with 2 valid rows is always first unless ( defined $sets[0]->[0] ) { my $set = shift @sets; push @sets, $set; } is( $sets[0]->[0]->select('outer_1_name'), 'test1 (has matching join row)', "The first row in the first set should have the name 'test1 (has matching join row)'" ); is( $sets[0]->[1]->select('outer_2_name'), 'will match something', "The second row in the first set should have the name 'will match something'" ); ok( ! defined $sets[1]->[0], "The first row in the second set should not be defined" ); is( $sets[1]->[1]->select('outer_2_name'), 'will match nothing', "The second row in the second set should have the name 'test12 (has no matching join row)'" ); } { my $cursor; # do the same join, but with specified foreign key my $fk = $s->table('outer_1')->foreign_keys_by_table( $s->table('outer_2') ); eval_ok( sub { $cursor = $s->join ( select => [ $s->tables( 'outer_1', 'outer_2' ) ], join => [ [ right_outer_join => $s->tables( 'outer_1', 'outer_2' ), $fk ] ] ) }, "Attempt a right outer join, with explicit foreign key" ); my @sets = $cursor->all_rows; is( scalar @sets, 2, "Right outer join should return 2 sets of rows" ); # re-order so that the set with 2 valid rows is always first unless ( defined $sets[0]->[0] ) { my $set = shift @sets; push @sets, $set; } is( $sets[0]->[0]->select('outer_1_name'), 'test1 (has matching join row)', "The first row in the first set should have the name 'test1 (has matching join row)'" ); is( $sets[0]->[1]->select('outer_2_name'), 'will match something', "The second row in the first set should have the name 'will match something'" ); ok( ! defined $sets[1]->[0], "The first row in the second set should not be defined" ); is( $sets[1]->[1]->select('outer_2_name'), 'will match nothing', "The second row in the second set should have the name 'test12 (has no matching join row)'" ); } } my $id = $emp{bill}->select('employee_id'); $emp{bill}->delete; eval { $emp{bill}->select('name'); }; $e = $@; isa_ok( $e, 'Alzabo::Exception::NoSuchRow', "Exception thrown from attempt to select from deleted row object" ); { my $row = $emp_proj_t->row_by_pk ( pk => { employee_id => $id, project_id => $proj{extend}->select('project_id') } ); is( $row, undef, "make sure row was deleted by cascading delte" ); } is( $dep{borg}->select('manager_id'), 1, "The manager_id for the borg department will be 1 because the object does not the database was changed" ); $dep{borg}->refresh; my $dep_id = $dep{borg}->select('department_id'); $emp_t->insert( values => { name => 'bob', smell => 'awful', dep_id => $dep_id } ); $emp_t->insert( values => { name => 'rachel', smell => 'horrid', dep_id => $dep_id } ); $emp_t->insert( values => { name => 'al', smell => 'bad', dep_id => $dep_id } ); { my @emps; eval_ok ( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('name') ] )->all_rows }, "Select all employee rows with arrayref to order_by" ); is( scalar @emps, 4, "There should be 4 rows in the employee table" ); is( $emps[0]->select('name'), 'al', "First row name should be al" ); is( $emps[1]->select('name'), 'bob', "Second row name should be bob" ); is( $emps[2]->select('name'), 'rachel', "Third row name should be rachel" ); is( $emps[3]->select('name'), 'unit 2', "Fourth row name should be 'unit 2'" ); } { my @emps; eval_ok ( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('name') ], quote_identifiers => 1, )->all_rows }, "Select all employee rows with arrayref to order_by with quote_identifiers" ); is( scalar @emps, 4, "There should be 4 rows in the employee table" ); is( $emps[0]->select('name'), 'al', "First row name should be al" ); is( $emps[1]->select('name'), 'bob', "Second row name should be bob" ); is( $emps[2]->select('name'), 'rachel', "Third row name should be rachel" ); is( $emps[3]->select('name'), 'unit 2', "Fourth row name should be 'unit 2'" ); } { my @emps; eval_ok( sub { @emps = $emp_t->all_rows( order_by => $emp_t->column('name') )->all_rows }, "Select all employee rows with column obj to order_by" ); is( scalar @emps, 4, "There should be 4 rows in the employee table" ); is( $emps[0]->select('name'), 'al', "First row name should be al" ); is( $emps[1]->select('name'), 'bob', "Second row name should be bob" ); is( $emps[2]->select('name'), 'rachel', "Third row name should be rachel" ); is( $emps[3]->select('name'), 'unit 2', "Fourth row name should be 'unit 2'" ); } { my @emps; eval_ok( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('name') ] )->all_rows }, "Select all employee rows with arrayref to order_by" ); is( scalar @emps, 4, "There should be 4 rows in the employee table" ); is( $emps[0]->select('name'), 'al', "First row name should be al" ); is( $emps[1]->select('name'), 'bob', "Second row name should be bob" ); is( $emps[2]->select('name'), 'rachel', "Third row name should be rachel" ); is( $emps[3]->select('name'), 'unit 2', "Fourth row name should be 'unit 2'" ); } { my @emps; eval_ok( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('smell') ] )->all_rows }, "Select all employee rows with arrayref to order_by (by smell)" ); is( scalar @emps, 4, "There should be 4 rows in the employee table" ); is( $emps[0]->select('name'), 'bob', "First row name should be bob" ); is( $emps[1]->select('name'), 'al', "Second row name should be al" ); is( $emps[2]->select('name'), 'unit 2', "Third row name should be 'unit 2'" ); is( $emps[3]->select('name'), 'rachel', "Fourth row name should be rachel" ); } { my @emps; eval_ok( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('smell'), 'desc' ] )->all_rows }, "Select all employee rows order by smell (descending)" ); is( $emps[0]->select('name'), 'rachel', "First row name should be rachel" ); is( $emps[1]->select('name'), 'unit 2', "Second row name should be 'unit 2'" ); is( $emps[2]->select('name'), 'al', "Third row name should be al" ); is( $emps[3]->select('name'), 'bob', "Fourth row name should be bob" ); } eval_ok( sub { $count = $emp_t->row_count }, "Call row_count for employee table" ); is( $count, 4, "The count should be 4" ); eval_ok( sub { $count = $emp_t->function( select => COUNT( $emp_t->column('employee_id') ) ) }, "Get row count via ->function method" ); is( $count, 4, "There should still be just 4 rows" ); { my $one; eval_ok( sub { $one = $emp_t->function( select => 1 ) }, "Get '1' via ->function method" ); is( $one, 1, "Getting '1' via ->function should return 1" ); } { my $statement; eval_ok( sub { $statement = $emp_t->select( select => COUNT( $emp_t->column('employee_id') ) ) }, "Get row count via even spiffier new ->select method" ); isa_ok( $statement, 'Alzabo::DriverStatement', "Return value from Table->select method" ); $count = $statement->next; is( $count, 4, "There should still be just 4 rows" ); } { my $st; eval_ok( sub { $st = $emp_t->select( select => 1 ) }, "Get '1' via ->select method" ); is( $st->next, 1, "Getting '1' via ->select should return 1" ); } { my @emps; eval_ok( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('smell'), 'desc' ], limit => 2 )->all_rows }, "Get all employee rows with ORDER BY and LIMIT" ); is( scalar @emps, 2, "This should only return 2 rows" ); is( $emps[0]->select('name'), 'rachel', "First row should be rachel" ); is( $emps[1]->select('name'), 'unit 2', "Second row is 'unit 2'" ); } { my @emps; eval_ok( sub { @emps = $emp_t->all_rows( order_by => [ $emp_t->column('smell'), 'desc' ], limit => [2, 2] )->all_rows }, "Get all employee rows with ORDER BY and LIMIT (with offset)" ); is( scalar @emps, 2, "This should only return 2 rows" ); is( $emps[0]->select('name'), 'al', "First row should be al" ); is( $emps[1]->select('name'), 'bob', "Second row is bob" ); } $emp_t->set_prefetch( $emp_t->columns( qw( name smell ) ) ); my @p = $emp_t->prefetch; is( scalar @p, 2, "Prefetch method should return 2 column names" ); is( scalar ( grep { $_ eq 'name' } @p ), 1, "One column should be 'name'" ); is( scalar ( grep { $_ eq 'smell' } @p ), 1, "And the other should be 'smell'" ); is( $emp_t->row_count, 4, "employee table should have 4 rows" ); { my @emps = $emp_t->all_rows( order_by => [ $emp_t->column('smell'), 'desc' ], limit => [2, 2] )->all_rows; my $smell = $emps[0]->select('smell'); is( $emp_t->row_count( where => [ $emp_t->column('smell'), '=', $smell ] ), 1, "Call row_count method with where parameter." ); $emps[0]->delete; eval { $emps[0]->update( smell => 'kaboom' ); }; $e = $@; isa_ok( $e, 'Alzabo::Exception::NoSuchRow', "Exception thrown from attempt to update a deleted row" ); my $row_id = $emps[1]->id_as_string; my $row; eval_ok( sub { $row = $emp_t->row_by_id( row_id => $row_id ) }, "Fetch a row via the ->row_by_id method" ); is( $row->id_as_string, $emps[1]->id_as_string, "Row retrieved via the ->row_by_id method should be the same as the row whose id was used" ); } $emp_t->insert( values => { employee_id => 9000, name => 'bob9000', smell => 'a', dep_id => $dep_id } ); $emp_t->insert( values => { employee_id => 9001, name => 'bob9001', smell => 'b', dep_id => $dep_id } ); $emp_t->insert( values => { employee_id => 9002, name => 'bob9002', smell => 'c', dep_id => $dep_id } ); my $eid_c = $emp_t->column('employee_id'); { my @emps = $emp_t->rows_where( where => [ [ $eid_c, '=', 9000 ], 'or', [ $eid_c, '=', 9002 ] ] )->all_rows; @emps = sort { $a->select('employee_id') <=> $b->select('employee_id') } @emps; is( @emps, 2, "Do a query with 'or' and count the rows" ); is( $emps[0]->select('employee_id'), 9000, "First row returned should be employee id 9000" ); is( $emps[1]->select('employee_id'), 9002, "Second row returned should be employee id 9002" ); } { my @emps = $emp_t->rows_where( where => [ [ $emp_t->column('smell'), '!=', 'c' ], 'and', ( '(', [ $eid_c, '=', 9000 ], 'or', [ $eid_c, '=', 9002 ], ')', ), ] )->all_rows; is( @emps, 1, "Do another complex query with 'or' and subgroups" ); is( $emps[0]->select('employee_id'), 9000, "The row returned should be employee id 9000" ); } { my @emps = $emp_t->rows_where( where => [ ( '(', [ $eid_c, '=', 9000 ], 'and', [ $eid_c, '=', 9000 ], ')', ), 'or', ( '(', [ $eid_c, '=', 9000 ], 'and', [ $eid_c, '=', 9000 ], ')', ), ] )->all_rows; is( @emps, 1, "Do another complex query with 'or', 'and' and subgroups" ); is( $emps[0]->select('employee_id'), 9000, "The row returned should be employee id 9000" ); } { my @emps = $emp_t->rows_where( where => [ $eid_c, 'between', 9000, 9002 ] )->all_rows; @emps = sort { $a->select('employee_id') <=> $b->select('employee_id') } @emps; is( @emps, 3, "Select using between should return 3 rows" ); is( $emps[0]->select('employee_id'), 9000, "First row returned should be employee id 9000" ); is( $emps[1]->select('employee_id'), 9001, "Second row returned should be employee id 9001" ); is( $emps[2]->select('employee_id'), 9002, "Third row returned should be employee id 9002" ); } { my @emps; eval_ok( sub { @emps = $emp_t->rows_where( where => [ '(', '(', [ $eid_c, '=', 9000 ], ')', ')' ] )->all_rows }, "Nested subgroups should be allowed" ); is( @emps, 1, "Query with nested subgroups should return 1 row" ); is( $emps[0]->select('employee_id'), 9000, "The row returned should be employee id 9000" ); } $emp_t->insert( values => { name => 'Smelly', smell => 'a', dep_id => $dep_id, } ); { my @emps = eval { $emp_t->rows_where( where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ] )->all_rows }; is( @emps, 4, "There should be only 4 employees where the length of the smell column is 1" ); } { my @emps; eval_ok( sub { @emps = $emp_t->rows_where( where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ], limit => 2 )->all_rows }, "Select all employee rows with WHERE and LIMIT" ); is( scalar @emps, 2, "Limit should cause only two employee rows to be returned" ); } { my @emps; eval_ok( sub { @emps = $emp_t->rows_where( where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ], order_by => $emp_t->column('smell'), limit => 2 )->all_rows }, "Select all employee rows with WHERE, ORDER BY, and LIMIT" ); is( scalar @emps, 2, "Limit should cause only two employee rows to be returned (again)" ); } { my @emps; eval_ok( sub { @emps = $emp_t->rows_where( where => [ '(', [ $emp_t->column('employee_id'), '=', 9000 ], ')', ], order_by => $emp_t->column('employee_id') )->all_rows }, "Query with subgroup followed by order by" ); is( @emps, 1, "Query with subgroup followed by order by should return 1 row" ); is( $emps[0]->select('employee_id'), 9000, "The row returned should be employee id 9000" ); } my @smells = $emp_t->function( select => [ $emp_t->column('smell'), COUNT( $emp_t->column('smell') ) ], group_by => $emp_t->column('smell') ); # map smell to count my %smells = map { $_->[0] => $_->[1] } @smells; is( @smells, 6, "Query with group by should return 6 values" ); is( $smells{a}, 2, "Check count of smell = 'a'" ); is( $smells{b}, 1, "Check count of smell = 'b'" ); is( $smells{c}, 1, "Check count of smell = 'c'" ); is( $smells{awful}, 1, "Check count of smell = 'awful'" ); is( $smells{good}, 1, "Check count of smell = 'good'" ); is( $smells{horrid}, 1, "Check count of smell = 'horrid'" ); { my $statement = $emp_t->select( select => [ $emp_t->column('smell'), COUNT( $emp_t->column('smell') ) ], group_by => $emp_t->column('smell') ); my @smells = $statement->all_rows; # map smell to count %smells = map { $_->[0] => $_->[1] } @smells; is( @smells, 6, "Query with group by should return 6 values - via ->select" ); is( $smells{a}, 2, "Check count of smell = 'a' - via ->select" ); is( $smells{b}, 1, "Check count of smell = 'b' - via ->select" ); is( $smells{c}, 1, "Check count of smell = 'c' - via ->select" ); is( $smells{awful}, 1, "Check count of smell = 'awful' - via ->select" ); is( $smells{good}, 1, "Check count of smell = 'good' - via ->select" ); is( $smells{horrid}, 1, "Check count of smell = 'horrid' - via ->select" ); } @rows = $emp_t->function( select => $emp_t->column('smell'), where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ], order_by => $emp_t->column('smell') ); is( @rows, 4, "There should only be four rows which have a single character smell" ); is( $rows[0], 'a', "First smell should be 'a'" ); is( $rows[1], 'a', "Second smell should be 'a'" ); is( $rows[2], 'b', "Third smell should be 'b'" ); is( $rows[3], 'c', "Fourth smell should be 'c'" ); { my $statement = $emp_t->select( select => $emp_t->column('smell'), where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ], order_by => $emp_t->column('smell') ); my @rows = $statement->all_rows; is( @rows, 4, "There should only be four rows which have a single character smell - via ->select" ); is( $rows[0], 'a', "First smell should be 'a' - via ->select" ); is( $rows[1], 'a', "Second smell should be 'a' - via ->select" ); is( $rows[2], 'b', "Third smell should be 'b' - via ->select" ); is( $rows[3], 'c', "Fourth smell should be 'c' - via ->select" ); } @rows = $emp_t->function( select => $emp_t->column('smell'), where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ], order_by => $emp_t->column('smell'), limit => 2, ); is( @rows, 2, "There should only be two rows which have a single character smell - with limit" ); is( $rows[0], 'a', "First smell should be 'a' - with limit" ); is( $rows[1], 'a', "Second smell should be 'a' - with limit" ); { my $statement = $emp_t->select( select => $emp_t->column('smell'), where => [ LENGTH( $emp_t->column('smell') ), '=', 1 ], order_by => $emp_t->column('smell'), limit => 2, ); my @rows = $statement->all_rows; is( @rows, 2, "There should only be two rows which have a single character smell - with limit via ->select" ); is( $rows[0], 'a', "First smell should be 'a' - with limit via ->select" ); is( $rows[1], 'a', "Second smell should be 'a' - with limit via ->select" ); } my $extend_id = $proj{extend}->select('project_id'); my $embrace_id = $proj{embrace}->select('project_id'); foreach ( [ 9000, $extend_id ], [ 9000, $embrace_id ], [ 9001, $extend_id ], [ 9002, $extend_id ] ) { $emp_proj_t->insert( values => { employee_id => $_->[0], project_id => $_->[1] } ); } # find staffed projects @rows = $s->function( select => [ $proj_t->column('name'), COUNT( $proj_t->column('name') ) ], join => [ $emp_proj_t, $proj_t ], group_by => $proj_t->column('name') ); is( @rows, 2, "Only two projects should be returned from schema->function" ); is( $rows[0][0], 'Embrace', "First project should be Embrace" ); is( $rows[1][0], 'Extend', "Second project should be Extend" ); is( $rows[0][1], 1, "First project should have 1 employee" ); is( $rows[1][1], 3, "Second project should have 3 employees" ); { my $statement = $s->select( select => [ $proj_t->column('name'), COUNT( $proj_t->column('name') ) ], join => [ $emp_proj_t, $proj_t ], group_by => $proj_t->column('name') ); my @rows = $statement->all_rows; is( @rows, 2, "Only two projects should be returned from schema->select" ); is( $rows[0][0], 'Embrace', "First project should be Embrace - via ->select" ); is( $rows[1][0], 'Extend', "Second project should be Extend - via ->select" ); is( $rows[0][1], 1, "First project should have 1 employee - via ->select" ); is( $rows[1][1], 3, "Second project should have 3 employees - via ->select" ); } @rows = $s->function( select => [ $proj_t->column('name'), COUNT( $proj_t->column('name') ) ], join => [ $emp_proj_t, $proj_t ], group_by => $proj_t->column('name'), limit => [1, 1], ); is( @rows, 1, "Only one projects should be returned from schema->function - with limit" ); is( $rows[0][0], 'Extend', "First project should be Extend - with limit" ); is( $rows[0][1], 3, "First project should have 3 employees - with limit" ); { my $statement = $s->select( select => [ $proj_t->column('name'), COUNT( $proj_t->column('name') ) ], join => [ $emp_proj_t, $proj_t ], group_by => $proj_t->column('name'), limit => [1, 1], ); my @rows = $statement->all_rows; is( @rows, 1, "Only one projects should be returned from schema->select - with limit via ->select" ); is( $rows[0][0], 'Extend', "First project should be Extend - with limit via ->select" ); is( $rows[0][1], 3, "First project should have 3 employees - with limit via ->select" ); } { my @rows = $s->function( select => [ $proj_t->column('name'), COUNT( $proj_t->column('name') ) ], join => [ $emp_proj_t, $proj_t ], group_by => $proj_t->column('name'), order_by => [ COUNT( $proj_t->column('name') ), 'DESC' ] ); is( @rows, 2, "Only two projects should be returned from schema->function ordered by COUNT(*)" ); is( $rows[0][0], 'Extend', "First project should be Extend" ); is( $rows[1][0], 'Embrace', "Second project should be Embrace" ); is( $rows[0][1], 3, "First project should have 3 employee" ); is( $rows[1][1], 1, "Second project should have 1 employees" ); } { my @rows = $s->function( select => [ $proj_t->column('name'), COUNT( $proj_t->column('name') ) ], join => [ $emp_proj_t, $proj_t ], group_by => $proj_t->column('name'), order_by => [ COUNT( $proj_t->column('name') ), 'DESC' ], having => [ COUNT( $proj_t->column('name') ), '>', 2 ], ); is( @rows, 1, "Only one project should be returned from schema->function ordered by COUNT(*) HAVING COUNT(*) > 2" ); is( $rows[0][0], 'Extend', "First project should be Extend" ); is( $rows[0][1], 3, "First project should have 3 employee" ); } { my @rows; eval_ok( sub { @rows = $s->function( select => 1, join => [ $emp_proj_t, $proj_t ], ) }, "Call schema->function with scalar select" ); is( @rows, 4, "Should return four rows" ); } { my $st; eval_ok( sub { $st = $s->select( select => 1, join => [ $emp_proj_t, $proj_t ], ) }, "Call schema->select with scalar select" ); my @rows = $st->all_rows; is( @rows, 4, "Should return four rows" ); } my $p1 = $proj_t->insert( values => { name => 'P1', department_id => $dep_id, } ); my $p2 = $proj_t->insert( values => { name => 'P2', department_id => $dep_id, } ); eval_ok( sub { $cursor = $s->join( distinct => $dep_t, join => [ $dep_t, $proj_t ], where => [ $proj_t->column('project_id'), 'in', map { $_->select('project_id') } $p1, $p2 ], ) }, "Do a join with distinct parameter set" ); @rows = $cursor->all_rows; is( scalar @rows, 1, "Setting distinct should cause only a single row to be returned" ); is( $rows[0]->select('department_id'), $dep_id, "Returned row's department_id should be $dep_id" ); { eval_ok( sub { $cursor = $s->join( distinct => $emp_proj_t, join => [ $emp_t, $emp_proj_t ], where => [ $emp_t->column('employee_id'), 'in', 9001 ], ) }, "Do a join with distinct parameter set to a table with a multi-col PK" ); @rows = $cursor->all_rows; is( scalar @rows, 1, "Setting distinct should cause only a single row to be returned" ); is( $rows[0]->select('employee_id'), 9001, "Returned row's employee_id should be 9001" ); } { eval_ok( sub { $cursor = $s->join ( distinct => [ $emp_t, $emp_proj_t ], join => [ $emp_t, $emp_proj_t ], where => [ $emp_t->column('employee_id'), 'in', 9000, 9001 ], ) }, "Do a join with distinct parameter set to a table with a multi-col PK" ); @rows = $cursor->all_rows; is( scalar @rows, 3, "Setting distinct should cause only three rows to be returned" ); ok( ( grep { $_->[0]->select('employee_id') == 9000 } @rows ), "Returned rows should include employee_id 9000" ); ok( ( grep { $_->[0]->select('employee_id') == 9001 } @rows ), "Returned rows should include employee_id 9001" ); } { $proj_t->insert( values => { name => 'P99', department_id => $dep{lying}->select('department_id'), } ); eval_ok( sub { $cursor = $s->join( distinct => $dep_t, join => [ $dep_t, $proj_t ], order_by => $proj_t->column('name'), ) }, "Do a join with distinct and order_by not in select" ); @rows = $cursor->all_rows; if ( $rdbms eq 'pg' ) { is( scalar @rows, 5, "distinct should cause only five rows to be returned" ); } else { is( scalar @rows, 2, "distinct should cause only two rows to be returned" ); } is( $rows[0]->select('department_id'), $dep{borg}->select('department_id'), 'first row is borg department' ); is( $rows[-1]->select('department_id'), $dep{lying}->select('department_id'), 'last row is lying department' ); # Prevents a warning later about destroying a DBI handle with # active statement handles. undef $cursor; } # insert rows used to test order by with multiple columns my $start_id = 999_990; foreach ( [ qw( OB1 bad ) ], [ qw( OB1 worse ) ], [ qw( OB2 bad ) ], [ qw( OB2 worse ) ], [ qw( OB3 awful ) ], [ qw( OB3 bad ) ], ) { $emp_t->insert( values => { employee_id => $start_id++, name => $_->[0], smell => $_->[1], dep_id => $dep_id } ); } @rows = $emp_t->rows_where( where => [ $emp_t->column('employee_id'), 'BETWEEN', 999_990, 999_996 ], order_by => [ $emp_t->columns( 'name', 'smell' ) ] )->all_rows; is( $rows[0]->select('name'), 'OB1', "First row name should be OB1" ); is( $rows[0]->select('smell'), 'bad', "First row smell should be bad" ); is( $rows[1]->select('name'), 'OB1', "Second row name should be OB1" ); is( $rows[1]->select('smell'), 'worse', "Second row smell should be bad" ); is( $rows[2]->select('name'), 'OB2', "Third row name should be OB2" ); is( $rows[2]->select('smell'), 'bad', "Third row smell should be bad" ); is( $rows[3]->select('name'), 'OB2', "Fourth row name should be OB2" ); is( $rows[3]->select('smell'), 'worse', "Fourth row smell should be worse" ); is( $rows[4]->select('name'), 'OB3', "Fifth row name should be OB3" ); is( $rows[4]->select('smell'), 'awful', "Fifth row smell should be awful" ); is( $rows[5]->select('name'), 'OB3', "Sixth row name should be OB3" ); is( $rows[5]->select('smell'), 'bad', "Sixth row smell should be bad" ); @rows = $emp_t->rows_where( where => [ $emp_t->column('employee_id'), 'BETWEEN', 999_990, 999_996 ], order_by => [ $emp_t->column('name'), 'desc', $emp_t->column('smell'), 'asc' ] )->all_rows; is( $rows[0]->select('name'), 'OB3', "First row name should be OB3" ); is( $rows[0]->select('smell'), 'awful', "First row smell should be awful" ); is( $rows[1]->select('name'), 'OB3', "Second row name should be OB3" ); is( $rows[1]->select('smell'), 'bad', "Second row smell should be bad" ); is( $rows[2]->select('name'), 'OB2', "Third row name should be OB2" ); is( $rows[2]->select('smell'), 'bad', "Third row smell should be bad" ); is( $rows[3]->select('name'), 'OB2', "Fourth row name should be OB2" ); is( $rows[3]->select('smell'), 'worse', "Fourth row smell should be worse" ); is( $rows[4]->select('name'), 'OB1', "Fifth row name should be OB1" ); is( $rows[4]->select('smell'), 'bad', "Fifth row smell should be bad" ); is( $rows[5]->select('name'), 'OB1', "Sixth row name should be OB1" ); is( $rows[5]->select('smell'), 'worse', "Sixth row smell should be worse" ); if ( $rdbms eq 'mysql' ) { my $emp; eval_ok( sub { $emp = $emp_t->insert( values => { name => UNIX_TIMESTAMP(), dep_id => $dep_id } ) }, "Insert using SQL function UNIX_TIMESTAMP()" ); like( $emp->select('name'), qr/\d+/, "Name should be all digits (unix timestamp)" ); eval_ok( sub { $emp->update( name => LOWER('FOO') ) }, "Do update using SQL function LOWER()" ); is( $emp->select('name'), 'foo', "Name should be 'foo'" ); eval_ok( sub { $emp->update( name => REPEAT('Foo', 3) ) }, "Do update using SQL function REPEAT()" ); is( $emp->select('name'), 'FooFooFoo', "Name should be 'FooFooFoo'" ); eval_ok( sub { $emp->update( name => UPPER( REPEAT('Foo', 3) ) ) }, "Do update using nested SQL functions UPPER(REPEAT())" ); is( $emp->select('name'), 'FOOFOOFOO', "Name should be 'FOOFOOFOO'" ); $emp_t->insert( values => { name => 'Timestamp', dep_id => $dep_id, tstamp => time - 100_000 } ); my $cursor; eval_ok( sub { $cursor = $emp_t->rows_where( where => [ [ $emp_t->column('tstamp'), '!=', undef ], [ $emp_t->column('tstamp'), '<', UNIX_TIMESTAMP() ] ] ) }, "Do select with where condition that uses SQL function UNIX_TIMESTAMP()" ); my @rows = $cursor->all_rows; is( scalar @rows, 1, "Only one row should have a timestamp value that is not null and that is less than the current time" ); is( $rows[0]->select('name'), 'Timestamp', "That row should be named Timestamp" ); # Fulltext support tests my $snuffle_id = $emp_t->insert( values => { name => 'snuffleupagus', smell => 'invisible', dep_id => $dep_id } )->select('employee_id'); @rows = $emp_t->rows_where( where => [ MATCH( $emp_t->column('name') ), AGAINST('abathraspus') ] )->all_rows; is( @rows, 0, "Make sure that fulltext search doesn't give a false positive" ); @rows = $emp_t->rows_where( where => [ MATCH( $emp_t->column('name') ), AGAINST('snuffleupagus') ] )->all_rows; is( @rows, 1, "Make sure that fulltext search for snuffleupagus returns 1 row" ); is( $rows[0]->select('employee_id'), $snuffle_id, "Make sure that the returned row is snuffleupagus" ); my $rows = $emp_t->function( select => [ $emp_t->column('employee_id'), MATCH( $emp_t->column('name') ), AGAINST('snuffleupagus') ], where => [ MATCH( $emp_t->column('name') ), AGAINST('snuffleupagus') ] ); my ($id, $score) = @$rows; is( $id, $snuffle_id, "Returned row should still be snuffleupagus" ); like( $score, qr/\d+(?:\.\d+)?/, "Returned score should be some sort of number (integer or floating point)" ); ok( $score > 0, "The score should be greater than 0 because the match was successful" ); eval_ok( sub { @rows = $emp_t->all_rows( order_by => [ IF( 'employee_id < 100', $emp_t->column('employee_id'), $emp_t->column('smell') ), $emp_t->column('employee_id'), ], )->all_rows }, "Order by IF() function" ); is( @rows, 16, "Seventeen rows should have been returned" ); is( $rows[0]->select('employee_id'), 3, "First row should be id 3" ); is( $rows[-1]->select('employee_id'), 999993, "Last row should be id 999993" ); eval_ok( sub { @rows = $emp_t->all_rows( order_by => RAND() )->all_rows }, "order by RAND()" ); is ( @rows, 16, "This should return 16 rows" ); } elsif ( $rdbms eq 'pg' ) { my $emp; eval_ok( sub { $emp = $emp_t->insert( values => { name => NOW(), dep_id => $dep_id } ) }, "Do insert using SQL function NOW()" ); like( $emp->select('name'), qr/\d+/, "Name should be all digits (Postgres timestamp)" ); eval_ok( sub { $emp->update( name => LOWER('FOO') ) }, "Do update using SQL function LOWER()" ); is( $emp->select('name'), 'foo', "Name should be 'foo'" ); eval_ok( sub { $emp->update( name => REPEAT('Foo', 3) ) }, "Do update using SQL function REPEAT()" ); is( $emp->select('name'), 'FooFooFoo', "Name should be 'FooFooFoo'" ); eval_ok( sub { $emp->update( name => UPPER( REPEAT('Foo', 3) ) ) }, "Do update using nested SQL functions UPPER(REPEAT())" ); is( $emp->select('name'), 'FOOFOOFOO', "Name should be 'FOOFOOFOO'" ); $emp_t->insert( values => { name => 'Timestamp', dep_id => $dep_id, tstamp => time - 100_000 } ); my $cursor; eval_ok( sub { $cursor = $emp_t->rows_where( where => [ [ $emp_t->column('tstamp'), '!=', undef ], [ $emp_t->column('tstamp'), '<', NOW() ] ] ) }, "Do select with where condition that uses SQL function NOW()" ); my @rows = $cursor->all_rows; is( scalar @rows, 1, "Only one row should have a timestamp value that is not null and that is less than the current time" ); is( $rows[0]->select('name'), 'Timestamp', "That row should be named Timestamp" ); } # Potential rows my $p_emp; eval_ok( sub { $p_emp = $emp_t->potential_row }, "Create potential row object"); is( $p_emp->is_live, 0, "potential_row should ! ->is_live" ); is( $p_emp->select('smell'), 'grotesque', "Potential Employee should have default smell, 'grotesque'" ); { my $updated = $p_emp->update( cash => undef, smell => 'hello!' ); ok( $updated, 'update() did change values' ); ok( ! defined $p_emp->select('cash'), "Potential Employee cash column is not defined" ); } { my $updated = $p_emp->update( cash => undef, smell => 'hello!' ); ok( ! $updated, 'update() did not change values' ); } is( $p_emp->select('smell'), 'hello!', "smell for employee should be 'hello!' after update" ); $p_emp->update( name => 'Ilya' ); is( $p_emp->select('name'), 'Ilya', "New employee got a name" ); $p_emp->update( dep_id => $dep_id ); is( $p_emp->select('dep_id'), $dep_id, "New employee got a department" ); eval { $p_emp->update( wrong => 'column' ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::Params', "Exception thrown from attempt to update a column which doesn't exist" ); eval { $p_emp->update( name => undef ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::NotNullable', "Exception thrown from attempt to update a non-NULLable column in a potential row to null" ); eval_ok( sub { $p_emp->make_live( values => { smell => 'cottony' } ) }, "Make potential row live"); is( $p_emp->select('name'), 'Ilya', "Formerly potential employee row object should have same name as before" ); is( $p_emp->select('smell'), 'cottony', "Formerly potential employee row object should have new smell of 'cottony'" ); eval_ok ( sub { $p_emp->delete }, "Delete new employee" ); eval_ok( sub { $p_emp = $emp_t->potential_row( values => { cash => 100 } ) }, "Create potential row object and set some fields "); is( $p_emp->select('cash'), 100, "Employee cash should be 100" ); eval { $emp_t->rows_where( where => [ $eid_c, '=', 9000, $eid_c, '=', 9002 ] ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception::Params', "Exception from where clause as single arrayref with <>3 elements" ); { # test that DriverStatement objects going out of scope leave # $@ alone! eval { my $cursor = $emp_t->all_rows; die "ok\n"; }; is( $@, "ok\n", "\$\@ should be 'ok'" ); } { my $row; eval_ok( sub { $row = $emp_t->one_row ( where => [ $emp_t->column('name'), '=', 'nonexistent' ] ) }, "Call ->one_row with a query guaranteed to fail" ); ok( ! defined $row, "Make sure that the query really returned nothing" ); } { is( scalar $proj_t->prefetch, ( scalar $proj_t->columns - $proj_t->primary_key_size - scalar ( grep { $_->is_blob } $proj_t->columns ) ), "Check that schema->prefetch_all_but_blobs is on by default" ); } { $proj_t->set_prefetch(); $s->prefetch_all; is( scalar $proj_t->prefetch, ( scalar $proj_t->columns - scalar $proj_t->primary_key_size ), "Check that schema->prefetch_all works" ); } { $proj_t->set_prefetch(); $s->prefetch_all_but_blobs; is( scalar $proj_t->prefetch, ( scalar $proj_t->columns - $proj_t->primary_key_size - scalar ( grep { $_->is_blob } $proj_t->columns ) ), "Check that schema->prefetch_all_but_blobs works" ); } { $s->prefetch_none; is( scalar $proj_t->prefetch, 0, "Check that schema->prefetch_none works" ); } { $s->prefetch_all; my $cursor; eval_ok( sub { $cursor = $s->join( join => [ $emp_t, $emp_proj_t, $proj_t ], where => [ $emp_t->column('employee_id'), '=', 9001 ] ) }, "Join with join as arrayref of arrayrefs" ); my @rows = $cursor->next; is( scalar @rows, 3, "3 rows per cursor ->next call" ); is( ( grep { defined } @rows ), 3, "Make sure all rows are defined" ); is( $rows[0]->select('employee_id'), 9001, "First rows should have employee_id == 9001" ); is( $rows[0]->select('name'), 'bob9001', "First rows should have employee with name eq 'bob9001'" ); is( $rows[2]->select('name'), 'Extend', "First rows should have project with name eq 'Extend'"); } { my $foo = $emp_t->column('employee_id')->alias( as => 'foo' ); my $st = $emp_t->select( select => $foo ); my %h = $st->next_as_hash; is( exists $h{foo}, 1, "next_as_hash should return a hash with a 'foo' key" ); } $s->disconnect; } Alzabo-0.92/t/07-methodmaker.t0000444000175000017500000004371410721343227015700 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Spec; use lib '.', File::Spec->catdir( File::Spec->curdir, 't', 'lib' ); use Alzabo::Test::Utils; use Test::More; my @rdbms_names = Alzabo::Test::Utils->rdbms_names; unless (@rdbms_names) { plan skip_all => 'no test config provided'; exit; } plan tests => 106; Alzabo::Test::Utils->remove_all_schemas; use Alzabo::Create::Schema; use Alzabo::Runtime::Schema; require Alzabo::MethodMaker; # doesn't matter which RDBMS is used my $rdbms = $rdbms_names[0]; my $config = Alzabo::Test::Utils->test_config_for($rdbms); # these tests use a different schema than the other live DB tests make_methodmaker_schema(%$config); Alzabo::MethodMaker->import( schema => $config->{schema_name}, all => 1, class_root => 'Alzabo::MM::Test', name_maker => \&namer, ); my $s = Alzabo::Runtime::Schema->load_from_file( name => $config->{schema_name} ); eval { $s->docs_as_pod }; ok( ! $@, 'docs_as_pod should not cause an exception' ); foreach my $t ($s->tables) { my $t_meth = $t->name . '_t'; ok( $s->can($t_meth), "Schema object should have $t_meth method" ); is( $s->$t_meth(), $t, "Results of \$s->$t_meth() should be same as existing table object" ); foreach my $c ($t->columns) { my $c_meth = $c->name . '_c'; ok( $t->can($c_meth), "Table object should have $t_meth method" ); is( $t->$c_meth(), $c, "Results of \$t->$c_meth() should be same as existing column object" ); } } ok( Alzabo::MM::Test::Row::Toilet->can('NotLinkings'), "Toilet should method to fetch NotLinking rows" ); ok( Alzabo::MM::Test::Row::Location->can('NotLinkings'), "Location should method to fetch NotLinking rows" ); isa_ok( $s->Toilet_t, 'Alzabo::MM::Test::Table' ); { $s->connect( Alzabo::Test::Utils->connect_params_for($rdbms) ); $s->set_referential_integrity(1); # needed for Pg! $s->set_quote_identifiers(1); my $char = 'a'; my $loc1 = $s->Location_t->insert( values => { location_id => 1, location => $a++ } ); isa_ok( $loc1, 'Alzabo::MM::Test::Row' ); $s->Location_t->insert( values => { location_id => 2, location => $a++, parent_location_id => 1 } ); $s->Location_t->insert( values => { location_id => 3, location => $a++, parent_location_id => 1 } ); $s->Location_t->insert( values => { location_id => 4, location => $a++, parent_location_id => 2 } ); my $loc5 = $s->Location_t->insert( values => { location_id => 5, location => $a++, parent_location_id => 4 } ); ok( ! defined $loc1->parent, "First location should not have a parent" ); my @c = $loc1->children( order_by => $s->Location_t->location_id_c ) ->all_rows; is( scalar @c, 2, "First location should have 2 children" ); is( $c[0]->location_id, 2, "First child location id should be 2" ); is( $c[1]->location_id, 3, "Second child location id should be 3" ); is( $loc5->parent->location_id, 4, "Location 5's parent should be 4" ); $loc1->location('Set method'); is( $loc1->location, 'Set method', "Update location column via ->location method" ); } { eval { $s->Location_t->insert( values => { location_id => 666, location => 'pre_die' } ) }; my $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown from pre_insert" ); is( $e->error, 'PRE INSERT TEST', "pre_insert error message should be PRE INSERT TEST" ); eval { $s->Location_t->insert( values => { location_id => 666, location => 'post_die' } ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by post_insert" ); is( $e->error, 'POST INSERT TEST', "pre_insert error message should be POST INSERT TEST" ); my $tweaked = $s->Location_t->insert( values => { location_id => 54321, location => 'insert tweak me' } ); is ( $tweaked->select('location'), 'insert tweaked', "pre_insert should change the value of location to 'insert tweaked'" ); eval { $tweaked->update( location => 'pre_die' ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown from pre_update" ); is( $e->error, 'PRE UPDATE TEST', "pre_update error message should be PRE UPDATE TEST" ); eval { $tweaked->update( location => 'post_die' ) }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by post_update" ); is( $e->error, 'POST UPDATE TEST', "post_update error message should be POST UPDATE TEST" ); $tweaked->update( location => 'update tweak me' ); is ( $tweaked->select('location'), 'update tweaked', "pre_update should change the value of location to 'update tweaked'" ); eval { $tweaked->select('pre_sel_die') }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by pre_select" ); is( $e->error, 'PRE SELECT TEST', "pre_select error message should be PRE SELECT TEST" ); $tweaked->update( location => 'post_sel_die' ); eval { $tweaked->select('location') }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by post_select" ); is( $e->error, 'POST SELECT TEST', "post_select error message should be POST SELECT TEST" ); eval { $tweaked->select_hash('location') }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by post_select" ); is( $e->error, 'POST SELECT TEST', "post_select error message should be POST SELECT TEST" ); $tweaked->update( location => 'select tweak me' ); is( $tweaked->select('location'), 'select tweaked', "post_select should change the value of location to 'select tweaked'" ); my %d = $tweaked->select_hash('location'); is( $d{location}, 'select tweaked', "post_select_hash should change the value of location to 'select tweaked'" ); $s->ToiletType_t->insert( values => { toilet_type_id => 1, material => 'porcelain', quality => 5 } ); my $t = $s->Toilet_t->insert( values => { toilet_id => 1, toilet_type_id => 1 } ); is( $t->material, 'porcelain', "New toilet's material method should return 'porcelain'" ); is( $t->quality, 5, "New toilet's quality method should return 5" ); $s->Location_t->insert( values => { location_id => 100, location => '# 100!' } ); $s->ToiletLocation_t->insert( values => { toilet_id => 1, location_id => 100 } ); $s->ToiletLocation_t->insert( values => { toilet_id => 1, location_id => 1 } ); my @l = $t->Locations( order_by => $s->Location_t->location_id_c )->all_rows; is( scalar @l, 2, "The toilet should have two locations" ); is( $l[0]->location_id, 1, "The first location id should be 1" ); is( $l[1]->location_id, 100, "The second location id should be 2" ); my @t = $l[0]->Toilets->all_rows; is( scalar @t, 1, "The location should have one toilet" ); is( $t[0]->toilet_id, 1, "Location's toilet id should be 1" ); my @tl = $t->ToiletLocations( order_by => $s->ToiletLocation_t->location_id_c )->all_rows; is( scalar @tl, 2, "The toilet should have two ToiletLocation rows" ); is( $tl[0]->location_id, 1, "First row's location id should be 1" ); is( $tl[0]->toilet_id, 1, "First row's toilet id should 1" ); is( $tl[1]->location_id, 100, "Second row's location id should be 100" ); is( $tl[1]->toilet_id, 1, "Second row's toilet id should 1" ); my $row = $s->Toilet_t->row_by_pk( pk => 1 ); isa_ok( $row, 'Alzabo::MM::Test::Row::Toilet', "The Toilet object" ); my $p_row = $s->Location_t->potential_row; isa_ok( $p_row, 'Alzabo::MM::Test::Row::Location', "Potential row object" ); $p_row->location( 'zzz' ); $p_row->location_id( 999 ); is( $p_row->location_id, 999, "location_id of potential object should be 99" ); is( $p_row->location, 'zzz', "Location name of potential object should be 'zzz'" ); eval { $p_row->update( location => 'pre_die' ); }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by pre_update" ); eval { $p_row->update( location => 'post_die' ); }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by post_update" ); $p_row->update( location => 'update tweak me' ); is ( $p_row->select('location'), 'update tweaked', "pre_update should change the value of location to 'update tweaked'" ); eval { $p_row->select('pre_sel_die') }; $e = $@; isa_ok( $e, 'Alzabo::Exception', "Exception thrown by pre_select" ); $p_row->update( location => 'select tweak me' ); is( $p_row->select('location'), 'select tweaked', "post_select should change the value of location to 'select tweaked'" ); %d = $p_row->select_hash('location'); is( $d{location}, 'select tweaked', "post_select_hash should change the value of location to 'select tweaked'" ); $p_row->make_live; is( $p_row->location_id, 999, "Check that live row has same location id" ); my $alias = $s->Toilet_t->alias; can_ok( $alias, 'toilet_id_c' ); is( $alias->toilet_id_c->name, $s->Toilet_t->toilet_id_c->name, "Alias column has the same name as real table's column" ); is( $alias->toilet_id_c->table, $alias, "The alias column's table should be the alias" ); # self-linking { $s->Toilet_t->insert( values => { toilet_id => $_, toilet_type_id => 1, } ) for ( 100 .. 110 ); $s->ToiletToilet_t->insert( values => { toilet_id => 100, toilet_id_2 => 106, } ); $s->ToiletToilet_t->insert( values => { toilet_id => 100, toilet_id_2 => 107, } ); $s->ToiletToilet_t->insert( values => { toilet_id => 101, toilet_id_2 => 106, } ); $s->ToiletToilet_t->insert( values => { toilet_id => 102, toilet_id_2 => 107, } ); { my $t100 = $s->Toilet_t->row_by_pk( pk => 100 ); my @child_ids = sort map { $_->toilet_id } $t100->child_toilets->all_rows; is( @child_ids, 2, 'there should be two children' ); is( $child_ids[0], 106, 'first child is 106' ); is( $child_ids[1], 107, 'second child is 107' ); } { my $t106 = $s->Toilet_t->row_by_pk( pk => 106 ); my @parent_ids = sort map { $_->toilet_id } $t106->parent_toilets->all_rows; is( @parent_ids, 2, 'there should be two parents' ); is( $parent_ids[0], 100, 'first parent is 100' ); is( $parent_ids[1], 101, 'second parent is 101' ); } { my $t107 = $s->Toilet_t->row_by_pk( pk => 107 ); my @parent_ids = sort map { $_->toilet_id } $t107->parent_toilets->all_rows; is( @parent_ids, 2, 'there should be two parents' ); is( $parent_ids[0], 100, 'first parent is 100' ); is( $parent_ids[1], 102, 'second parent is 102' ); } } } sub make_methodmaker_schema { my %p = @_; my %r = ( mysql => 'MySQL', pg => 'PostgreSQL', ); my $s = Alzabo::Create::Schema->new( name => $p{schema_name}, rdbms => $r{ delete $p{rdbms} }, ); my $loc = $s->make_table( name => 'Location' ); $loc->make_column( name => 'location_id', type => 'int', primary_key => 1 ); $loc->make_column( name => 'parent_location_id', type => 'int', nullable => 1 ); $loc->make_column( name => 'location', type => 'varchar', length => 50 ); # self relation $s->add_relationship( columns_from => $loc->column('parent_location_id'), columns_to => $loc->column('location_id'), cardinality => [ 'n', 1 ], from_is_dependent => 0, to_is_dependent => 0, ); my $toi = $s->make_table( name => 'Toilet' ); $toi->make_column( name => 'toilet_id', type => 'int', primary_key => 1 ); # linking table $s->add_relationship( table_from => $toi, table_to => $loc, cardinality => [ 'n', 'n' ], from_is_dependent => 0, to_is_dependent => 0, ); # not a linking table (for MethodMaker), because it will have an # extra column $s->add_relationship( table_from => $loc, table_to => $toi, cardinality => [ 'n', 'n' ], from_is_dependent => 0, to_is_dependent => 0, ); $s->table('LocationToilet')->set_name('NotLinking'); $s->table('NotLinking')->make_column( name => 'extra_column', type => 'int' ); my $toi_toi = $s->make_table( name => 'ToiletToilet' ); $toi_toi->make_column( name => 'toilet_id', type => 'int', primary_key => 1 ); $toi_toi->make_column( name => 'toilet_id_2', type => 'int', primary_key => 1 ); # linking table between Toilet & Toilet (self-linking) $s->add_relationship( columns_from => $toi->column('toilet_id'), columns_to => $toi_toi->column('toilet_id'), cardinality => [ '1', 'n' ], from_is_dependent => 0, to_is_dependent => 0, ); $s->add_relationship( columns_from => $toi->column('toilet_id'), columns_to => $toi_toi->column('toilet_id_2'), cardinality => [ '1', 'n' ], from_is_dependent => 0, to_is_dependent => 0, ); my $tt = $s->make_table( name => 'ToiletType' ); $tt->make_column( name => 'toilet_type_id', type => 'int', primary_key => 1 ); $tt->make_column( name => 'material', type => 'varchar', length => 50 ); $tt->make_column( name => 'quality', type => 'int', nullable => 1 ); # lookup table $s->add_relationship( table_from => $toi, table_to => $tt, cardinality => [ 'n', 1 ], from_is_dependent => 0, to_is_dependent => 0, ); $s->save_to_file; delete @p{ 'schema_name', 'rdbms' }; $s->create(%p); } sub namer { my %p = @_; return $p{table}->name . '_t' if $p{type} eq 'table'; return $p{column}->name . '_c' if $p{type} eq 'table_column'; return $p{column}->name if $p{type} eq 'row_column'; if ( $p{type} eq 'foreign_key' ) { my $name = $p{foreign_key}->table_to->name; if ($p{plural}) { my $name = my_PL( $name ); return if $name eq 'ToiletToilets'; return $name; } else { return if $name eq 'Toilet' && $p{foreign_key}->table_from->name eq 'ToiletToilet'; return $name; } } if ( $p{type} eq 'linking_table' ) { if ( $p{foreign_key}->table_from eq $p{foreign_key_2}->table_to ) { if ( ($p{foreign_key}->columns_to)[0]->name eq 'toilet_id' ) { return 'child_toilets'; } else { return 'parent_toilets'; } } my $method = $p{foreign_key}->table_to->name; my $tname = $p{foreign_key}->table_from->name; $method =~ s/^$tname\_?//; $method =~ s/_?$tname$//; return my_PL($method); } if ( $p{type} eq 'lookup_columns' ) { return if $p{column}->table->name eq 'Toilet' && $p{column}->name eq 'toilet_type_id'; return $p{column}->name; } return $p{column}->name if $p{type} eq 'lookup_columns'; return $p{parent} ? 'parent' : 'children' if $p{type} eq 'self_relation'; die "unknown type in call to naming sub: $p{type}\n"; } sub my_PL { return shift() . 's'; } { package Alzabo::MM::Test::Table::Location; sub pre_insert { my $self = shift; my $p = shift; Alzabo::Exception->throw( error => "PRE INSERT TEST" ) if $p->{values}->{location} eq 'pre_die'; $p->{values}->{location} = 'insert tweaked' if $p->{values}->{location} eq 'insert tweak me'; } sub post_insert { my $self = shift; my $p = shift; Alzabo::Exception->throw( error => "POST INSERT TEST" ) if $p->{row}->select('location') eq 'post_die'; } } { package Alzabo::MM::Test::Row::Location; sub pre_update { my $self = shift; my $p = shift; Alzabo::Exception->throw( error => "PRE UPDATE TEST" ) if $p->{location} && $p->{location} eq 'pre_die'; $p->{location} = 'update tweaked' if $p->{location} && $p->{location} eq 'update tweak me'; } sub post_update { my $self = shift; my $p = shift; Alzabo::Exception->throw( error => "POST UPDATE TEST" ) if $p->{location} && $p->{location} eq 'post_die'; } sub pre_select { my $self = shift; my $cols = shift; Alzabo::Exception->throw( error => "PRE SELECT TEST" ) if grep { $_ eq 'pre_sel_die' } @$cols; } sub post_select { my $self = shift; my $data = shift; Alzabo::Exception->throw( error => "POST SELECT TEST" ) if exists $data->{location} && $data->{location} eq 'post_sel_die'; $data->{location} = 'select tweaked' if exists $data->{location} && $data->{location} eq 'select tweak me'; } sub pre_delete { my $self = shift; Alzabo::Exception->throw( error => "PRE DELETE TEST" ) if $self->select('location') eq 'pre_del_die'; } sub post_delete { my $self = shift; # Alzabo::Exception->throw( error => "POST DELETE TEST" ); } } 1; Alzabo-0.92/install_helpers/0000755000175000017500000000000010721343227015705 5ustar autarchautarchAlzabo-0.92/install_helpers/pod_merge.pl0000444000175000017500000000600110721343227020176 0ustar autarchautarch#!/usr/bin/perl -w use strict; use File::Basename; use File::Copy; use File::Path; use File::Spec; my ($sourcedir, $libdir, $verbose) = @ARGV; foreach ($sourcedir, $libdir) { s,/$,,; } foreach ( qw( Schema Table Column ColumnDefinition Index ForeignKey ) ) { my $from = File::Spec->catfile( $sourcedir, 'Alzabo', "$_.pm" ); foreach my $class ( qw( Create Runtime ) ) { my $merge = File::Spec->catfile( $sourcedir, 'Alzabo', $class, "$_.pm" ); my $to = File::Spec->catfile( $libdir, 'Alzabo', $class, "$_.pm" ); merge( $from, $merge, $to, $class ); } } merge( File::Spec->catfile( $sourcedir, 'Alzabo.pm' ), File::Spec->catfile( $sourcedir, 'Alzabo', 'QuickRef.pod' ), File::Spec->catfile( $libdir, 'Alzabo', 'QuickRef.pod' ), ); sub merge { my ($file, $t_in, $t_out, $class) = @_; local (*FROM, *TO); open FROM, $file or die "Can't read '$file': $!"; open TO, $t_in or die "Can't read '$t_in': $!"; my $from = join '', ; my $to = join '', ; close FROM or die "Can't close '$file': $!"; close TO or die "Can't close '$t_in': $!"; $to =~ s/\r//g; $to =~ s/\n =for\ pod_merge # find this string at the beginning of a line (?: \s+ (\w+) # say what POD marker to merge from ) (?: \ + (\w+) # optionally, say what POD marker to merge until (i.e. =head3) )? .*? # what we're going to merge (and replace) \n+ (?= \n= # next =foo marker, skipping all spaces. This just makes matching stop here ) / find_chunk($file, $from, $class, $1, $2) /gxie; mkpath( dirname($t_out) ) unless -d dirname($t_out); if (-e $t_out) { chmod 0644, $t_out or die "Can't chmod '$t_out' to 644: $!"; } open TO, ">$t_out" or die "Can't write to '$t_out': $!"; print TO $to or die "Can't write to '$t_out': $!"; close TO or die "Can't write to '$t_out': $!"; chmod 0644, $t_out or die "Can't chmod '$t_out' to 444: $!"; for ( $file, $t_out ) { s,^.*(?=Alzabo),,; s/\.pm$//; s,[\\/],::,g; } print "merged $file docs into $t_out\n" if $verbose; } sub find_chunk { my ($file, $from, $class, $title, $until) = @_; my $chunk; if ($title eq 'merged') { $chunk = "\n\nNote: all relevant documentation from the superclass has been merged into this document.\n"; } else { if ( my ($l) = $from =~ /\n=head([1234]) +$title.*?\n/ ) { my $levels = join '', (1..$l); my $until_re = $until ? qr/$until/ : qr/(?:head[$levels]|cut)/; my $re = qr/(\n=head$l +$title.*?)\n=$until_re/s; ($chunk) = $from =~ /$re/; } } if (defined $class) { $chunk =~ s/Alzabo::(Column|ColumnDefinition|ForeignKey|Index|Schema|Table)/Alzabo::$class\::$1/g; } die "Can't find =headX $title in $file\n" unless $chunk; return $chunk; } Alzabo-0.92/inc/0000755000175000017500000000000010721343227013266 5ustar autarchautarchAlzabo-0.92/inc/Alzabo/0000755000175000017500000000000010721343227014476 5ustar autarchautarchAlzabo-0.92/inc/Alzabo/Build.pm0000444000175000017500000000113210721343227016066 0ustar autarchautarchpackage Alzabo::Build; use strict; use Module::Build 0.20; use base 'Module::Build'; use Data::Dumper; use File::Path; use File::Spec; sub ACTION_docs { my $self = shift; $self->depends_on('code'); $self->ACTION_pod_merge; $self->SUPER::ACTION_docs(@_); } sub ACTION_pod_merge { my $self = shift; my $script = File::Spec->catfile( 'install_helpers', 'pod_merge.pl' ); my $blib = File::Spec->catdir( qw( blib lib ) ); $self->run_perl_script( $script, '', "lib $blib" ); } sub ACTION_install { my $self = shift; $self->SUPER::ACTION_install(@_); } 1; Alzabo-0.92/inc/Alzabo/Config.pm.tmpl0000444000175000017500000000413010721343227017210 0ustar autarchautarchpackage Alzabo::Config; use File::Spec; use vars qw($VERSION %CONFIG); use strict; $VERSION = 2.0; %CONFIG = "'CONFIG'"; my $curdir = File::Spec->curdir; my $updir = File::Spec->updir; sub root_dir { $CONFIG{root_dir} = $_[0] if defined $_[0]; return $CONFIG{root_dir}; } sub schema_dir { Alzabo::Exception->throw( error => "No Alzabo root directory defined" ) unless defined $CONFIG{root_dir}; return File::Spec->catdir( $CONFIG{root_dir}, 'schemas' ); } sub available_schemas { my $dirname = Alzabo::Config::schema_dir; local *DIR; opendir DIR, $dirname or Alzabo::Exception::System->throw( error => "can't open $dirname: $!\n" ); my @s; foreach my $e (readdir DIR) { next if $e eq $curdir || $e eq $updir; my $dir = File::Spec->catdir( $dirname, $e ); push @s, $e if -d $dir && -r _ && glob "$dir/*.alz"; } closedir DIR or Alzabo::Exception::System->throw( error => "can't close $dirname: $!\n" ); return @s; } __END__ =head1 NAME Alzabo::Config - Alzabo configuration information =head1 SYNOPSIS use Alzabo::Config print Alzabo::Config::schema_dir; =head1 DESCRIPTION This module contains functions related to Alzabo configuration information. =head1 FUNCTIONS =head2 root_dir ($root) If a value is passed to this method then the root is temporarily changed. This change lasts as long as your application remains in memory. However, since changes are not written to disk it will have to be changed again. Returns the root directory for your Alzabo installation. =head2 schema_dir If no root_dir is defined, this function throws an exception. Returns the directory under which Alzabo schema objects are stored in serialized form. =head2 available_schemas If no root_dir is defined, this function throws an exception. Returns a list containing the names of the available schemas. There will be one directory for each schema under the directory returned. Directories which cannot be read will not be included in the list. Throws: L|Alzabo::Exceptions> =cut Alzabo-0.92/INSTALL0000444000175000017500000000031310721343227013541 0ustar autarchautarchAlzabo requires Perl 5.6.1 or newer. The installation process uses Module::Build 0.20 or greater. Installing Alzabo: perl Build.PL (answer the questions you're asked) ./Build test ./Build install Alzabo-0.92/META.yml0000444000175000017500000001105010721343227013761 0ustar autarchautarch--- name: Alzabo version: 0.92 author: - 'Dave Rolsky, ' abstract: A data modelling tool and RDBMS-OO mapper license: perl resources: license: http://dev.perl.org/licenses/ requires: Class::Factory::Util: 1.3 DBI: 1.21 Digest::MD5: 0 Exception::Class: 0.97 Params::Validate: 0.58 Scalar::Util: 1.01 Storable: 0.7 Test::Harness: 1.26 Test::Simple: 0.47 Tie::IxHash: 0 Time::HiRes: 0 perl: 5.006 build_requires: Pod::Man: 1.14 recommends: DBD::Pg: 1.13 DBD::mysql: 2.1017 provides: Alzabo: file: lib/Alzabo.pm version: 0.92 Alzabo::BackCompat: file: lib/Alzabo/BackCompat.pm version: 2 Alzabo::ChangeTracker: file: lib/Alzabo/ChangeTracker.pm version: 2 Alzabo::Column: file: lib/Alzabo/Column.pm version: 2 Alzabo::ColumnDefinition: file: lib/Alzabo/ColumnDefinition.pm version: 2 Alzabo::Create: file: lib/Alzabo/Create.pm version: 2 Alzabo::Create::Column: file: lib/Alzabo/Create/Column.pm version: 2 Alzabo::Create::ColumnDefinition: file: lib/Alzabo/Create/ColumnDefinition.pm version: 2 Alzabo::Create::ForeignKey: file: lib/Alzabo/Create/ForeignKey.pm version: 2 Alzabo::Create::Index: file: lib/Alzabo/Create/Index.pm version: 2 Alzabo::Create::Schema: file: lib/Alzabo/Create/Schema.pm version: 2 Alzabo::Create::Table: file: lib/Alzabo/Create/Table.pm version: 2 Alzabo::Debug: file: lib/Alzabo/Debug.pm Alzabo::Docs: file: lib/Alzabo/MethodMaker.pm Alzabo::DocumentationContainer: file: lib/Alzabo/MethodMaker.pm Alzabo::Driver: file: lib/Alzabo/Driver.pm version: 2 Alzabo::Driver::MySQL: file: lib/Alzabo/Driver/MySQL.pm version: 2 Alzabo::Driver::PostgreSQL: file: lib/Alzabo/Driver/PostgreSQL.pm version: 2 Alzabo::DriverStatement: file: lib/Alzabo/Driver.pm version: 0.1 Alzabo::Exception: file: lib/Alzabo/Exceptions.pm Alzabo::Exception::Driver: file: lib/Alzabo/Exceptions.pm Alzabo::Exceptions: file: lib/Alzabo/Exceptions.pm version: 2 Alzabo::ForeignKey: file: lib/Alzabo/ForeignKey.pm version: 2 Alzabo::Index: file: lib/Alzabo/Index.pm version: 2 Alzabo::MethodDocs: file: lib/Alzabo/MethodMaker.pm Alzabo::MethodMaker: file: lib/Alzabo/MethodMaker.pm version: 2 Alzabo::RDBMSRules: file: lib/Alzabo/RDBMSRules.pm version: 2 Alzabo::RDBMSRules::MySQL: file: lib/Alzabo/RDBMSRules/MySQL.pm version: 2 Alzabo::RDBMSRules::PostgreSQL: file: lib/Alzabo/RDBMSRules/PostgreSQL.pm version: 2 Alzabo::Runtime: file: lib/Alzabo/Runtime.pm version: 2 Alzabo::Runtime::Column: file: lib/Alzabo/Runtime/Column.pm version: 2 Alzabo::Runtime::ColumnDefinition: file: lib/Alzabo/Runtime/ColumnDefinition.pm version: 2 Alzabo::Runtime::Cursor: file: lib/Alzabo/Runtime/Cursor.pm version: 2 Alzabo::Runtime::ForeignKey: file: lib/Alzabo/Runtime/ForeignKey.pm version: 2 Alzabo::Runtime::Index: file: lib/Alzabo/Runtime/Index.pm version: 2 Alzabo::Runtime::InsertHandle: file: lib/Alzabo/Runtime/InsertHandle.pm Alzabo::Runtime::JoinCursor: file: lib/Alzabo/Runtime/JoinCursor.pm version: 2 Alzabo::Runtime::Row: file: lib/Alzabo/Runtime/Row.pm version: 2 Alzabo::Runtime::RowCursor: file: lib/Alzabo/Runtime/RowCursor.pm version: 2 Alzabo::Runtime::RowState::Deleted: file: lib/Alzabo/Runtime/RowState/Deleted.pm Alzabo::Runtime::RowState::InCache: file: lib/Alzabo/Runtime/RowState/InCache.pm Alzabo::Runtime::RowState::Live: file: lib/Alzabo/Runtime/RowState/Live.pm Alzabo::Runtime::RowState::Potential: file: lib/Alzabo/Runtime/RowState/Potential.pm Alzabo::Runtime::Schema: file: lib/Alzabo/Runtime/Schema.pm version: 2 Alzabo::Runtime::Table: file: lib/Alzabo/Runtime/Table.pm version: 2 Alzabo::Runtime::UniqueRowCache: file: lib/Alzabo/Runtime/UniqueRowCache.pm Alzabo::SQLMaker: file: lib/Alzabo/SQLMaker.pm version: 2 Alzabo::SQLMaker::Function: file: lib/Alzabo/SQLMaker.pm Alzabo::SQLMaker::MySQL: file: lib/Alzabo/SQLMaker/MySQL.pm version: 2 Alzabo::SQLMaker::PostgreSQL: file: lib/Alzabo/SQLMaker/PostgreSQL.pm version: 2 Alzabo::Schema: file: lib/Alzabo/Schema.pm version: 2 Alzabo::Table: file: lib/Alzabo/Table.pm version: 2 Alzabo::Utils: file: lib/Alzabo/Utils.pm generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Alzabo-0.92/Changes0000444000175000017500000030232210721343227014010 0ustar autarchautarch0.92 BUG FIXES: - Reverse engineering with MySQL broke when the tables were returned _without_ the schema name. - Enable subselects for MySQL, though there's still no good API for subselects. - Pass any unknown command line options through to Module::Build, for example things like "--install-base". Reported by Lars Dieckow. RT Ticket #28410. - Fix a possible bug in Alzabo::Config::available_schemas. Reported by Otto Hirr. RT Ticket #28312 0.91 Mar 25, 2007 BUG FIXES: - Alzabo checked whether a particular variable was an array reference with a construct like this "eval { @$thing } ? @$thing : $thing". Under most circumstances, this is ok, but Mason installs a $SIG{__DIE__} handler that turns all string exceptions into exception objects. This meant that under Mason, for any eval where the reference in question was _not_ an array reference, a string exception was caught and turned into a full-blown exception object. This could cause a massive performance hit in some cases. 0.90 Mar 9, 2007 ENHANCEMENTS: - Added handling of multi-column indexes which include one function when reverse-engineering Pg schemas. BUG FIXES: - When a row was deleted, it was not being deleted from the cache. If you then inserted a row with the same primary key, you got back the row from the cache, which was marked as deleted, instead of the new row. - Newer versions of MySQL may return fully qualified and quoted table names (`Schema`.`Table`) from $dbh->tables. This broke reverse-engineering. - The Alzabo::Column->is_time() method was totally broken for MySQL. 0.8904 Nov 17, 2006 BUG FIXES: - The t/21-row_by_pk-exception test blew up if no test config was provided, instead of just skipping its tests gracefully. Reported by Andy Lester. 0.8903 Nov 16, 2006 BUG FIXES: - The change in 0.8902 to not use UNIVERSAL::isa exposed a bug in the handling of an attempt to load a row which doesn't exist in the DBMS. Reported by Jon Prettyman. 0.8902 Nov 9, 2006 BUG FIXES: - Make Alzabo "safe" to use with UNIVERSAL::can (the module), which spits out lots of warning if you use Alzabo after it has been loaded. - Fixed a warning from DBI in the 03-runtime.t tests. - Fixed reverse engineering of nextval() as a column default with Pg. 0.8901 Jul 19, 2006 BUG FIXES: - Fix reverse engineering of "now()" as default for a column with Pg. 0.89 Jun 20, 2006 ENHANCEMENTS: - Improved schema diffs for Postgres, particularly in the area of comparing two columns. Now we attempt to determine if two columns are logically equivalent, even if they might have minor variations (INT vs INTEGER type name, 'f' versus 'false' for BOOLEAN default, etc.). - Added Alzabo::SQLMaker->distinct_requires_order_by_in_select for the benefit of Pg, which requires that anything in the ORDER BY clause show up in the SELECT when you SELECT DISTINCT. This change is experimental, and may go away in future versions. - Removed support for passing order_by and group_by as a hash reference. This was deprecated in 0.59. BUG FIXES: - When reverse engineering a Postgres schema, Alzabo did not look for its own sequences to determine if a column should be marked as sequenced. - Defer FK creation until all other DDL has been executed. This ensures that the table to which we're referring will be available. - When recreating a table during a SQL diff, make this an exception so we don't do other column diff/add/drop operations on the same table. - Fixed a test failure in 07-methodmaker.t when testing with Postgres. This failure may not have showed up often because it came from a test that depended on the DBMS returning rows in a speific order by without specifying an ORDER BY. - When a Postgres table is renamed, its sequences are also renamed. 0.8801 Mar 13, 2006 BUG FIXES: - Quoting of PostgreSQL column defaults in DDL SQL was completely broken. 0.88 Mar 13, 2006 ENHANCEMENTS: - Added a new option when creating a column, "default_is_raw", which can be used to allow for a function like NOW() as a column default. - Added an "--automated" option for Build.PL, to force it to just use default prereqs. Also added other options to be used with this one, see "perl Build.PL --help" for detalis. - The Alzabo::Driver classes will now transparently reconnect to the DBMS if you attempt to use them in a child process after a fork. This prevents various problems that can occur if you attempt to share a DBI handle between two processes. One notable problem is that the parent's DBI handle is closed when the child exits. - Added support for (VAR)BINARY type columns in MySQL. Request by Martin Groenemeyer. RT Ticket #16338. BUG FIXES: - Alzabo::Table->foreign_keys_by_table() and foreign_keys_by_column() could return the same object more than once when using multiple-column foreign keys. Reported by Rainer Rohmfeld. RT Ticket #13885. - Calling connect() on a driver object (via a schema object) with different parameters did not reconnect if the existing handle was still good. This was explicitly opposite what the docs said the code was doing. RT Ticket #17942. - Fix bug in reverse engineering function indexes in Postgres. The reverse engineering code always ended up thinking all of the columns in the table were used in the index. - Fix failing MySQL test in 03-runtime.t. The problem was the test, not the Alzabo core. Reported by Alex McLintock. - Fixed adding too many "=cut" directives in docs generated by Alzabo::MethodMaker. - Fixed SQL generation for the Postgres functions CURRENT_DATE, CURRENT_TIME, and CURRENT_TIMESTAMP, which should not have parentheses after them. - Documented that DATE_TRUNC() is a support Pg function in Alzabo::SQLMaker::PostgreSQL. RT Ticket #13843. 0.87 May 14, 2005 BUG FIXES: - Table names in CREATE INDEX statements for Postgres were not quoted. - Database names in CREATE/DROP DATABASE statements for Postgres were not quoted. - Postgres database names with upper case characters were never being detected as being instantiated, which meant Alzabo always tried to recreate the schema from scratch. - ALTER TABLE statements for Postgres left the table name unquoted when renaming a column. - Even if Alzabo::Runtime::Schema->referential_integrity was false, Alzabo was still doing referential integrity checking on inserts. Reported by Michal Jurosz. - 19-schema-name.t did not use the user-supplied connection parameters and could fail because of this. Reported by Daniel Puro. - Handle quotes in table names returned by Postgres when reverse engineering. - Reverse engineering a Postgres schema that contained indexes on functions could fail because the Alzabo::RDBMSRules::PostgreSQL code used a function from Text::Balanced without loading it first (or making it a prereq for the distro). Reported by an anonymous user via rt.cpan.org. - When getting the next sequence number from a Postgres schema, Alzabo was not quoting the sequence name even if the schema's quote_identifiers attribute was true. Reported by "Martin" via rt.cpan.org. ENHANCEMENTS: - Allow any key starting with "pg_" when connecting a Postgres database. This allows you to pass attributes like "pg_enable_utf8" or "pg_bool_tf". Prompted by a discussion with Boris Shomodjvarac. 0.86 December 22, 2004 BUG FIXES: - Allow a UNIQUE constraint as a column attribute for MySQL. ENHANCEMENTS: - It is now possible to use a single Alzabo schema object to create and access multiple copies of that schema in an RDBMS. This is done by setting the "schema_name" parameter whenever calling a method that accesses the RDBMS. This feature has a bad interaction with the way internal schema diffs are generated, however. Please see the "MULTIPLE COPIES OF THE SAME SCHEMA" section in Alzabo::Intro for details. - The Alzabo::Runtime::Row->update() method now returns a boolean indicating whether any changes were actually made. Patch by Eric Waters. 0.85 October 12, 2004 BUG FIXES: - The DECIMAL and NUMERIC column types in MySQL were not being treated as numeric types. This meant that you couldn't give such a column the UNSIGNED attribute, among other problems. Reported by Bob Sidebotham. - If a column had CHECK constraints, the Postgres reverse engineering failed. Reported by Ken Miller, fixed by Joshua Jore. - Insert handles did not include sequenced Postgres columns, causing 17-insert-handle.t to fail when run against Postgres. Reported by Eric Schwartz. 0.84 September 4, 2004 ENHANCEMENTS: - Alzabo::MethodMaker will now warn you when you it creates a method that overrides a parent class's method. This can cause problems when you override the table class's name() method with one that returns a column object. BUG FIXES: - Make Alzabo::Create::Schema->delete work under taint mode. Reported by Dana Hudes. - Improve Alazbo::PostgreSQL docs, specifically mentioning that if you create a Postgres schema with mixed or upper case table names, you need to do $schema->set_quote_identifiers(1) for any DML SQL to work. - The Alzabo::Runtime::Row->is_potential method didn't exist. - The caching had a very nasty interaction with reverse engineering that could cause data loss (of foreign keys) when the "sync with backend" functionality was called from the Mason GUI. There may have been other bugs as well. This was fixed by not caching reverse engineered schemas, which is somewhat of a hack. Anyone using the Mason GUI with MySQL is encouraged to upgrade because of this bug. 0.83 June 9, 2004 MISCELLANEOUS: - I got fed up with the instability of CVS on Sourceforge, and am now using a Subversion repository I host myself. See "source" page on www.alzabo.org for details. ENHANCEMENTS: - All SQL-generating methods for the Alzabo::Runtime::Schema and Alzabo::Runtime::Table classes now accept a "quote_identifiers" parameter, which allows you to turn this on for a single query. - Improved handling of MySQL's "default defaults" when reverse engineering or comparing two schemas, so that the code doesn't generate ALTER TABLE statements that don't do anything. - Make many Params::Validate specs into constants, which may improve speed a bit, and may affect memory usage under mod_perl. This is probably a useless micro-optimization, though. BUG FIXES - Make sure generated SQL for Postgres schema diffs does not include dropping & adding the same FK constraint more than once. - Reverse engineering works with Postgres 7.4. Thanks to Josh Jore for this big patch. Hopefully this won't break anything for Postgres 7.3 ;) - The Alzabo::Column->is_time_interval method was misspelled, and so did not work at all. Patch from Josh Jore. - With Postgres 7.4, the DBI tables method always includes system tables, so we have to filter these out in the Alzabo::Driver::PostgreSQL->tables method. Patch from Josh Jore. - Make the is_date & is_datetime method consistent across various databases. For Postgres, is_date was only returning true for the DATE type, not TIMESTAMP. - Make is_datetime return true for Postgres' TIMESTAMPTZ column type. - Turning on SQL debugging could cause Alzabo to alter bound values that were null to the string "NULL" before performing a query. - If a table name was changed and an index, column, or foreign key dropped from that table, then the generated "diff" SQL could refer to the old table name in the various DROP statements that were generated. - Workaround a bug in MySQL that reports a "Sub_part" of 1 for fulltext indexes. - The changes introduced in 0.71 to track table and column renames could cause bogus SQL to be generated if something was renamed, the schema was instantiated, and then the schema was compared to an existing live database which also had the same renaming done to it. - If you tried to create a relationship between two tables where one of the tables had a varchar or char column as part of its PK, and you let Alzabo create the foreign key column in the other table, then Alzabo would try to set the length of the varchar/char column to undef, which would cause an exception to be thrown. --------------------------------------------------------------------------- 0.82 January 6, 2004 ENHANCEMENTS: - The Alzabo::Runtime::Table->insert() and Alzabo::Runtime::InsertHandle->insert() methods will not create a new row object when called in void context. This should make inserts faster when you don't need a row object back. - When reverse engineering a MySQL schema, Alzabo will now set a table attribute for the table type (MyISAM, InnoDB, etc.) if the server supports table types (which any modern version of MySQL does do). BUG FIXES: - When creating the test database for MySQL, we now explicitly set the table type to MYISAM, in case the default is something else. Otherwise the tests will fail when we try to create a fulltext index. KNOWN BUGS: - This release will fail several tests when tested with Postgres 7.4. Specifically, reverse engineering with Postgres 7.4 is known to be broken. This will be fixed in the next release. --------------------------------------------------------------------------- 0.81 December 21, 2003 ENHANCEMENTS: - Added a new insert handle feature, which should be significantly faster for batch inserts than repeatedly calling the table class's insert() method. Development funded by Marigold Technologies. BUG FIXES: - An order_by parameter that contained two SQL functions (like "COUNT(*) DESC, AVG(score) DESC") caused the error "A sort specifier cannot follow another sort specifier in an ORDER BY clause". - If you passed a no_cache parameter to a method that created a row, this would cause an error unless Alzabo::Runtime::UniqueRowCache had been loaded. - Workaround for bug/change/something in DBD::Pg 1.31+ that affects the $dbh->tables method, which broke reverse engineering. --------------------------------------------------------------------------- 0.80 October 24, 2003 ENHANCEMENTS: - Use the non-deprecated form of DBI->tables(). - Added an is_time_interval method to Alzabo::Column. - Lots and lots of doc cleanup and re-formatting. --------------------------------------------------------------------------- 0.79_04 October 18, 2003 - Identical to 0.79_03 except for minor POD changes in order to try to fix the problem of search.cpan.org treating the wrong file as the main Alzabo.pm docs. Again reported by Darren Duncan. --------------------------------------------------------------------------- 0.79_03 October 18, 2003 ENHANCEMENTS: - Many doc rewrites and updates. - Documented row state classes. - Added back the no_cache parameter to avoid caching one or more rows. - Moved the relevant documentation from Alzabo::Runtime::PotentialRow into Alzabo::Runtime::Row. BUG FIXES: - Fixed the NAME portion of the Alzabo::MySQL and Alzabo::PostgreSQL POD files so that search.cpan.org doesn't think Alzabo::MySQL is the Alzabo.pm file. Reported by Darren Duncan. - The 12-rev_engineer_pg_fk.t test would try to load DBD::Pg even if you weren't using Postgres, which would cause the test file to die if DBD::Pg wasn't installed. Reported by Jost's smokehouse. - More documentation updates to remove outdated information. - Split out the documentation in Alzabo.pm into Alzabo::Intro and Alzabo::Design. - Added a FAQ from a question on the mailing list. Suggested by Terrence Brannon. - Eliminated a circular reference between tables created via the Alzabo::Runtime::Table->alias() method, and the columns those alias tables contain. This required the use of weak references. NOTE: Alzabo regular tables and columns have circular references to each other, but this normally isn't a problem because you generally want to keep a whole schema around all the time anyway. --------------------------------------------------------------------------- 0.79_02 October 17, 2003 ENHANCEMENTS: - Added support for table attributes like MySQL's "TYPE = ..." or Postgres's "WITH OIDS". - Added support for functional indexes in Postgres, like "LOWER(some_col)". Funded by Kineticode, Inc. for Bricolage 2.0. - Added column/table constraint/check reverse engineering for Postgres. Funded by Kineticode, Inc. for Bricolage 2.0. - The SQL generated for Postgres schemas now includes foreign key constraints. - Added a new method to Alzabo::Runtime::Schema, prefetch_none(). - Added a new method to Alzabo::Table, has_index(). - Documented Alzabo::Runtime::UniqueRowCache. - The definitions of the is_character and is_blob column methods have been clarified. Note that these definitions have changed from the previous, undefined behavior. - When a 1..1 or 1..n foreign key is added to a table, a unique index is created on the columns involved in the foreign key, unless those columns are part of the table's primary key. BUG FIXES: - Fixed a problem in the Makefile.PL which would cause it to fail even if you had Module::Build installed. Reported by Ken Williams. - Fixed (really, this time, I hope) a problem where the user-provided connection parameters were not respected in the 01-driver.t tests. Reported by Ken Williams. - FK reverse engineering for Postgres sometimes got the cardinality of the relationship wrong, making it 1..1 when it should be 1..n. This should be much improved in this release, though it may still have bugs. - Removed references to the old caching code in various spots. - Fixed handling of case_sensitive parameter to Alzabo::Column->has_attribute(). BACKWARDS INCOMPATIBILITIES: - When you load a runtime schema, it now calls "$self->prefetch_all_but_blobs" in order to turn on pre-fetching by default, since for the vast majority of users, this is a huge performance improvement. The new prefetch_none() method can be used to turn off all prefetching. - The is_character column method now returns true for any text type column, regardless of size. - The is_blob column method now returns true only for columns that are defined to hold binary data. --------------------------------------------------------------------------- 0.79_01 October 10, 2003 ENHANCEMENTS: - Distribution is now signed with Module::Signature. - Lots of refactoring of the row object internals to simplify the code. Implemented by Ilya Martynov. - The testing code has been cleaned up quite a bit, and all of the utility functions used in the tests have been consolidated in t/lib/Alzabo/Test/Utils.pm. - Added intermediate table and row classes for MethodMaker created classes, to provide a central point for adding new methods to table and row objects. Based on a patch from Ken Williams. - Support for "self-linking" tables in Alzabo::MethodMaker, a linking table which connects a table to itself in an n..n relationship. Implemented by Ken Williams. - Added rdbms_version method to driver classes. Implemented by Ken Williams. - Added Alzabo::Create::Schema->is_saved() method. - Foreign keys are now reverse engineered for Postgres 7.3+. Implemented by Ken Williams. - Don't try to include dropped columns when reverse engineering Postgres 7.3+. Implemented by Ken Williams. - Do a better job of detecting SERIAL type columns when reverse engineering Postgres schemas. Based on a patch from Ken Williams. - Treat Postgres data types SERIAL4, SERIAL8, BIGSERIAL, and BIGINT as valid types. Implemented by Josh Jore. - NotNullable exception now include the table and schema name. Based on a patch from Ken Williams. - Primary keys are updateable. - Debugging output from Alzabo::MethodMaker is clearer about what methods are being made. Implemented by Ken Williams. - Alzabo::MethodMaker will now create foreign key methods when two tables have multiple relationships, as long as the name generation callback returns different names for each of them. Implemented by Ken Williams. - A join parameter can now specify an outer join with a single array reference, such as: [ left_outer_join => $table_A, $table_B ] Previously, this could only be done as a double array reference, like: [ [ left_outer_join => $table_A, $table_B ] ] - Various doc fixes and rewriting, most notably in Alzabo.pm. BUG FIXES: - A join using multiple aliases to the same table would fail with an error message like "Cannot use column (Foo.bar_id) in select unless its table is included in the FROM clause". - Remove the long-ago deprecated next_row() and next_rows() methods. - Postgres 7.3 allows identifiers to be up to 63 characters. This broke the code that handled sequenced columns for Postgres. Patch by Josh Jore. - If you tried to create a relationship between two tables, and the "table_to" table already had a column of the same name as the "column_from" column, then Alzabo died with an error. Reported by Ping Liang. - If you had previously installed Alzabo, and then provided a new Alzabo root directory or a new directory for the Mason components, this was not respected during the installation process. - Alzabo's referential integrity checks will no longer complain if you attempt to set a foreign key column to NULL. Previously it would throw an exception if the column was part of the dependent table in a foreign key relationship. Now, it just assumes you really meant to allow the column to be NULLable. - The schema class's load_from_file() method now blesses the loaded schema into the calling class. So if you use MethodMaker to generate classes, and then call My::Schema->load_from_file, it should always return an object blessed into the My::Schema class. Reported by Ken Williams. - When checking for the MySQL variable sql_mode, the value may be simply '' as opposed to 0. Patch by Andrew Baumhauer. BACKWARDS INCOMPATIBILITIES: - Alzabo now requires at least Perl 5.6.0 (5.6.1+ recommended). - The old caching system has been removed, as it had way too much overhead. There is a new, much simpler caching system provided by the Alzabo::UniqueRowCache module. - The Alzabo::Runtime::Table->row_by_pk() method no longer dies if it cannot find a matching row. Instead it simply returns false. - Some deprecated MethodMaker options were removed: insert, update, lookup_table - The Alzabo::Runtime::Row->delete() method now works for potential rows. --------------------------------------------------------------------------- 0.73 October 5, 2003 BACKWARDS INCOMPATIBILITIES: - This release no longer includes the Mason schema creation GUI. It can be installed separately via the Alzabo::GUI::Mason package. BUG FIXES: - Fixed a bug in Alzabo::Create::Schema that only seems to be triggered by newer Perls. The symptom was an error like "Alzabo does not support the 'MySQL' RDBMS" when trying to create a new schema. - Fixed a warning in Alzabo::RDBMSRules. - The 01-driver.t test ignored any user-supplied RDBMS connection parameters. Reported by Barry Hoggard. - Newer versions of MySQL may return quoted table names, which broke reverse engineering. - Added a quick and nasty hack to remove the schema name from table names when reverse engineering Postgres schemas. - Reverse engineering of indexes for MySQL 4.0+ was broken. --------------------------------------------------------------------------- 0.72 April 12, 2003 ENHANCEMENTS: - Rewrote the complex build/install system to use Module::Build, which simplified quite a bit of code. Additionally, this should eliminate problems reported by Win32 users with the generated Makefile, because there is no longer a Makefile ;) BUG FIXES: - Fixed the Alzabo::MethodMaker->docs_as_pod method, which simply died when used with a recent version of Params::Validate. Reported by Ken Williams. --------------------------------------------------------------------------- 0.71 April 6, 2003 ENHANCEMENTS: - Alzabo now tracks table and column renames after a schema has been instantiated. This means that when updating the schema in the database after such a change, Alzabo can ensure that there is no data lost because of the change. Previously, Alzabo treated name changes as a drop followed by an add, which caused data loss. - Alzabo::DriverStatement->next_hash has been renamed next_as_hash, in order to be consistent with the Alzabo::Runtime::Cursor classes. - Experimental support for restriction clauses as part of an outer join, such as SELECT ... FROM Foo LEFT OUTER JOIN Bar ON Foo.foo_id = Bar.foo_id AND Bar.something > 2 - Added support for HAVING in queries. BUG FIXES: - Exceptions did not include a stack trace. - Trying to create a Postgres schema with foreign keys defined caused an exception. Reported by Josh Jore. - Fetching rows from the cursor for a join with multiple outer joins could fail if data was being prefetched. DEPRECATIONS: - Alzabo::DriverStatement->next_hash method has been renamed next_as_hash. --------------------------------------------------------------------------- 0.70 November 21, 2002 ENHANCEMENTS: - The exception thrown when you attempt to set a non-nullable column to NULL is now an Alzabo::Exception::NotNullable exception, instead of an Alzabo::Exception::Params exception. In the interests of backwards compatibility, the former is a subclass of the latter. - Improved debugging options. See the new Alzabo::Debug module for details. BUG FIXES: - Fixed Alzabo::Table->primary_key, which would die when no primary key existed and it was called in a scalar context. In an array context, all the columns in the table were returned. Reported by Eric Prestemon. - Alzabo::ObjectCache::Sync::RDBMS created a table that it would later consider incorrect. This made this module unusable. - Alzabo::ObjectCache::Sync::RDBMS caused weird random errors when used with MySQL's InnoDB tables. - In the schema creator, the link to the graph page, and the link _on_ the graph page to the image, were both broken. - Alzabo was allowing you to rename a column to the name of an existing column in a table. Similarly, a table could be renamed to the same name as an existing table. Doing this could trash a schema. - Alzabo::Runtime::Table->one_row would return undef if no row was found, which in a list context evaluated to a true value. - Allow no_cache option when calling Alzabo::Runtime::Schema->join. - When displaying SQL, the schema creator now makes sure to HTML-escape it, because it's possible to have HTML in there (in a default, most likely). - The "children" method generated by Alzabo::MethodMaker did not allow you to add additional where clause constraints to the query. --------------------------------------------------------------------------- 0.69 September 19, 2002 ENHANCEMENTS: - Add count method to Alzabo::DriverStatement objects. BUG FIXES: - ** A particularly nasty bug sometimes manifested itself when removing a foreign key. This bug caused the deletion of all foreign keys involving the _corresponding_ column(s) in the foreign table. Needless to say, this could make a big mess. - Fix some typos in the generated docs created by Alzabo::MethodMaker. - A join that included a where clause with an 'OR' generated improper SQL. Reported by Ilya Martynov. - Calling the Alzabo::Runtime::JoinCursor->next_as_hash method when the query involved an outer join could cause a runtime error. - In where clause specifications, 'and' and 'or' were only being allowed in lower-case. They are now allowed in any case. - Aliases did not work in outer joins. This has been fixed. - Using outer joins was a bit fragile, in that the order of the outer join in the context of the other joins could cause Alzabo to generate incorrect SQL. Now outer joins should work no matter what. - A couple links in the schema creator had a hardcoded ".mhtml" extension, as opposed to using the value of Alzabo::Config::mason_extension(). Patch by Scott Lanning. --------------------------------------------------------------------------- 0.68 July 20, 2002 ENHANCEMENTS: - Updated the thank you list in the README file (you too can be listed by sending me useful bug reports, patches, suggestions, or reminding that you already did so and I forgot ;) - Allow the Driver's ->schemas method to take connection params, wherever possible. This allows Alzabo::Create::Schema methods like ->create, ->sync_backend_sql, and ->sync_backend to work properly when the database server is on another machine. Patch by Ilya Martynov. - Added Alzabo::Runtime::*Row->is_live method to easily distinguish between real and potential rows. - Did some profiling of data retrieval (Alzabo::Runtime bits) and optimized some of the most heavily used pieces of Alzabo. - Added the Alzabo::Runtime::Schema->prefetch_all and Alzabo::Runtime::Schema->prefetch_all_but_blobs convenience methods. - Added a ->count method to the cursor classes. - Added ->is_integer, ->is_floating_point, ->is_date, ->is_datetime, ->is_time, and ->generic_type methods to column objects. - The Alzabo::Driver->schemas method now takes connection parameters. See your specific driver subclass for details on which. Bug report by Ilya Martynov. - Added Alzabo::Runtime::Schema->disconnect method. Patch by Ilya Martynov. - Make the Makefile.PL act gracefully when it is invoked without a tty. Patch by Ilya Martynov. - The quoting of identifiers (table/column names) is now optional, and _off_ by default. In profiling I found that a non-trivial amount of time was being spent quoting these, and in most cases it's not necessary. There is now a Alzabo::Runtime::Schema->set_quote_identifiers method that can be used to change this behavior. Identifiers are always quoted when using Alzabo::Create::* with Postgres, however. - Did a fair amount of profiling in order to optimize Alzabo's data fetching. In general, Alzabo::Runtime::* operations should be faster. - Added Alzabo::Runtime::Column->alias which is useful when executing queries via the Alzabo::Runtime::Schema and Alzabo::Runtime::Table ->select methods. BUG FIXES: - Alzabo::MethodMake generated "lookup column/table" methods will return if there is no matching entry in the related table, which is important when the two tables are independent. Previously it would have been a runtime error (attempting to call a method on an undefined value). - Fix warning from Row->update. Patch by Ilya Martynov. - Alzabo::Runtime::PotentialRow's id_as_string method was misnamed id. The docs had it wrong for all classes. - Catch where clauses that contain non-column/function objects as left hand side value (like if you accidentally pass in a table object). - The Postgres TEXT column type is now considered a blob, not a character type column. - There was a fatal error when creating an n-to-n relationship if only columns were given, without tables. This was fixed with a patch from Dan Martinez. - Explicitly check for errors after calling $dbh->func. - There was a bug when trying to use the schema creator to create relationships involving more than one column. - Fixed a bug where a query using the Alzabo::Runtime::Table->one_row could cause an exception if no rows were found. - Alzabo::Create::Schema->sync_backend was not passing through the connection parameters it was getting to the ->create method, causing failures. Patch from Ilya Martynov. --------------------------------------------------------------------------- 0.67 June 6, 2002 BUG FIXES: - There were some broken bits in the installation code in 0.66. These are now fixed. --------------------------------------------------------------------------- 0.66 June 6, 2002 ENHANCEMENTS: - It is now possible to retrieve auto-generated documentation to go along with the methods generated by Alzabo::MethodMaker. See the "GENERATED DOCUMENTATION" section of the Alzabo::MethodMaker docs for more details. - Added documentation to all the components in mason/widgets. You can run perldoc on those files for more details. - Added a very ugly hack to work around a bug with Storable 2.00 - 2.03 and a Perl < 5.8.0. - It is now possible to install Alzabo without defining an Alzabo root directory. This means you will have to set this by calling Alzabo::Config::root_dir() every time you load Alzabo. An attempt to load a schema without first defining the root_dir will throw an exception. Based on a patch from Ilya Martynov. BUG FIXES: - Allow UNIQUE as a column attribute for Postgres. Reported by Dan Martinez. - Add DISTINCT back as an exportable function from the SQLMaker subclasses. It may be useful when calling ->select and ->function. - Fixed a bug that prevented things from being deleted from the cache storage. - Fixed a variety of problems related to handling Postgres tables and columns with mixed or upper case names. This included a bug that prevented them from being reverse engineered properly. Reported by Terrence Brannon. - Fixed a bug when altering a Postgres column name that caused Alzabo to generate incorrect syncing SQL. - Make the test suite play nice with the latest Test::* modules. The 03-runtime.t tests were aborting because I feature I had been using in earlier versions of Test::More was removed. - Alzabo::MethodMaker will die properly if given a non-existent schema name. Suggested by Ilya Martynov. - If you added a sequenced primary key to a table with MySQL, Alzabo did not generate all of the SQL necessary to change the table. Reported by Ilya Martynov. DEPRECATIONS: - The Alzabo::Schema start_transaction method has been renamed to begin_work. The finish_transaction method is now commit. The old names are deprecated. --------------------------------------------------------------------------- 0.65 May 16, 2002 INCOMPATIBILITIES: - Alzabo now uses the natively created Postgres sequence for SERIAL columns. If you have existing Alzabo code with SERIAL columns that is using the Alzabo-created sequence, then this release will break things for you. One easy fix is to simply drop the existing Postgres-created sequence and recreate it with a new starting number one higher than the highest row already in existence. So if your hightest "foo_id" value in the "Foo" table is 500, you would do this: DROP SEQUENCE foo_foo_id_seq; CREATE SEQUENCE foo_foo_id_seq START 501; - The Alzabo::Table->primary_key method is now context-sensitive, returning a single column object in scalar context. - The data browser is no longer installed, until such time as I can rewrite it to be more useful. DEPRECATIONS: - The Alzabo::Create::Schema->add_relation method has been renamed as Alzabo::Create::Schema->add_relationship. ENHANCEMENTS: - Check out the mason/widgets directory for some handy widgets that can help integrate Mason and Alzabo in useful ways. These aren't really well-documented yet but may be useful for playing with. More widgets will be included in future releases (I hope). - When creating a relationship between tables in the schema creator, you can now let Alzabo figure out which columns to use instead of choosing them yourself. For most relationships, Alzabo will simply do the right thing, adding a column to one of the tables as needed. - The problems running the tests with Postgres should now be fixed. - Fix stupid and inefficient internal handling of "SELECT DISTINCT" queries. Now Alzabo simply lets the database handle this, the way it should have in the first place. - The Alzabo::Runtime::Schema and Alzabo::Runtime::Table ->function and ->select methods now allow you to select scalars so you can do things like SELECT 1 FROM Foo WHERE ... in order to test for the existence of a row. - Added Alzabo::Table->primary_key_size method, which indicates how many columns participate in the table's primary key. - Added Alzabo::Runtime::Schema->row_count. Suggested by Daniel Gaspani. - Alzabo now detects older versions of schemas and transparently updates them. This will work for all schemas created with version 0.55 or later. See the section titled "Backwards Compability" in Alzabo.pm for more details. - Added comment attribute for tables, columns, and foreign keys. - Add VARBIT and TIMESTAMPTZ as legal types for Postgres. - Handle SERIAL columns in Postgres better. Use the sequence Postgres creates for the columns rather than making our own and just insert undef into new rows for that column. BUG FIXES: - Adding a column that is not-nullable or has a default to a table under Postgres was causing an error with Postgres 7.2.1. It seems likely that with earlier versions of Postgres, this was simply failing silently. Patch by Daniel Gaspani. - Fixed buggy handling of joins that had a table with a multi-column primary key as the "distinct" parameter. - Calling the Alzabo::Runtime::Schema->join method with no 'select' parameter and a 'join' parameter that was an array reference of array references would fail. - Avoid an uninit value in Alzabo::MethodMaker. Reported by Daniel Gaspani. - If you created a cursor inside an eval{} block, the cursor contained an object whose DESTROY method would overwrite $@ as it went out of scope when the eval block exited. This could basically make it look like an exception had disappeared. Thanks to Brad Bowman for an excellent bug report. - Loading a schema failed in taint mode. This was reported ages ago by Raul Nohea Goodness and dropped on the floor by me. My bad. - The schema creator's exception handling was a little bit buggered up when handling Alzabo::Exception::Driver exceptions. --------------------------------------------------------------------------- 0.64 Mar 27, 2002 ENHANCEMENTS: - Added potentially useful script, alzabo_to_ascii, in eg/ dir. - Ask for port when setting up tests. - Turn on stacktraces for all Alzabo::Exception objects. - Removed the deprecated "lookup_tables" option from Alzabo::MethodMaker. - Removed the deprecated next_row methods from the various cursor classes. - Removed the deprecated Alzabo::Runtime::Table->func method. - Major changes to how joins are done. It is now possible to mix together various sorts of outer joins in a single query. In addition, it is now possible to specify a foreign key that should be used when joining two tables. - The "tables" parameter has been renamed as "join". - The Alzabo::Create::Schema->right_outer_join and Alzabo::Create::Schema->left_outer_join methods have been removed. Use the ->join method instead, which can now be used to do outer joins as well, via: $schema->join( join => [ left_outer_join => $foo, $bar ], ... ) - The functionality of Alzabo::Runtime::OuterJoinCursor has been merged into Alzabo::Runtime::JoinCursor. - Alzabo::Exception::Driver->bind now returns an array reference, not an array. BUG FIXES: - Fix failure to load schema objects from file when $\ is set to something like "\n". Reported by Brad Bowman. - Fixed Postgres reverse engineering to work with slightly changed system tables in 7.2. - Fix handling of table alterations for postgres. Temp tables were being created but not dropped and the data saved in the temp table was not being restored to the real table. Also, Alzabo was trying to create sequences again when altering tables Based mostly on a patch from Daniel Gaspani. - Fix handling of primary key changes for Postgres (I'm still not sure it's entirely correct). - Fix detection of primary key changes for schema diffs. - Handle NOT IN for where conditions. --------------------------------------------------------------------------- 0.63 Feb 18, 2002 ENHANCEMENTS: - Calling Alzabo::Runtime::Row->select or Alzabo::Runtime::Row->select_hash with no arguments returns the values for all of the columns in the table. Suggested by Jeremy R. Semeiks. - The Alzabo::Runtime::Row->id method has been renamed to id_as_string for the benefit of those crazy people who like to use "id" as a column name and want Alzabo::MethodMaker to be able to create such a method. Suggested by Alexei Barantsev. - Changed the Alzabo::Create::Schema->sync_backend method so that if there was no corresponding schema in the RDBMS, then it will instantiate a new schema instead of just blowing up. Similarly, the sync_backend_sql method will just return the SQL necessary to create the schema from scratch. BUG FIXES: - Removing column attributes via the schema creator was broken. Adding them could have caused errors but generally worked. - If you changed a column from non-sequenced to sequenced, the SQL "diff" was not reflecting this. - Revert a previous change to MySQL reverse engineering. Now default for numeric columns that are not 0 or 0.00 are used instead of being ignored. The fact that MySQL has 'default defaults' _really_ screws things up. Bad MySQL! - A query that ended with a subgroup could not be followed with an order by or group by clause. Bug report and test case submitted by Ilya Martynov. - Nested subgroups in where clauses (like where => [ '(', '(', ....) were not being allowed. Bug report and test case submitted by Ilya Martynov. - Alzabo::MethodMaker would overwrite methods in the Alzabo::Runtime::Row/CachedRow/PotentialRow classes. This has been fixed. Reported by Alexei Barantsev. - Allow order by clause to contain only a SQL function to allow things like "SELECT foo FROM Bar ORDER BY RAND()", which works with MySQL. --------------------------------------------------------------------------- 0.62 Jan 15, 2002 ENHANCEMENTS: - Add support for IFNULL, NULLIF, and IF for MySQL. - Document that Alzabo supports COALESCE and NULLIF for Postgres. - Added Alzabo::ObjectCache::Sync::Mmap which uses Cache::Mmap. This is just slightly slower than using SDBM_File. - New table alias feature for making queries that join against a table more than once. An example: my $foo_alias = $foo_tab->alias; my $cursor = $schema->join( select => $foo_tab, tables => [ $foo_tab, $bar_tab, $foo_alias ], where => [ [ $bar_tab->column('baz'), '=', 10 ], [ $foo_alias->column('quux'), '=', 100 ] ], order_by => $foo_alias->column('briz') ); In this query, we want to get all the entries in the foo table based on a join between foo and bar with certain conditions. However, we want to order the results by a _different_ criteria than that used for the join. This doesn't necessarily happen often, but when it does its nice to be able to do it. In SQL, this query would look something like this: SELECT foo.foo_id FROM foo, bar, foo as foo1 WHERE foo.foo_id = bar.foo_id AND bar.foo_id = foo1.foo_id AND bar.baz = 10 AND foo1.quux = 100 ORDER BY foo1.quux FEATURE REMOVAL: - It is no longer possible to pass sorting specifications ('ASC' or 'DESC') as part of the group_by parameter. This was only supported by MySQL and it was broken in MySQL until 3.23.47 anyway. It's weird and non-standard. Just use order_by instead. BUG FIXES: - If prefetch wasn't set, all the rows in the table were being pre-fetched. - The newest Test::More (0.40) uses eval{} inside its isa_ok() function. The test suite was passing $@ directly into isa_ok() and it would then get reset by the eval{} in the isa_ok() function. This has been fixed by copying $@ into another variable before passing it into isa_ok(). Apparently, Test::More 0.41 will fix this as well. - Make Alzabo::ObjectCache::Store::RDBMS and Alzabo::ObjectCache::Sync::RDBMS play nice with Postgres. Postgres aborts transactions when there are errors like an attempt to insert a duplicate inside a transaction. These module would just try to insert potentially duplicate rows and ignore the error. Now Postgres is handled specially. - If you told the installer that you didn't want to run any tests with a live database, there would be errors when it tried to run 03-runtime.t. Now it just skips it. - Alzabo includes a script called 'pod_merge.pl' that is run before installing its modules. This script merges POD from a parent class into a child class (like from Alzabo::Table into Alzabo::Create::Table) in order to get all the relevant documentation in one place. The way the Makefile.PL ran this script was not working for some people, and in addition, did not end up putting the merged documentation into the generated man pages. This release includes a patch from Ilya Martynov that fixes both of these problems. --------------------------------------------------------------------------- 0.61 Dec 25, 2001 ENHANCEMENTS: - Improve documentation for new Alzabo::Create::Schema->sync_backend method and note its caveats. - It is now possible to use SQL functions as part of order_by clauses. For example: my $cursor = $schema->select( select => [ COUNT('*'), $id_col ], tables => [ $foo_tab, $bar_tab ], group_by => $id_col, order_by => [ COUNT('*'), 'DESC' ] ); - Allow a call to Alzabo::Runtime::Table->insert without a values parameter. This is potentially useful for tables where the primary key is sequenced and the other columns have defaults or are NULLable. Patch by Ilya Martynov. BUG FIXES: - A call to the schema class's select or function methods that had both an order_by and group_by parameter would fail because it tried to process the order by clause before the group by clause. - When thawing potential row objects, Alzabo was trying to stick them into the cache, which may have worked before but not now, and should be avoided anyway. - The parent and children methods created by Alzabo::MethodMaker were incorrect (and unfortunately the tests of this feature were hosed too). - Add YEAR as exportable function from Alzabo::SQLMaker::MySQL. - Fix definition of WEEK and YEARWEEK functions exported from Alzabo::SQLMaker::MySQL to accept 1 or 2 parameters. - A bug in the caching code was throwing an exception when attempting to update objects that weren't expired. This only seemed to occur in conjuction with the prefetch functionality. The caching code has been simplified a bit and is hopefully now bug-free (I can dream, can't I?). - Make it possible to call Alzabo::Runtime::Schema->join with only one table in the tables parameter. This is useful if you are constructing your join at runtime and you don't know how many tables you'll end up with. - Where clauses that began with '(' were not working. Reported (with a test suite patch) by Ilya Martynov. - Where clauses that contained something like ( ')', 'and' (or 'or') ) were not working either. - This file incorrectly thanked TJ Mather for separating out Class::Factory::Util, but this was done by Terrence Brannon. Oops, brain fart. - Improve the recognition of more defaults that MySQL uses for column lengths and defaults, in order to improve reverse engineering. - Recognize defaults like 0 or '' for MySQL. - Fix Alzabo::Create::Schema->sync_backend method. --------------------------------------------------------------------------- 0.60 Dec 6, 2001 ENHANCEMENTS: - When passing order_by specifications, it is now possible to do this: order_by => [ $col1, $col2, 'DESC', $col3, 'ASC' ] which allow for multiple levels of sorting as well as being much simpler to remember. - It is now possible to do something like $table->select( select => [ 1, $column ] ... ); and have it work. In this case, every row returned by the cursor will have 1 as its first element. - Added Alzabo::MySQL and Alzabo::PostgreSQL POD pages. These pages document how Alzabo does (or does not) support various RDBMS specific features. - Remove Alzabo::Util. Use Class::Factory::Util from CPAN instead. Class::Factory::Util is a slight revision of Alzabo::Util that has been separated from the Alzabo core code by Terrence Brannon. Thanks Terrence. - Add the ability to sync the RDBMS backend to the current state of the Alzabo schema. This allows you to arbitrarily update the RDBMS schema to match the current state of the Alzabo schema. - Add support for SELECT and WHERE clauses that use MySQL's fulltext search features. - Add BIT and BIT VARYING as allowed types for Postgres. BUG FIXES: - Reverse engineering was not checking for fulltext indexes with MySQL. These indexes were treated the same as other indexes. - Make sure Alzabo::SQLMaker always handles stringification of functions properly. - Improve recognition of default column lengths under MySQL (and ignore them). Also improve recognition of default defaults (like '0000-00-00' for DATE columns) and ignore those. - When using the BerkeleyDB module for object syncing or storage, the Berkeley DB code itself creates a number of temporary files. These will now be created in the same directory as the storage/syncing file specified. - Allow GROUP BY foo ASC/DESC for MySQL. The MySQL manual claims this works. In my testing, it accepts the syntax but doesn't actually respect the order requested. Of course, you can always add order by clause with your group by and that seems to work just fine. - Don't allow a GROUP BY clause to follow an ORDER BY clause. The reverse is still allowed. - MySQL: Allow fulltext indexes to include *text type columns without specifying a prefix. - Dropping a column that had an index on it would cause an error in the generated SQL diff where Alzabo would drop the column and then try to drop (the now non-existent) index. The fix is simply to drop the indexes first. - Make caching code work under Perl 5.00503. - Make code warnings clean (I think) under Perl 5.00503; DEPRECATIONS: - The way order_by and group_by parameters are passed has changed a bit. In particular, this form: order_by => { columns => ..., sort => ... } has been deprecated in favor of a simpler syntax. --------------------------------------------------------------------------- 0.59 Nov 17, 2001 ENHANCEMENTS: - Got rid of the post_select_hash hook and combined it with post_select, which now receives a hash reference. Suggested by Ilya Martynov. - Run all hooks inside Alzabo::Schema->run_in_transaction method to ensure database integrity in cases where your hooks might update/delete/insert data. Suggested by Ilya Martynov. - Added new Alzabo::Runtime::Table->select method. This is just like the existing ->function method, but returns a cursor instead of the entire result set. - Added a 'limit' parameter to the ->function method (also works for the ->select method). - Added new Alzabo::Runtime::Schema->select method. This is like the method of the same name in the table class but it allows for joins. - Added new potential rows, which are objects with (largely) the same interface as regular rows, but which are not (yet) inserted into the database. They are created via the new Alzabo::Runtime::Table->potential_row method. Thanks to Ilya Martynov for suggestions and code for this feature. - Added Alzabo::Runtime::Row->schema method. Suggested by Ilya Martynov. - Made it possible to use Storable to freeze and thaw any type of row object. Previously, this would have worked but would have serialized basically every single Alzabo object in memory (whee!). Patch by Ilya Martynov. - Make Alzabo::Schema->run_in_transaction preserve scalar/array context and return whatever was returned by the wrapped code. BUG FIXES: - Did some review and cleanup of the exception handling code. There were some places where exceptions were being handled in an unsafe manner as well as some spots where exception objects should have been thrown that were just using die. - Ignore failure to rollback for MySQL when not using transactional table. - Alzabo was not handling the BETWEEN operator in where clauses properly. Patch by Eric Hillman. - Passing in something like this to rows_where: ( where => [ $col_foo, '=', 1, $col_bar, '=', 2 ] ) worked when it shouldn't. - Trying to do a select that involved a group by and a limit was not being allowed. INCOMPATIBILITIES: - Got rid of the post_select_hash hook and combined it with post_select, which now receives a hash reference. --------------------------------------------------------------------------- 0.58 Oct 18, 2001 ENHANCEMENTS: - Added new insert_hooks, update_hooks, select_hooks, and delete_hooks options to Alzabo::MethodMaker. Suggested by Ilya Martynov. - Moved all the important document for the object caching system into Alzabo::ObjectCache, including the import options for all of the various modules. - Added Alzabo::ObjectCache::Sync::RDBMS & Alzabo::ObjectCache::Store::RDBMS. The former finally allows synchronization of multiple processes across multiple machines! - Add Alzabo::Schema->has_table and Alzabo::Table->has_column methods. - Make BYTEA a legal column type for postgres. This is treated as a blob type. BUG FIXES: - The way cardinality and dependency was being represented in the schema graphs was sometimes backward and sometimes just broken. - Fixed Alzabo::ObjectCache::Store::BerkeleyDB->clear, which was not actually doing anything. Added tests that catch this. - The lookup_tables option, which was deprecated in 0.57, was not being allowed at all. - Calls to select_hash on cached rows were not going through the cache checking routines, possibly returning expired data. Added tests for this. - Eliminate race condition in Alzabo::ObjectCache::Sync::BerkeleyDB. - The Alzabo::Runtime::Row->rows_by_foreign_key method wasn't doing quite what it said. In cases where there was a 1..1 or n..1 relationship to columns that were not the table's primary key, a cursor would be returned instead of a single row. Reported by Ilya Martynov. - Alzabo::MethoMaker could generate 'subroutine foo redefined' warnings . Reported by Ilya Martynov. - Fixed clear method for all Alzabo::ObjectCache::Store::* modules. DEPRECATIONS: - The insert and update options for Alzabo::MethodMaker have been deprecated. They have been replaced by the new insert_hooks and update_hooks options, along with new select_hooks and delete_hooks options. INCOMPATIBILITIES: - If you specify give the 'all' parameter to MethodMaker, 'insert' and 'update' are no longer included. --------------------------------------------------------------------------- 0.57 Oct 9, 2001 ENHANCEMENTS: - When MethodMaker creates 'row_column' methods, these are now get/set methods. - Added new lookup_columns option to MethodMaker (like lookup_tables but more flexible). This replaces the now deprecated lookup_tables option. See DEPRECATIONS and INCOMPATIBILITIES for more details. - Added the ability to make any storage cache module an LRU. Simply pass an lru_size parameter to Alzabo::ObjectCache when using it and the storage module will be an LRU cache. - Documented Alzabo's referential integrity rules in Alzabo.pm (perldoc Alzabo). - Added section on optimizing memory usage to Alzabo::FAQ. - Alzabo::Runtime::Schema->join now takes a parameter called 'distinct'. This is useful in situations where you are joining between several tables but don't want rows back from all of them. In that case, it is possible that you could end up getting more duplicates than you need. This parameter can help you eliminate those. - Add the following Alzabo::Schema methods: begin_work, rollback, commit, run_in_transaction. - If you have GraphViz installed the schema creator can now use it to show you a graph of your schema. BUG FIXES: - Fix handling of binary attribute for MySQL columns. Generated SQL for creating/altering these columns may have been invalid previously. - The rules were not catching an attempt to create a CHAR/VARCHAR column with no length (MySQL). - Fixed bug that caused limit to not work when there was a where clause or order_by clause. Reported by Ilya Martynov. - Documented row_column option for MethodMaker. - order_by was ignored when given to the Alzabo::Runtime::Schema->join method. Reported by Martin Ertl. - When viewing an existing column in the schema creator, the three checkboxes at the bottom were always unchecked. - The test suite has been revamped to use Test::More. In the process some new tests were added and some (gulp) false positives were caught. - The default column value wasn't being escaped in the schema creator. DEPRECATIONS - The Alzabo::MethodMaker option 'lookup_tables' has been deprecated. Use the new 'lookup_columns' option instead. INCOMPATIBILITIES: - Alzabo::ObjectCache::Store modules now expect an object id instead of an object for their delete_from_cache method. - If you specify give the 'all' parameter to MethodMaker, 'lookup_tables' is no longer included. --------------------------------------------------------------------------- 0.56 Had to become 0.57 cause I was too hasty in uploading to CPAN. Doh! --------------------------------------------------------------------------- 0.55 Sep 24, 2001 UPGRADE INSTRUCTIONS: Because of changes to the internal data structures for some objects, the saved schema files from older versions of Alzabo will no longer work with this new version. In the eg/ directory of this distribution, there is a script called convert.pl that can be used to convert your schemas. It is _crucial_ that this script be run while you still have your _current_ version of Alzabo installed. To repeat, DO NOT INSTALL THE NEWEST VERSION OF Alzabo BEFORE RUNNING THIS SCRIPT! Now that we've got that straightened out... What this script does is read an existing schema and generate code that you can run after installing the new version of Alzabo. This code will recreate your schema from scratch. It should be noted that this script _will_ reverse the cardinalities of the relationships in your schema. See the entries in BUG FIXES about this. If you don't like this and want it the old broken way, you can run the reverse_cardinality.pl script in the eg/ directory on your schemas. However, you can only do this _after_ installing this new version of Alzabo. So the steps you should take are: 1. Backup all of your schema files (by default, these are stored under /usr/local/alzabo). 2. Run convert.pl against each schema you have created by doing: perl convert.pl This will create a file named _schema.pl 3. After doing this for _all_ of your schemas, install this version Alzabo. 4. Simply run each file created by the convert.pl script. This will overwrite the old schema files. If you are creating your schemas via a script, then you can use the code generated by convert.pl to replace the code that does this. Do note that the cardinalities will be reversed in the generated code. Those who are doing this will notice that the generated code seems to contain everything twice. This has to do with how Alzabo keeps track of changes from one generation of a schema to the next. Simply use the code up to right before the generated code contains the comment "Previous generation of schema". ENHANCEMENTS: - Greatly improved the flexibility of the join and *_outer_join methods for the schema class. It is now possible to construct arbitrary joins between any set of tables in any manner. - Eliminate use of transactions where not needed and shorten their length in other places. Also make sure failed commit triggers a rollback. - Get rid of silly min/max language in favor of cardinality and dependencies. BUG FIXES: - Fixed a problem with syncing after the Unix time rollover to 10 digits. - Alzabo::ForeignKey->is_many_to_one always returned false. - Alzabo::MethodMaker was interpreting foreign key cardinality incorrectly (backwards). This meant it was treating one-to-many relationships as many-to-one. Reported by Martin Ertl. NOTE: This fix will break code that depended on this behavior. See the UPGRADE INSTRUCTIONS above. - This was also broken in Alzabo::Create::Schema->add_relation. I took this opportunity to rewrite the code get rid of the use of min_max_* and replace it with cardinality and dependency, which is easier to understand. NOTE: This fix will break old code that created schemas programmatically. See the UPGRADE INSTRUCTIONS above. DEPRECATIONS: - The Alzabo::Runtime::RowCursor->next_row, Alzabo::Runtime::JoinCursor->next_rows, and Alzabo::Runtime::OuterJoinCursor->next_rows methods have all been deprecated. Instead, simply use the ->next method for all of them. INCOMPATIBILITIES: - The Alzabo::Column->null and Alzabo::Create::Column->set_null methods (deprecated in 0.20) are gone. Use ->nullable and ->set_nullable instead. --------------------------------------------------------------------------- 0.51 Aug 29, 2001 BUG FIXES: - Accidentally broke foreign key display for schema creation interface in 0.50. -- In retrospect, the bug was fixing this. Oh well, live and learn. ENHANCEMENTS: - Add ->handle method to Alzabo::Driver class, which lets you set and get the current database handle. Suggested by Ilya Martynov. --------------------------------------------------------------------------- 0.50 Aug 16, 2001 ENHANCEMENTS: - There is now support for left and right outer joins. The interface to this may change a bit in future releases. - Added the following methods to foreign key objects: from_is_dependent, to_is_dependent, is_one_to_one, is_one_to_many, is_many_to_one. - Improved and fixed the Alzabo::MethodMaker documentation. DEPRECATIONS: - In some future release all references to the concept 'min_max_from' and 'min_max_to' will go away. Instead, relationships will be described by their cardinality and dependencies. This was changed in the schema creation interface a while ago but the APIs have not yet completely switched over (there are accessors for the new way, but the set methods still use the old concepts). I'll make sure that there is a time when using these methods issues a warning about their deprecation. BUG FIXES: - Fix pod merging, which broke a while back (this merges superclass documentation into subclasses for things like Alzabo::Runtime::Table). - The code was accidentally serializing a DBI handle, which generates lots of useless warnings. This wasn't affecting Alzabo's operations as it never attempted to use the thawed handle. - Fix handling of ENUM and SET column types for MySQL. These were not being allowed through properly. - Attempting to insert a value into a column that was related to a non-primary key column were not allowed if the value being inserted did not match the related column in the other table, even when the columns were not dependent on each other. Now this is only disallowed when the foreign key is a primary key in its own table. --------------------------------------------------------------------------- 0.49 Jul 18, 2001 BUG FIXES: - Found out even more missing files from the MANIFEST (all related to the schema creation interface). Fortunately, I just discovered Perl's "make distcheck" so this shouldn't happen in the future. - One link each in the schema creator and data browser were using a hard-coded .mhtml extension instead of calling Alzabo::Config::mason_extension(). Reported by Barry Hoggard. --------------------------------------------------------------------------- 0.48 Jul 17, 2001 BUG FIXES: - I was missing yet another file from the MANIFEST. Thanks to Barry Hoggard for helping me out with this. - Fix a bug in the test number for 03-runtime.t. --------------------------------------------------------------------------- 0.47 Jul 17, 2001 ENHANCEMENTS: - Make several of the config values settable via the Alzabo::Config module. Suggested by Jared Rhine. - Transactions should now work under MySQL. Whether it does anything or not depends on the table type you are using. This needs testing though. BUG FIXES: - Make sure that index names are not too long. - Added a missing file to the MANIFEST. 0.46 was missing a needed file from the tarball. --------------------------------------------------------------------------- 0.46 Jul 2, 2001 ENHANCEMENTS: - Column types are now canonized to be all upper case. When multiple keywords specify the same type ('INT' and 'INTEGER', for example), one will be chosen. This improves the quality of the reverse engineering and the usability of the schema creation interface. - You can now use SQL functions pretty much anywhere you would want (in inserts, updates, where clauses, etc). See the "Using SQL Functions" section in the Alzabo.pm docs for more details. - As a corollary to the above, the Alzabo::Runtime::Table->function method has been created to replace the old Alzabo::Runtime::Table->func method. This new method takes advantage of the new system for using SQL functions and is simpler and more flexible. It allows you to perform all sorts of aggregate selects. - Added the Alzabo::Runtime::Row->select_hash method. Requested by Dana Powers. DEPRECATIONS: - The Alzabo::Runtime::Table->func method has been deprecated. BUG FIXES: - When adding an AUTO_INCREMENT column to an existing MySQL table, the SQL generated would cause an error. This has been fixed. However, if the table already has more than row then chances are this still won't work (because MySQL does not try to generate needed unique values for the column when it is added). --------------------------------------------------------------------------- 0.45 Jun 6, 2001 INCOMPATIBILITIES: - The 'dbm_file' parameter given when loading a syncing module that used DBM files (such as Alzabo::ObjectCache::Sync::SDBM_File) has been changed to 'sync_dbm_file', because this release includes a new cache storage module that uses DBM files as well. - The schema creator now requires HTTP::BrowserDetect. - Fix what was arguably a bug in the caching/syncing code. Previously, one process could update a row and another process could then update that same row. Now the second process will throw an exception. BUG FIXES: - Accidentally left debugging turned on in Alzabo::Exceptions. - The schema creator did not allow you to remove a length or precision setting for a column once it had been made. - Require a length for CHAR and VARCHAR columns with MySQL. - Add error on setting precision for any column that doesn't allow them with MySQL. - The interaction of caching rows and Alzabo::MethodMaker was not right. Basically, it was determined at compile time whether or not to use the cached row class but this needs to be determined at run time. This has been fixed. - Using the Alzabo::Runtime::Row->rows_by_foreign_key method would fail when the column in one table did not have the same name as a column in the other table. Reported by Michael Graham (along with a correct diagnosis, thanks!). - Don't specify a database name when creating or dropping a database. Reported and patched by Dana Powers. ENHANCEMENTS: - Rules violations error messages (bad table name, for example) in the schema creator are now handled in a much friendlier manner. Instead of the big error dump exception page it returns you to the page you submitted from with an error message. - Add Alzabo::Create::Column->alter method which allows you to change the column type, length, and precision all at once. This is necessary because some of the column type validation code will insist that a column have a length setting. If you try to change them in two separate operations it will throw an exception. - Add Alzabo::ObjectCache::Store::Null - This allows you to use any multi-process syncing module without using up the memory that Alzabo::ObjectCache::Store::Memory uses. - Add Alzabo::ObjectCache::Store::BerkeleyDB - I'm not sure if storing in a db file is really a performance win (vs. null storage) because of the work needed to freeze & thaw the row objects. Benchmarks are needed. - Add support for fulltext indexes (MySQL). - Don't show fulltext or column prefix options when creating indexes for databases that don't support these features. - Use cardinality & dependency language for relations. - Add some style to the schema creator (via stylesheets). It looks a little better now. --------------------------------------------------------------------------- 0.44 May 4, 2001 BUG FIXES: - Bug fix in Alzabo::Runtime::Table->set_prefetch. Reported by Bob Gustafson. - Don't try to make directories when running Makefile.PL. Save it for later after user does 'make install'. - Fix handling of geometric types in Postgres (they were all being rejected as invalid). - Drop columns from a table before adding new ones. Sometimes this makes a difference. For example, if you are using MySQL and drop an existing AUTO_INCREMENT column and add a new one that is also AUTO_INCREMENT. - Only allow one sequenced column per table when using MySQL. - Doc fixes. Thanks to Ron Savage for pointing me towards some of these. - Fix a bug with the schema creator. If you attempted to make a change to a column with an extended type and you did not change the type, an error occurred. ENHANCEMENTS: - Schema creator now shows you a list of possible column types instead of having you type it in. However, for complex types like MySQL's ENUM or Postgres' POLYGON there is a text box to type it in. --------------------------------------------------------------------------- 0.43 Apr 25, 2001 ENHANCEMENTS: - Allow passing of port when executing SQL from schema creator. - Confirm schema deletion in schema creator. BUG FIXES: - Quick hack to fix a problem with Alzabo::MethodMaker when using caching. However, this requires that the caching modules be loaded first, before Alzabo::MethodMaker. A more palatable fix will be in a future release. - Fix a problem with prefetching rows that caused row objects to contain undefined values for certain columns. This only happened if you were prefetching one column. - Fix another problem that left the schema creator still broken. --------------------------------------------------------------------------- 0.42 Apr 25, 2001 BUG FIXES: - The schema creator was broken (for lack of quotes around one string) - Remove 255 char limit on prefix length (this needs more research). --------------------------------------------------------------------------- 0.41 Apr 24, 2001 BUG FIXES: - 0.40 was missing a file in the distro (lib/Alzabo/ObjectCache/Sync/DBM.pm). --------------------------------------------------------------------------- 0.40 Apr 24, 2001 INCOMPATIBILITIES: The classes in the ObjectCache hierarchy have been reorganized. The renaming is as follows: Alzabo::ObjectCache::MemoryStore => Alzabo::ObjectCache::Store::Memory Alzabo::ObjectCache::DBMSync => Alzabo::ObjectCache::Sync::DB_File Alzabo::ObjectCache::IPCSync => Alzabo::ObjectCache::Sync::IPC.pm Alzabo::ObjectCache::NullSync => Alzabo::ObjectCache::Sync::Null.pm ENHANCEMENTS: - Document order by clauses for joins. - Document limit clauses for joins and single table selects. - Expand options for where clauses to allow 'OR' conditionals as well as subgroupings of conditional clauses. - If you set prefetch columns for a table, these are now fetched along with other data for the table in a cursor, reducing the number of database SELECTs being done. - Added Alzabo::Create::Schema->clone method. This allows you to clone a schema object (except for the name, which must be changed as part of the cloning process). - Using the profiler, I have improved some of the hot spots in the code. I am not sure how noticeable these improvements are but I plan to do a lot more of this type of work in the future. - Added the Alzabo::ObjectCache::Sync::BerkeleyDB and Alzabo::ObjectCache::Sync::SDBM_File modules. These modules are much faster than the old DBMSync or IPCSync modules and actually appear to be faster than not syncing at all. The NullSync (now Sync::Null) module is still faster than all of them, however. BUG FIXES: - Reversing engineering a MySQL schema with ENUM or SET columns may have caused an error if the values for the enum/set contained spaces. - A bug in the schema creation interface made it impossible to create an index without a prefix. Reported by Sam Horrocks. - When dropping a table in Postgres, the sequences for its columns (if any), need to be dropped as well. Adapted from a patch submitted by Sam Horrocks. - The modules needed by the schema creator and data browser are now used by the components. However, it is still better to load them at server startup in order to maximize shared memory. - Calling the object cache's clear method did not work when using the IPCSync or NullSync modules. - Reverse engineering a Postgres database was choking on char(n) columns, which are converted internally by Postgres into bpchar(n) columns. This is now fixed (by converting them back during reverse engineering). - Reject column prefixes > 255 with MySQL. I hesitate to call this a bug fix since this appears to be undocumented in the MySQL docs. - Using the DBMSync module in an environment which started as one user and then became another (like Apache) may have caused permiission problems with the dbm file. This has been fixed. MISC: - Require DBD::Pg 0.97 (the latest version as of this writing) as it fixes some bugs in earlier versions. ARCHITECTURE: - Split up Row object into Alzabo::Runtime::Row (base class for standard uncached row) and Alzabo::Runtime::CachedRow (subclass for rows that have to interact with a cache). This simplifies the code, particulary in terms of how it interacts with the caching system. - Made Alzabo::Runtime::Row->get_data a private method. This served no purpose for end users anyway. --------------------------------------------------------------------------- 0.36 Mar 20, 2001 - Addition of Params::Validate broke several methods: -- The Alzabo::Schema->tables method was broken when trying to retrieve a subset of all the tables. -- The Alzabo::Create::Schema->move_table method was broken (thus breaking the ability to add a table at a specified place in the table order). -- Same problem for Alzabo::Create::Table->move_column. - Added to the test suite to catch all this in the future. - Attempting to dynamically generate component paths in the Mason component was a bad idea, particularly since it was unnecessary because I can find the component by doing '../common/foo'. Thanks to Bob Gustafson for suggesting this. - Fix bug in Postgres rules that didn't allow length for CHAR columns. - Fixed problems running multi-process tests with Postgres. --------------------------------------------------------------------------- 0.35 Mar 18, 2001 - Add ability to specify port parameter when connecting to DB for reverse engineering/data browser. - Fix support for host param in data browser. - Added a new Alzabo/FAQ.pod file. Its pretty skimpy but hopefully it will become more useful over time. - If your Mason component root was under your document then the links to return to the top levels of the schema creator and data browser were broken. Note: if your component root is entirely outside your document root then things may not work at all. - Add support for extra MySQL connection params (like mysql_default_file). See the Alzabo::Driver::MySQL docs for more details. - Add support for Postgres connect params 'options' and 'tty'. - Alzabo::Create::Schema->reverse_engineer was not passing the 'port' parameter to the driver when attempting to make a driver. - Attempting to pass in the port parameter to a connection would have generated a bad DSN due to a type in the code. - Started using Params::Validate so I can be even stricter about argument checking. - Fix bug introduced in 0.33. Changing a column's type always removed any length and precision setting for the column. Now it is only removed if the new column type does not allow a length or precision setting. - Fix some warnings in the Makefile.PL code. Also require Pod::Man >= 1.14 to handle =head3 and =head4 directives. - The Postgres code did not allow the ABSTIME, MACADDR, or RELTIME column types. These have been added. Thanks to Bob Gustafson for helping me find this problem. - The Alzabo::Create::Schema->reverse_engineer method was not doing anything with a host parameter. Reported by Aaron Johnson. - Fix bug in Alzabo::ObjectCache docs. Reported by Robin Berjon. - Include a first version of the quick method reference suggested by Robin Berjon. This Alzabo::QuickRef. The HTML version is table-ized and spiffed up a bit from the POD version. --------------------------------------------------------------------------- 0.34 Feb 26, 2001 - If you were trying to run the tests on a system without MySQL installed, or without the DB_File or IPC::Shareable modules, you saw lots of test failures, even if you said you did not plan to use the parts of Alzabo that required these. This has been fixed. I can now run the tests successfully using a Perl with only DBD::Pg and DBI installed and it will skip any tests that it can't run. - Fixed another caching bug related to objects that were deleted and then another row was inserted with the same primary key. Note to self: premature optimization is the root of all evil. --------------------------------------------------------------------------- 0.33 Feb 21, 2001 - The linking table methods generated by Alzabo::MethodMaker were broken. Fixed this. - Changed how order by clauses can be passed to select operations. Also changed the docs, which were way out of sync with the changes in this area. - Attempting to update more than one value at once was broken. Fixed this. - Added Alzabo::Runtime::Table->func method to allow arbitrary column aggregate functions like MAX, MIN, AVG, etc. - Fixed schema creator bug. It was not possible to change a column's NULLability after it was created. - When changing a column's type, Alzabo now removes any column attributes that are not valid for that column. In addition, if the existing length and precision parameters are not valid, they will be set to undef. - Fixed the code to get rid of weird error messages that came from DBI with Perl 5.6.0+ when the Alzabo::Create::Schema->create or Alzabo::Create::Schema->reverse_engineer methods were called. For the curious, this has to do with the DBI object passing through Storable::dclone. --------------------------------------------------------------------------- 0.32 Feb 7, 2001 - Forgot to include data browser files in MANIFEST. Caused weirdness if you said you wanted it when asked during install. Reported by Remi Cohen-Scali. --------------------------------------------------------------------------- 0.31 Feb 5, 2001 Bug fixes only - Fix bugs in Alzabo::MethodMaker. The insert, update, lookup_table, and self_relation (parent portion only) were broken. - A bug in the SQL making code was causing some queries to appear as if they failed when they didn't. --------------------------------------------------------------------------- 0.30 Feb 4, 2001 - The convert.pl script in eg/ has been updated to handle the new release. IMPORTANT: I forgot to include a mention of this in the last release but you need to run the script _before_ installing a new version of Alzabo. - Many improvements and updates to Alzabo::MethodMaker. Highlights include fixing a bug that prevented the insert and update methods from being created, a new callback system that allows you to specify all the method names to be generated, and a new 'self_relations' option for tables that have parent/child relationships with themself. - Fix handling of NULL columns for inserts and updates. Now, Alzabo only throws an exception if the column is not nullable and has no default. If it has a default and is specified as NULL then it will not be included in the INSERT clause (in which case the RDBMS should insert the default value itself). - Fix bugs in Postgres reverse engineering. Defaults were not handled properly, nor were numeric column type length and precision. - The schema creator and data browser now allow you to enter the host for database connections where needed. - Foreign keys can now span multiple columns. This means you can have a relation from foo.foo_id and foo.index_id to bar.foo_id and bar.index_id. This required some changes to the interface for the foreign key objects. Notably, the Alzabo::ForeignKey->column_from and Alzabo::ForeignKey->column_to methods are now Alzabo::ForeignKey->columns_from and Alzabo::ForeignKey->columns_to. In addition, the parameters given to the Alzabo::Create::Schema->add_relation have changed. - Major changes to caching architecture. The caching code has been split up. There is now a 'storing' class, which holds onto the objects (the cache). Then there is a 'sync' class. This class handles expiration and deletion tracking. These two classes can be mixed and matched. Right now there is only one storage class (which stores the objects in memory). There are 3 syncing classes. One, NullSync, doesn't actually sync objects. It does track deletions, but not expirations. The others, IPCSync and DBMSync, use IPC or DBM files to track expiration and deletion of objects. - Doing this work highlighted some bugs in the caching/syncing code. One oversight was that if you deleted an object and then inserted another row with the exact same primary key, the cache continued to think the object was deleted. Other bugs also surfaced. These have been fixed and the test suite has been updated so caching should be stable (if not, I'll have to cry). - When viewing an existing column in the schema creator, defaults, lengths, and precision of 0 were not being shown. - Alzabo::Runtime::Table->row_count can now take a where clause. - Fix bugs in Alzabo::Create::Table. This was causing problems with indexes when the table name was changed. - Fixed a bug in Alzabo::Util that caused the test cases to fail if Alzabo hadn't been previously installed. Reported by Robert Goff. - The SQLMaker class is now smarter about not letting you make bad SQL. For example, if you try to make a WHERE clause with tables not mentioned in the FROM clause, it will throw an exception. This will hopefully help catch logic errors in your code a bit sooner. - Removed use of prepare_cached in Alzabo::Driver. This has the potential to cause some strange errors under Alzabo. Because of the way Alzabo works, it is possible to have a Cursor object holding onto a statement handle that needs to be used elsewhere (by a row object, for example). It is safer to let a new statement handle be created in this case. INCOMPATIBILITIES - See the note above about the changes required to support multi-column foreign keys. - Because of the aforementioned changes to the caching architecture, caching just does not work the way it used to. 1. By default, there is no caching at all. 2. To get the old behavior, which defaulted to an in-process memory cache with no inter-process syncing (meaning deletes are tracked but there is no such thing as expiration), you can do this in your code: use Alzabo::ObjectCache( store => 'Alzabo::ObjectCache::MemoryStore', sync => 'Alzabo::ObjectCache::NullSync' ); or just: use Alzabo::ObjectCache; # the above modules are the defaults 3. To get the behavior of the old Alzabo::ObjectCacheIPC module, do: use Alzabo::ObjectCache( store => 'Alzabo::ObjectCache::MemoryStore', sync => 'Alzabo::ObjectCache::IPCSync' ); However, the new DBMSync module will probably scale better, and performance should be about the same for smaller applications. To use it, do: use Alzabo::ObjectCache( store => 'Alzabo::ObjectCache::MemoryStore', sync => 'Alzabo::ObjectCache::DBMSync' ); 4. If you run without any caching at all then the Alzabo::Runtime::Row class's behavior has changed somewhat. In particular, selects or updates against a deleted object will always throw an Alzabo::Exception::NoSuchRow exception. Before, the behavior wasn't very well defined. Please read the section on clearing the cache in the Alzabo::ObjectCache module, as this is an important concept. By default, the caching and syncing modules will just grow unchecked. You need to clear at the appropriate points (usually your application's entry points) in order to keep them under control. --------------------------------------------------------------------------- 0.20 Jan 9, 2001 - Preliminary Postgres support. There is no support yet for constraints or foreign keys when reverse engineering or making SQL. There is also no support for large objects (I'm hoping that 7.1 will be released soon so I won't have to think about this). Otherwise, the support is about at the same level as MySQL support, though less mature. - Added Alzabo::MethodMaker module. This can be used to auto-generate useful methods for your schema/table/row objects based on the properties of your objects themselves. - Reworking/expanding/clarifying/editing of the docs. - Add order_by and limit options whenever creating a cursor. - Method documentation POD from the Alzabo::* modules is merged into the relevant Alzabo::Create::* and Alzabo::Runtime::* modules during install. This should make it easier to find what you need since the average user will only need to look at a few modules in Alzabo::Runtime::*. - Reworked exceptions so they are all now Alzabo::Exception::Something. - Added default as a column attribute (thus there are now Alzabo::Column->default and Alzabo::Create::Column->set_default methods). - Added length & precision attributes for columns. Both are set through the Alzabo::Create::Column->set_length method. - This release includes a script in eg/ called convert.pl to convert older schemas. - Alzabo::Schema->tables & Alzabo::Table->columns now take an optional list of tables/columns as an argument and return a list of matching objects. - Added Alzabo::Column->has_attribute method. - The data browser has actually lost some functionality (the filtering). Making this more powerful is a fairly low priority at the moment. - Fix bugs where extra params passed to Alzabo::Runtime::Table->insert were not making it to the Alzabo::Runtime::Row->new method. - Fix for Alzabo::Runtime::Table->set_prefetch method. - Fixed bug in handling of deleted object in Alzabo::ObjectCacheIPC (they were never reported as deleted). - Fix bug that caused schema to get bigger every time it was saved. - Finally switched to regular hashes for objects. - Added Alzabo::SQLMaker classes to handle generating SQL in a cross-platform compatible way. DEPRECATIONS: - Parameters for Alzabo::Create::Column->new: 'null' parameter is now 'nullable'. The use of the parameter 'null' is deprecated. - Alzabo::Column->null & Alzabo::Column->set_null methods are now Alzabo::Column->nullable & Alzabo::Column->set_nullable. The old methods are deprecated. - Alzabo::Create::ForeignKey->new no longer requires table_from & table_to params (it took me this long to realize I can get that from the column passed in. doh!) INCOMPATIBILITIES: - Alzabo::Runtime::Table->rows_where parameters have changed. The from parameter has been removed (use the Alzabo::Runtime::Schema->join method instead). The where parameter expects something different now. - Alzabo::Runtime::Table->rows_by_where_clause method has been removed. - Alzabo::Runtime::Schema->join method's where parameter expects something different. --------------------------------------------------------------------------- 0.10_5 Oct 10, 2000 - You can now specify a database name to be used for testing. The default is 'test_alzabo'. This a good default for MySQL, at least. Thanks to Randal Schwartz for the help. - Make sure test file cleanup is done _before_ attempting tests so that files from a test previously aborted are cleaned up (and no errors are generated. Thanks to Randal Schwartz for the bug report. - Doesn't fail on install for Mason components if no Mason component extension was given. Thanks _again_ to Randal for working with me on this in IRC late at night. --------------------------------------------------------------------------- 0.10_4 Oct 10, 2000 - Fix Makefile.PL bug - Auto select a column when adding a relation (if there is a logical one to select). --------------------------------------------------------------------------- 0.10_3 - Fix bug with deleting foreign key objects from tables. --------------------------------------------------------------------------- 0.10 **FIRST BETA VERSION** - Doc bug fixes in Alzabo::Runtime::Schema. - Fix fact that Alzabo::Runtime::Row rows_by_foreign_key method could return either a Row _or_ RowCursor object. Now it always returns a cursor object. - Fix fact that no_cache parameter was not propagated through the RowCursor object to the rows it created. - Add all all_rows method to Alzabo::Runtime::RowCursor. - Add ability to reset instantiation flag in schema creation interface. - Updated INSTALL to mention how to get the schema creator and data browser working. - Finally make creating relations between tables _without_ specifying the columns work. This does some, IMHO, pretty cool DWIMmery. - Added primary_key param to Alzabo::Runtime::Table make_column method. - Added set_host and host methods to Alzabo::Runtime::Schema. - Added drop method to Alzabo::Create::Schema and necessary support in driver modules. - Changed 'id' param to 'pk' for Alzabo::Runtime::Table row_by_pk method. 'id' still works, for now, but is deprecated. - Fix problem where an insert could generate a referential integrity exception but still end up in the database. Note, without transactions (in MySQL, for example), there's no way to make the all of the referential integrity code work correctly 100% of the time. - Added new class Alzabo::ObjectCache to make sure that objects stay in sync after referential integrity operations happen. This is now the default caching class. Please make sure to read the docs for this new module, particularly if you're running Alzabo under a persistent environment where this module can be quite the memory hog if not used properly (clear the cache!). - Fixed breakage in maintenance of referential integrity caused by switch to cursors (and me not fixing all the code that expected row objects). - Added Alzabo::Runtime::Cursor base class. - Added join method to Alzabo::Runtime::Schema. *EXPERIMENTAL* - Added Alzabo::Runtime::JoinCursor class. *EXPERIMENTAL* - Began conversion of all classes from pseudohash to hash. - Both schema creator and data browser now respect user choice of component extension. --------------------------------------------------------------------------- 0.09 - MAJOR CHANGE: All the Alzabo::Runtime::Row methods that used to return lists of rows now return the new Alzabo::Runtime::RowCursor object. This change is a major speed and memory optimization. It does, however, break the old interface. But its worth it. - Set autohandlers for schema maker and data browser so that they won't inherit from other autohandlers higher up the directory tree. - Fix bug in Alzabo::Driver which made it so that the one_row_hash method always returned a hash with keys. This caused spurious row object to be created in the Alzabo::Runtime::Row class. - Fix bug in Alzabo::Table::rows_where method where it wasn't handling the construct $table->rows_where( where => { foo => undef } ) properly. --------------------------------------------------------------------------- 0.08 - Lazy column evaluation had made it possible to create an Alzabo::Runtime::Row object that did not correspond to any data in the database if its table object did specify any rows to prefetch. This would have only been discovered later by calling the select method on a non-primary key column. This hole was plugged. - As a corollary to the above change methods in Alzabo::Runtime::Table that produce rows now always return an empty list or undef when the rows cannot be made because the specified primary key doesn't exist. Previously, the rows_by_where_clause method did this while others would cause an exception either during the object creation or later, depending upon the situation described above. - GENERAL NOTE: I probably used exceptions too much, as in the above case. I will probably be making a few more changes like this in the future. - Bug fix in Alzabo::RDBMSRules when making SQL diffs. Forgot to account for new foreign key method names. - Bug fix related to MySQL auto_increment column and Alzabo::Runtime::Table insert method. Basically, you couldn't insert into a table and use its auto_increment feature. - Alzabo::Table::set_prefetch now makes sure that primary key columns are not included. It simply ignores them but they will not be returned by the prefetch method. - fix bug where some row retrieval methods would fail if not given a 'bind' parameter. - Doc bug fix. Docs for Alzabo::Runtime::Table listed group_by_column as simply group. Of course, this probably only needs to be used by Alzabo::Runtime::Row anyway. - Added Alzabo::Runtime::Table rows_where method. - Added Alzabo::Runtime::Table all_rows method. - Documented 'bind' parameter for Alzabo::Runtime::Table rows_by_where_clause method. --------------------------------------------------------------------------- 0.07 - Fixed major bugs in Alzabo::Runtime::Table::insert method. - Fixed bug in Alzabo::Runtime::Row::delete method related to API change in 0.06 - Reduce amount of work done in Alzabo::Runtime::Row when referential integrity maintenance is set to false. - Added new method to Alzabo::Runtime::Row: rows_by_foreign_key. A row can now fetch the rows that are related to it automatically. - Made all Alzabo::Table foreign key object returning methods list/scalar context sensitive. This is useful when you know that there is only one foreign key that matches what you are looking for. --------------------------------------------------------------------------- 0.06 - change return value from Alzabo::Index id method to be something that can be an actual index name. This is a bug fix as previously index SQL was not valid (at least not for MySQL). - cosmetic fixes in schema creator - moved exception component to common mason files so its shared by schema creator and data browser. - added Index attribute of unique (so we can make unique indexes). - made SQL making code for MySQL aware of this. - added ability to set this to schema creator. - added ability to specify column order in an index in schema creator. - made it possible for a table to have more than one foreign from a given column. documented how this changes API in Alzbo::Table. - API: The Alzabo::Table foreign_keys() method name has been changed to all_foreign_keys(). The foreign_key method (which returns keys by table to and column from) is now the foreign_keys() method because it can return more than one object. - change schema creator, Alzabo::Create::Schema module, and 03/create.t test to handle this properly. - added ability to move columns and tables to arbitrary new locations after they've been created (without the arrows). --------------------------------------------------------------------------- 0.05 - bug fix for Alzabo::Runtime::Row calling wrong method from schema object - got rid of the locking stuff in the MySQL driver. Since its not possible to have more than 1 lock at a time with the GET_LOCK function there's no way to have the right kinds of locks for cascading deletes. It might be possible to do this kind of locking via some other mechanism (semaphores, DBM files, whatever, but that's a hack for another day. --------------------------------------------------------------------------- 0.04 - Switched to use Tie::IxHash object interface - fixed stupid bug in Alzabo::RDBMSRules::MySQL - changed the way Alzabo::ChangeTracker works. it requires fewer method calls to do its job now. - added set_referential_integrity/referential_integrity methods to Alzabo::Runtime::Schema. The default is to not attempt to maintain referential_integrity. - It should no longer be possible for Alzabo::Runtime::ForeignKey objects to create loops when maintaining referential integrity. It also should be a bit more efficient in the register_delete method. If no action needs to be taken, it won't loop through all the rows in the related table before finding this out. - fixed data browser bug when putting in a filter on any page that was not the first page of results for a table. - fixed data browser bug in paging with filters. --------------------------------------------------------------------------- 0.03 - Fixed bugs in Alzabo::ObjectCacheIPC so it now works. - Added lazy column evaluation (see Alzabo::Runtime::Table) docs - Added Alzabo::DriverStatement and Alzabo::Driver::Exception to Alzabo::Driver - improved data browser memory efficiency - minor bug fixes (bad links) in data browser and schema maker - minor buglet fix in Alzabo::Driver::MySQL - big fix to how Alzabo::Runtime::Schema is saved from Alzabo::Create::Schema. Previous implementation was accidentally saving both the runtime and create versions at once. The new version fixes this. Alzabo-0.92/README0000444000175000017500000001014010721343227013367 0ustar autarchautarchABOUT Alzabo is a two-fold program. Its first function is as a data modelling tool. Through either a schema creation interface or a custom perl program, you can create a set of schema, table, column, etc. objects that represent your data model. Alzabo is also capable of reverse engineering an existing data model. Its second function is as a RDBMS to object mapping system. Once you have created a schema, you can use the Alzabo::Runtime::Table and Alzabo::Runtime::Row classes to access its data. These classes offer a high level interface to common operations such as SQL SELECT, INSERT, DELETE, and UPDATE commands. To take it a step further, you could then aggregate a set of rows from different tables into a larger container object which could understand the logical relationship between these tables. The Alzabo::MethodMaker module can be very helpful in this regard. For more information please see the Alzabo docs (start with perldoc Alzabo) or the Alzabo homepage at http://www.alzabo.org/. The full documentation in HTML form is available at http://www.alzabo.org/docs/. Install information is in the INSTALL file. REQUIREMENTS Alzabo passes all its test with Perl 5.6.1+. 5.6.0 is known to be buggy and not recommended. Alzabo currently supports MySQL (3.23.x or 4.0.x release is recommended) and Postgres (7.2.x or newer is recommended). Alzabo also requires a number of modules, and will prompt you to install them if necessary. Of course, if you install Alzabo via the CPAN or CPANPLUS shells this will be handled for you. SUPPORT The Alzabo docs are conveniently located online at http://www.alzabo.org/docs/. There is also a mailing list. You can sign up at http://lists.sourceforge.net/lists/listinfo/alzabo-general. Please don't email me directly. Use the list instead so others can see your questions. REPORTING BUGS If you are getting some sort of error message, please set the environment variable ALZABO_DEBUG to TRACE and then send the now very verbose error message to the mailing list. If you are experiencing test failures, please run the tests like this: ./Build test verbose=1 and send the output along with the bug report. Otherwise I'll just ask you to do this before I can do anything. UPGRADING As of version 0.65, Alzabo automatically upgrades older schemas as it loads them. This works for schemas made by versions going back to version 0.55. BUGS - Forking apps and Postgres In testing, I found that there were some problems using Postgres in a situation where you start the app, connect to the database, get some data, fork, reconnect, and and then get more data. I suspect that this has more to do with the DBD::Pg driver and/or Postgres itself than Alzabo. I don't believe this would be a problem with an app which forks before ever connecting to the database (such as mod_perl). I have structured the test suite to avoid this problem in testing but forewarned is forearmed (or something like that). - make_html_docs.pl and Pod::Html There are links in some of the POD that Pod::Html fails to resolve. This causes warnings when running make_html_docs.pl. However, the generated HTML files are processed to correct these problems so you can just ignore them. CREDITS Ilya Martynov deserves special thanks for providing a _lot_ of patches as well as many useful suggestions on new features, bug fixing, etc. Ken Williams contributed a number of patches, many of which focused on improving Postgres support. Bob Gustafson has provided extensive assistance in testing and debugging. Thanks very much to Randal Schwartz for spending time with me on IRC helping me find problems with the install process way back in the early releases. Some features in Alzabo have been borrowed or influenced by Class:DBI (Michael Schwern and Tony Bowden) and Tangram (Jean-Louis Leroy). Various bug reports and assistance from: Alexei Barantsev Robin Berjon Brad Bowman Terrence Brannon Remi Cohen-Scali Martin Ertl Daniel Gaspani Robert Goff Raul Nohea Goodness Michael Graham Eric Hillman Barry Hoggard Sam Horrocks Aaron Johnson Josh Jore Dan Martinez William McKee Dana Powers Jared Rhine Ron Savage Jeremy R. SemeiksAlzabo-0.92/TODO0000444000175000017500000000527510721343227013214 0ustar autarchautarchTo Do List Short term: - Track multiple historical versions of a schema like VMWare's snapshot/clone system. Store each copy separately on disk for efficiency. - Make RDBMSRules query driver for more stuff (max identifier length, reverse engineering, etc.). This will require an active driver when a new schema is created, however. - Overhaul foreign key objects so that one relationship has one such object, shared by two tables. - Add constraints to output SQL for MySQL (InnoDB tables will actually use them). - Make sense of foreign key definitions for InnoDB tables in MySQL. - Table update & delete. - Update & delete "handles", to avoid having to regenerate SQL over and over. - Batch insert ? - Add Alzabo::Runtime::Schema->clone method. - allow defaults to be marked as functions ( NOW() ) so they're not quoted in DDL SQL. Medium term: - reconsider MethodMaker's pre/post hooks and try to re-implement in a more flexible/sane manner. - Abort during Build.PL if supplied username/pw cannot connect to DB (and try to test privs too). Suggested by Robert Creager. - Output Dia XML. - Make a tool to convert schemas from one RDBMS to another. This will probably require user prompting because some things are unresolvable without a loss of information. - Add an Alzabo::Database class between the schema and table. This will allow multiple databases in a schema (on multiple platforms ideally) and allow you to do joins between these databases. This probably raises all sorts of horrid transactional issues I haven't yet thought of. - Attempt to guess relationships when reverse engineering a schema without foreign key information. - More drivers & rules (Oracle, Sybase, Interbase, Solid, and so on) - Integrate data validation into the code and schema creator in such a way that Alzabo::MethodMaker can automatically create pre_insert and pre_update methods. - Expand regression tests for core API - SQLMaker, RDBMSRules. - Give the options to save objects to disk in something a bit more robust than a serialized object form. Eventually, Alzabo will spit out some sort of XML. Ongoing: - Support 'feature probing' via the rules for user interface and to determine whether to try to do things (like use transactions). This is a broad idea and includes things such as returning a list of possible column types to the user interface or having a flag for supporting transactions. - Robin Berjon suggested a single documentation 'page' that contains a list of all the method and what objects they apply to. This exists as Alzabo::QuickRef. - Support any and all SQL, of arbitrary complexity. This is fairly far along. - Non-Mason interface(s) (curses, plain CGI) Alzabo-0.92/mason/0000755000175000017500000000000010721343227013632 5ustar autarchautarchAlzabo-0.92/mason/widgets/0000755000175000017500000000000010721343227015300 5ustar autarchautarchAlzabo-0.92/mason/widgets/update0000444000175000017500000000157010721343227016506 0ustar autarchautarch<%doc> =pod =head1 NAME update =head1 SYNOPSIS <& update, table => $table, %ARGS &> =head1 DESCRIPTION A simple widget to perform an update based on the values of %ARGS. =head1 PARAMETERS =over 4 =item * table An object which contains the row to be updated =back The rest of the arguments should simply be the C<%ARGS> hash as passed to the calling component. This component will extract the relevant column values from that hash. =head1 RETURNS The row just updated is returned from this component. =cut <%args> $table <%init> my %data; my %pk; foreach my $c ( $table->primary_key ) { $pk{ $c->name } = $ARGS{ $c->name }; } foreach my $c ( $table->columns ) { $data{ $c->name } = $ARGS{ $c->name } if exists $ARGS{ $c->name }; } my $row = $table->row_by_primary_key( pk => \%pk ); $row->update(%data); return $row; Alzabo-0.92/mason/widgets/fk_to_one_select0000444000175000017500000000360710721343227020531 0ustar autarchautarch<%doc> =pod =head1 NAME fk_to_one_select =head1 DESCRIPTION Given a foreign key and an optional row, this component produces a select form element for that relationship. If a row is given, then its value will be used as the default value for the form element. =head1 PARAMETERS =over 4 =item * fk (required) An C object representing the relationship. =item * row (optional) An Alzabo row object. =item * class (optional) This defaults to C<< $m->base_comp->attr_if_exists('fk_to_one_select_class_default') >>. =item * foreign_rows (optional) This allows you to pre-select the rows in the foreign table that will be used for the select options. Otherwise, the component simple grabs all the available rows from the foreign table. =item * display_column (optional) This is the column in the foreign table which should be used as the visible value of each option. This defaults to the column involved in the foreign key relationship. =back =cut <%args> $fk $row => undef @foreign_rows => () $class => $m->base_comp->attr_if_exists('fk_to_one_select_class_default') $display_column => undef <%init> # I'm a wuss. Don't know how to handle this. my @col_from = $fk->columns_from; return if @col_from > 1; my $col_from = shift @col_from; my $col_to = $fk->columns_to; @foreign_rows = $col_to->table->all_rows->all_rows unless @foreign_rows; my $current; $current = $row->select( $col_from->name ) if $row; $display_column = $col_to unless defined $display_column; Alzabo-0.92/mason/widgets/edit_field_textarea0000444000175000017500000000323610721343227021212 0ustar autarchautarch<%doc> =pod =head1 NAME edit_field_textarea =head1 SYNOPSIS <& edit_field_textarea, column => $column, row => $row &> =head1 DESCRIPTION Given a column and an optional row, this component produces a textarea form element for that column. If a row is given, then its value will be used as the default value for the form element. =head1 PARAMETERS =over 4 =item * column (required) An C object. =item * row (optional) An Alzabo row object. =item * class (optional) This defaults to C<< $m->base_comp->attr_if_exists('textarea_class_default') >>. =item * rows (optional) If not given, this defaults to C<< $m->base_comp->attr_if_exists('textarea_rows_default') >> if it exists, or 4 if it does not. =item * cols (optional) If not given, this defaults to C<< $m->base_comp->attr_if_exists('textarea_cols_default') >> if it exists, or 40 if it does not. =item * wrap (optional) If not given, this defaults to C<< $m->base_comp->attr_if_exists('textarea_wrap_default') >> if it exists, or "multiple" if it does not. =back =cut \ <%args> $row => undef $column $class => $m->base_comp->attr_if_exists('textarea_class_default') || '' $rows => $m->base_comp->attr_if_exists('textarea_rows_default') || 4 $cols => $m->base_comp->attr_if_exists('textarea_cols_default') || 40 $wrap => $m->base_comp->attr_if_exists('textarea_wrap_default') || 'multiple' <%init> my $val; my $col_name = ref $column ? $column->name : $column; if (defined $row) { $val = $row->select( $col_name ); } $val = '' unless defined $val; Alzabo-0.92/mason/widgets/insert_or_update0000444000175000017500000000165010721343227020571 0ustar autarchautarch<%doc> =pod =head1 NAME insert_or_update =head1 SYNOPSIS <& insert_or_update, table => $table, %ARGS &> =head1 DESCRIPTION A simple component to perform an insert or update based on the values of %ARGS. An insert is done if the primary key columns for the table are not defined in C<%ARGS>. Otherwise an update is done. =head1 PARAMETERS =over 4 =item * table An object into which a new row is inserted or an existing row is updated. =back The rest of the arguments should simply be the C<%ARGS> hash as passed to the calling component. This component will extract the relevant column values from that hash. =head1 RETURNS The row that was inserted or updated. =cut <%args> $table <%init> my $insert = 1; foreach my $c ( $table->primary_key ) { $insert = 0 unless defined $ARGS{ $c->name }; } return $insert ? $m->comp( 'insert', %ARGS ) : $m->comp( 'update', %ARGS ); Alzabo-0.92/mason/widgets/edit_field_checkbox0000444000175000017500000000211510721343227021156 0ustar autarchautarch<%doc> =pod =head1 NAME edit_field_checkbox =head1 SYNOPSIS <& edit_field_checkbox, column => $column, row => $row &> =head1 DESCRIPTION Given a column and an optional row, this component produces a checkbox form element for that column. The value of this column when checked is 1. If a row is given, then its value will determine whether or not the checkbox is checked. Otherwise the column's default value will be used. =head1 PARAMETERS =over 4 =item * column (required) An C object. =item * row (optional) An Alzabo row object. =item * class (optional) This defaults to C<< $m->base_comp->attr_if_exists('checkbox_class_default') >>. =back =cut class="<% $class %>">\ <%args> $column $row => undef $class => $m->base_comp->attr_if_exists('checkbox_class_default') <%init> my $true; my $col_name = ref $column ? $column->name : $column; if (defined $row) { $true = $row->select( $col_name ); } else { $true = $column->default; } Alzabo-0.92/mason/widgets/insert0000444000175000017500000000135210721343227016526 0ustar autarchautarch<%doc> =pod =head1 NAME insert =head1 SYNOPSIS <& insert, table => $table, %ARGS &> =head1 DESCRIPTION A simple component to perform an insert based on the values of %ARGS. =head1 PARAMETERS =over 4 =item * table An object into which a new row will be inserted. =back The rest of the arguments should simply be the C<%ARGS> hash as passed to the calling component. This component will extract the relevant column values from that hash. =head1 RETURNS The new row that was inserted is returned. =cut <%args> $table <%init> my %data; foreach my $c ( $table->columns ) { $data{ $c->name } = $ARGS{ $c->name } if exists $ARGS{ $c->name }; } return $table->insert( values => \%data ); Alzabo-0.92/mason/widgets/edit_field_text_input0000444000175000017500000000333610721343227021601 0ustar autarchautarch<%doc> =pod =head1 NAME edit_field_text_input =head1 SYNOPSIS <& edit_field_text_input, column => $column, row => $row &> =head1 DESCRIPTION Given a column and an optional row, this component produces a text input form element for that column. If a row is given, then its value will be used as the default value for the form element. =head1 PARAMETERS =over 4 =item * column (required) An C object. =item * row (optional) An Alzabo row object. =item * class (optional) This defaults to C<< $m->base_comp->attr_if_exists('text_input_class_default') >>, which makes it easy to set up default styles for this form element. =item * size (optional) If this is not given, it default to C<< $m->base_comp->attr_if_exists('text_input_size_default') >> if available, otherwise 30. =item * maxlength (optional) If this is not given, the component tries to come up with some reasonable value based on the column's type and length. =back =cut \ <%args> $row => undef $column $class => $m->base_comp->attr_if_exists('text_input_class_default') $size => $m->base_comp->attr_if_exists('text_input_size_default') || 30 $maxlength => $size <%init> my $val; my $col_name = ref $column ? $column->name : $column; if (defined $row) { $val = $row->select( $col_name ); } $val = '' unless defined $val; $maxlength = $column->length && $column->length < $maxlength ? $column->length : ( ! $column->is_character ? 10 : $maxlength ); if ( $maxlength > $size && exists $ARGS{size} ) { $maxlength = $size; } elsif ( $maxlength < $size ) { $size = $maxlength; } Alzabo-0.92/MANIFEST0000444000175000017500000000444610721343227013654 0ustar autarchautarchBuild.PL Changes eg/alzabo_grep eg/alzabo_to_ascii eg/convert.pl eg/reverse_cardinality.pl inc/Alzabo/Build.pm inc/Alzabo/Config.pm.tmpl INSTALL install_helpers/pod_merge.pl lib/Alzabo.pm lib/Alzabo/BackCompat.pm lib/Alzabo/ChangeTracker.pm lib/Alzabo/Column.pm lib/Alzabo/ColumnDefinition.pm lib/Alzabo/Create.pm lib/Alzabo/Create/Column.pm lib/Alzabo/Create/ColumnDefinition.pm lib/Alzabo/Create/ForeignKey.pm lib/Alzabo/Create/Index.pm lib/Alzabo/Create/Schema.pm lib/Alzabo/Create/Table.pm lib/Alzabo/Debug.pm lib/Alzabo/Design.pod lib/Alzabo/Driver.pm lib/Alzabo/Driver/MySQL.pm lib/Alzabo/Driver/PostgreSQL.pm lib/Alzabo/Exceptions.pm lib/Alzabo/FAQ.pod lib/Alzabo/ForeignKey.pm lib/Alzabo/Index.pm lib/Alzabo/Intro.pod lib/Alzabo/MethodMaker.pm lib/Alzabo/MySQL.pod lib/Alzabo/PostgreSQL.pod lib/Alzabo/QuickRef.pod lib/Alzabo/RDBMSRules.pm lib/Alzabo/RDBMSRules/MySQL.pm lib/Alzabo/RDBMSRules/PostgreSQL.pm lib/Alzabo/Runtime.pm lib/Alzabo/Runtime/Column.pm lib/Alzabo/Runtime/ColumnDefinition.pm lib/Alzabo/Runtime/Cursor.pm lib/Alzabo/Runtime/ForeignKey.pm lib/Alzabo/Runtime/Index.pm lib/Alzabo/Runtime/InsertHandle.pm lib/Alzabo/Runtime/JoinCursor.pm lib/Alzabo/Runtime/Row.pm lib/Alzabo/Runtime/RowCursor.pm lib/Alzabo/Runtime/RowState/Deleted.pm lib/Alzabo/Runtime/RowState/InCache.pm lib/Alzabo/Runtime/RowState/Live.pm lib/Alzabo/Runtime/RowState/Potential.pm lib/Alzabo/Runtime/Schema.pm lib/Alzabo/Runtime/Table.pm lib/Alzabo/Runtime/UniqueRowCache.pm lib/Alzabo/Schema.pm lib/Alzabo/SQLMaker.pm lib/Alzabo/SQLMaker/MySQL.pm lib/Alzabo/SQLMaker/PostgreSQL.pm lib/Alzabo/Table.pm lib/Alzabo/Utils.pm LICENSE Makefile.PL MANIFEST This list of files mason/widgets/edit_field_checkbox mason/widgets/edit_field_text_input mason/widgets/edit_field_textarea mason/widgets/fk_to_one_select mason/widgets/insert mason/widgets/insert_or_update mason/widgets/update META.yml README t/01-compile.t t/01-driver.t t/02-create.t t/03-runtime.t t/04-rev-engineer.t t/05a-rules-mysql.t t/05b-rules-pg.t t/07-methodmaker.t t/09-storable.t t/12-rev-engineer-pg-fk.t t/14-unique-row-cache.t t/15-alias-ref.t t/17-insert-handle.t t/18-debug-null-bug.t t/19-schema-name.t t/20-rev-engineer-pg-now.t t/21-row_by_pk-exception.t t/98-schema-diff.t t/99-cleanup.t t/99-pod.t t/lib/Alzabo/Test/Utils.pm TODO SIGNATURE Added here by Module::Build Alzabo-0.92/Makefile.PL0000444000175000017500000000163210721343227014467 0ustar autarchautarchuse strict; unless (eval "use Module::Build 0.20; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build from CPAN?', 'y'); if ($yn =~ /^y/i) { require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); my $makefile = File::Spec->rel2abs($0); CPAN::Shell->install('Module::Build::Compat'); chdir $cwd or die "Cannot chdir() back to $cwd: $!"; exec $^X, $makefile, @ARGV; # Redo now that we have Module::Build } else { warn " *** Cannot install without Module::Build. Exiting ...\n"; exit 1; } } require Module::Build::Compat; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(); Alzabo-0.92/lib/0000755000175000017500000000000010721343227013263 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/0000755000175000017500000000000010721343227014473 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/RDBMSRules/0000755000175000017500000000000010721343227016355 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/RDBMSRules/MySQL.pm0000444000175000017500000006517510721343227017674 0ustar autarchautarchpackage Alzabo::RDBMSRules::MySQL; use strict; use vars qw($VERSION); use Alzabo::RDBMSRules; use base qw(Alzabo::RDBMSRules); $VERSION = 2.0; sub new { my $proto = shift; my $class = ref $proto || $proto; return bless {}, $class; } sub validate_schema_name { my $self = shift; my $name = shift->name; Alzabo::Exception::RDBMSRules->throw( error => "Schema name must be at least one character long" ) unless length $name; # These are characters that are illegal in a dir name. I'm trying # to accomodate both Win32 and UNIX here. foreach my $c ( qw( : \ / ) ) { Alzabo::Exception::RDBMSRules->throw( error => "Schema name contains an illegal character ($c)" ) if index($name, $c) != -1; } } # Note: These rules are valid for MySQL 3.22.x. MySQL 3.23.x is # actually less restrictive but this should be enough freedom. sub validate_table_name { my $self = shift; my $name = shift->name; Alzabo::Exception::RDBMSRules->throw( error => "Table name must be at least one character long" ) unless length $name; Alzabo::Exception::RDBMSRules->throw( error => "Table name is too long. Names must be 64 characters or less." ) if length $name >= 64; Alzabo::Exception::RDBMSRules->throw( error => "Table name must only contain alphanumerics or underscore(_)." ) if $name =~ /\W/; } sub validate_column_name { my $self = shift; my $name = shift->name; Alzabo::Exception::RDBMSRules->throw( error => "Column name must be at least one character long" ) unless length $name; Alzabo::Exception::RDBMSRules->throw( error => 'Name is too long. Names must be 64 characters or less.' ) if length $name >= 64; Alzabo::Exception::RDBMSRules->throw( error => 'Name contains characters that are not alphanumeric or the dollar sign ($).' ) if $name =~ /[^\w\$]/; Alzabo::Exception::RDBMSRules->throw( error => 'Name contains only digits. Names must contain at least one alpha character.' ) unless $name =~ /[^\W\d]/; } sub validate_column_type { my $self = shift; my $type = shift; $type = 'INTEGER' if uc $type eq 'INT'; # Columns which take no modifiers. my %simple_types = map {$_ => 1} ( qw( DATE DATETIME TIME TINYBLOB TINYTEXT BLOB TEXT MEDIUMBLOB MEDIUMTEXT LONGBLOB LONGTEXT INTEGER TINYINT SMALLINT MEDIUMINT BIGINT FLOAT DOUBLE REAL DECIMAL NUMERIC TIMESTAMP CHAR VARCHAR YEAR ), ); return uc $type if $simple_types{uc $type}; return 'DOUBLE' if $type =~ /DOUBLE\s+PRECISION/i; return 'CHAR' if $type =~ /\A(?:NATIONAL\s+)?CHAR(?:ACTER)?/i; return 'VARCHAR' if $type =~ /\A(?:NATIONAL\s+)?(?:VARCHAR|CHARACTER VARYING)/i; my $t = $self->_capitalize_type($type); return $t if $t; Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized type: $type" ); } sub _capitalize_type { my $self = shift; my $type = shift; if ( uc substr($type, 0, 4) eq 'ENUM' ) { return 'ENUM' . substr($type, 4); } elsif ( uc substr($type, 0, 3) eq 'SET' ) { return 'SET' . substr($type, 3); } else { return uc $type; } } sub validate_column_length { my $self = shift; my $column = shift; # integer column if ( $column->type =~ /\A(?:(?:(?:TINY|SMALL|MEDIUM|BIG)?INT)|INTEGER)/i ) { Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) if defined $column->length && $column->length > 255; Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." ) if defined $column->precision; return; } if ( $column->type =~ /\A(?:FLOAT|DOUBLE(?:\s+PRECISION)?|REAL)/i ) { if (defined $column->length) { Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) if $column->length > 255; Alzabo::Exception::RDBMSRules->throw( error => "Max display value specified without floating point precision." ) unless defined $column->precision; Alzabo::Exception::RDBMSRules->throw( error => "Floating point precision is too high. The maximum value is " . "30 or the maximum display size - 2, whichever is smaller." ) if $column->precision > 30 || $column->precision > ($column->length - $column->precision); } return; } if ( $column->type =~ /\A(?:DECIMAL|NUMERIC)\z/i ) { Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) if defined $column->length && $column->length > 255; Alzabo::Exception::RDBMSRules->throw( error => "Floating point precision is too high. The maximum value is " . "30 or the maximum display size - 2, whichever is smaller." ) if defined $column->precision && ($column->precision > 30 || $column->precision > ($column->length - 2) ); return; } if ( uc $column->type eq 'TIMESTAMP' ) { Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 14." ) if defined $column->length && $column->length > 14; Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." ) if defined $column->precision; return; } if ( $column->type =~ /\A(?:(?:NATIONAL\s+)?VAR)?(?:CHAR|BINARY)/i ) { Alzabo::Exception::RDBMSRules->throw( error => "(VAR)CHAR and (VAR)BINARY columns must have a length provided." ) unless defined $column->length && $column->length > 0; Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) if $column->length > 255; Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." ) if defined $column->precision; return; } if ( uc $column->type eq 'YEAR' ) { Alzabo::Exception::RDBMSRules->throw( error => "Valid values for the length specification are 2 or 4." ) if defined $column->length && ($column->length != 2 && $column->length != 4); return; } Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a length or precision." ) if defined $column->length || defined $column->precision; } # placeholder in case we decide to try to do something better later sub validate_table_attribute { 1 } sub validate_column_attribute { my $self = shift; my %p = @_; my $column = $p{column}; my $a = uc $p{attribute}; $a =~ s/\A\s//; $a =~ s/\s\z//; if ( $a eq 'UNSIGNED' || $a eq 'ZEROFILL' ) { Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to numeric columns" ) unless $column->is_numeric; return; } if ( $a eq 'AUTO_INCREMENT' ) { Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to integer columns" ) unless $column->is_integer; return; } if ($a eq 'BINARY') { Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to character columns" ) unless $column->is_character; return; } return if $a =~ /\A(?:REFERENCES|UNIQUE\z)/i; Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized attribute: $a" ); } sub validate_primary_key { my $self = shift; my $col = shift; Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns cannot be part of a primary key' ) if $col->type =~ /\A(?:TINY|MEDIUM|LONG)?(?:BLOB|TEXT)\z/i; } sub validate_sequenced_attribute { my $self = shift; my $col = shift; Alzabo::Exception::RDBMSRules->throw( error => 'Non-integer columns cannot be sequenced' ) unless $col->is_integer; Alzabo::Exception::RDBMSRules->throw( error => 'Only one sequenced column per table is allowed.' ) if grep { $_ ne $col && $_->sequenced } $col->table->columns; } sub validate_index { my $self = shift; my $index = shift; foreach my $c ( $index->columns ) { my $prefix = $index->prefix($c); if (defined $prefix) { Alzabo::Exception::RDBMSRules->throw( error => "Invalid prefix specification ('$prefix')" ) unless $prefix =~ /\d+/ && $prefix > 0; Alzabo::Exception::RDBMSRules->throw( error => 'Non-character/blob columns cannot have an index prefix' ) unless $c->is_blob || $c->is_character || $c->type =~ /^(?:VAR)BINARY$/i; } if ( $c->is_blob ) { Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns must have an index prefix' ) unless $prefix || $index->fulltext; } if ( $index->fulltext ) { Alzabo::Exception::RDBMSRules->throw( error => 'A fulltext index can only include text or char columns' ) unless $c->is_character; } } Alzabo::Exception::RDBMSRules->throw( error => 'An fulltext index cannot be unique' ) if $index->unique && $index->fulltext; Alzabo::Exception::RDBMSRules->throw( error => 'MySQL does not support function indexes' ) if defined $index->function; } sub type_is_integer { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /\A(?:(?:TINY|SMALL|MEDIUM|BIG)?INT|INTEGER)\z/; } sub type_is_floating_point { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /\A(?:DECIMAL|NUMERIC|FLOAT|DOUBLE|REAL)\z/; } sub type_is_char { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /(?:CHAR|TEXT)\z/; } sub type_is_date { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /\A(?:DATE|DATETIME|TIMESTAMP)\z/; } sub type_is_datetime { my $self = shift; my $col = shift; my $type = uc $col->type; if ( $type eq 'TIMESTAMP' ) { # default length is 14 return 1 unless defined $col->length; return $col->length > 8; } return 1 if $type eq 'DATETIME'; } sub type_is_time { my $self = shift; my $col = shift; my $type = uc $col->type; if ( $type eq 'TIMESTAMP' ) { return $col->length > 8; } return 1 if $type =~ /\A(?:DATETIME|TIME)\z/; } sub type_is_time_interval { 0 } sub type_is_blob { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /BLOB\z/; } sub blob_type { return 'BLOB' } sub column_types { return qw( TINYINT SMALLINT MEDIUMINT INTEGER BIGINT FLOAT DOUBLE DECIMAL NUMERIC CHAR VARCHAR DATE DATETIME TIME TIMESTAMP YEAR TINYTEXT TEXT MEDIUMTEXT LONGTEXT TINYBLOB BLOB MEDIUMBLOB LONGBLOB ); } my %features = map { $_ => 1 } qw ( extended_column_types index_prefix fulltext_index allows_raw_default ); sub feature { shift; return $features{+shift}; } sub schema_sql { my $self = shift; my $schema = shift; my @sql; foreach my $t ( map { $self->_clean_table_name($_) } $schema->tables ) { push @sql, $self->table_sql($t); } # This has to come at the end because we don't which tables # reference other tables. foreach my $t ( $schema->tables ) { foreach my $fk ( $t->all_foreign_keys ) { push @sql, $self->foreign_key_sql($fk); } } return @sql; } sub _clean_table_name { if ( $_[1] =~ /(?:`\w+`\.)?`(\w+)`/ ) { return $1; } return $_[1]; } sub table_sql { my $self = shift; my $table = shift; my $sql = "CREATE TABLE " . $table->name . " (\n "; $sql .= join ",\n ", map { $self->column_sql($_) } $table->columns; if (my @pk = $table->primary_key) { $sql .= ",\n"; $sql .= ' PRIMARY KEY ('; $sql .= join ', ', map {$_->name} @pk; $sql .= ")"; $sql .= "\n"; } $sql .= ")"; if (my @att = $table->attributes) { $sql .= ' '; $sql .= join ' ', @att; } my @sql = ($sql); foreach my $i ( $table->indexes ) { push @sql, $self->index_sql($i); } return @sql; } sub column_sql { my $self = shift; my $col = shift; my $p = shift; # for skip_name # make sure each one only happens once my %attr = map { uc $_ => $_ } ( $col->attributes, ($col->nullable ? 'NULL' : 'NOT NULL'), ($col->sequenced ? 'AUTO_INCREMENT' : () ) ); # unsigned attribute has to come right after type declaration, # same with binary. No column could have both. my @unsigned = $attr{UNSIGNED} ? delete $attr{UNSIGNED} : (); my @binary = $attr{BINARY} ? delete $attr{BINARY} : (); my @default; if ( defined $col->default ) { my $def = $self->_default_for_column($col); @default = ( qq|DEFAULT $def| ); } my $type = $col->type; my @length; if ( defined $col->length ) { my $length = '(' . $col->length; $length .= ', ' . $col->precision if defined $col->precision; $length .= ')'; $type .= $length; } my @name = $p->{skip_name} ? () : $col->name; my $sql .= join ' ', ( @name, $type, @unsigned, @binary, @default, sort values %attr ); return $sql; } sub index_sql { my $self = shift; my $index = shift; return if $self->{state}{index_sql}{ $index->id }; my $index_name = $self->_make_index_name( $index->id ); my $sql = 'CREATE'; $sql .= ' UNIQUE' if $index->unique; $sql .= ' FULLTEXT' if $index->fulltext; $sql .= " INDEX $index_name ON " . $index->table->name . ' ( '; $sql .= join ', ', ( map { my $sql = $_->name; $sql .= '(' . $index->prefix($_) . ')' if $index->prefix($_); $sql; } $index->columns ); $sql .= ' )'; return $sql; } sub _default_for_column { my $self = shift; my $col = shift; return $col->default if $col->is_numeric || $col->default_is_raw; my $d = $col->default; $d =~ s/"/""/g; return qq|"$d"|; } sub _make_index_name { shift; return substr(shift, 0, 64); } sub foreign_key_sql { # Bah, no ON UPDATE SET DEFAULT return; my $self = shift; my $fk = shift; if ( grep { $_->is_primary_key } $fk->columns_from ) { return unless $fk->from_is_dependent; } my @indexes; foreach my $part ( qw( from to ) ) { my $found_index; my $col_meth = "columns_$part"; my @cols = $fk->$col_meth(); my $table_meth = "table_$part"; INDEX: foreach my $i ( $fk->$table_meth()->indexes ) { my @c = $i->columns; next unless @c == @cols; for ( 0..$#c ) { next INDEX unless $c[$_]->name eq $cols[$_]->name; } $found_index = 1; last; } unless ($found_index) { push @indexes, $fk->$table_meth()->make_index( columns => [ @cols ] ); } } my $sql = 'ALTER TABLE '; $sql .= $fk->table_from->name; $sql .= ' ADD FOREIGN KEY ( '; $sql .= join ', ', map { $_->name } $fk->columns_from; $sql .= ' ) REFERENCES `'; $sql .= $fk->table_to->name; $sql .= '`( '; $sql .= join ', ', map { $_->name } $fk->columns_to; $sql .= ' ) ON DELETE '; if ( $fk->from_is_dependent ) { $sql .= 'CASCADE'; } else { my @to = $fk->columns_to; unless ( ( grep { $_->nullable } @to ) == @to ) { $sql .= 'SET DEFAULT'; } else { $sql .= 'SET NULL'; } } $sql .= ' ON UPDATE CASCADE'; return ( map { $self->index_sql($_) } @indexes ), $sql; } sub drop_column_sql { my $self = shift; my %p = @_; return 'ALTER TABLE ' . $p{new_table}->name . ' DROP COLUMN ' . $p{old}->name; } sub drop_foreign_key_sql { return; } sub drop_index_sql { my $self = shift; my $index = shift; # table name may have changed. my $table_name = shift; return 'DROP INDEX ' . $self->_make_index_name( $index->id ) . " ON $table_name"; } sub column_sql_add { my $self = shift; my $col = shift; my $sequenced = 0; if ( ($sequenced = $col->sequenced) ) { $col->set_sequenced(0); } my $new_sql = $self->column_sql($col); if ($sequenced) { $col->set_sequenced(1); } return 'ALTER TABLE ' . $col->table->name . ' ADD COLUMN ' . $new_sql; } sub column_sql_diff { my $self = shift; my %p = @_; my $new = $p{new}; my $old = $p{old}; my $sequenced = 0; if ( ( $sequenced = $new->sequenced ) && ! $old->sequenced ) { $new->set_sequenced(0); } my $new_default = $new->default; $new->set_default(undef) if $self->_can_ignore_default( uc $new->type, $new_default ); my $new_sql = $self->column_sql( $new, { skip_name => 1 } ); $new->set_sequenced(1) if $sequenced; $new->set_default($new_default) if defined $new_default; my $old_default = $old->default; $old->set_default(undef) if $self->_can_ignore_default( uc $old->type, $new_default ); my $old_sql = $self->column_sql( $old, { skip_name => 1 } ); $old->set_default($old_default) if defined $old_default; my @sql; if ( $new_sql ne $old_sql || ( $new->sequenced && ! $old->sequenced ) ) { my $sql = ( 'ALTER TABLE ' . $new->table->name . ' CHANGE COLUMN ' . $new->name . ' ' . $new->name . ' ' . $new_sql ); # can't have more than 1 auto_increment column per table (dumb!) if ( ( $new->sequenced && ! $old->sequenced ) && ! grep { $_ ne $new && $_->sequenced } $new->table->columns ) { $sql .= ' AUTO_INCREMENT' if $new->sequenced && ! $old->sequenced; } push @sql, $sql; } return @sql; } sub alter_primary_key_sql { my $self = shift; my %p = @_; my $new = $p{new}; my $old = $p{old}; my @sql; push @sql, 'ALTER TABLE ' . $new->name . ' DROP PRIMARY KEY' if $old->primary_key; if ( $new->primary_key ) { my $sql = 'ALTER TABLE ' . $new->name . ' ADD PRIMARY KEY ( '; $sql .= join ', ', map {$_->name} $new->primary_key; $sql .= ')'; push @sql, $sql; } foreach ( $new->primary_key ) { if ( $_->sequenced && ! ( $old->has_column( $_->name ) && $old->column( $_->name )->is_primary_key ) ) { my $sql = $self->column_sql($_); push @sql, 'ALTER TABLE ' . $new->name . ' CHANGE COLUMN ' . $_->name . ' ' . $sql; } } return @sql; } sub alter_table_name_sql { my $self = shift; my $table = shift; return 'RENAME TABLE ' . $table->former_name . ' TO ' . $table->name; } sub alter_table_attributes_sql { my $self = shift; my %p = @_; # This doesn't work right if new table has no attributes return; return 'ALTER TABLE ' . $p{new}->name . ' ' . join ' ', $p{new}->attributes; } sub alter_column_name_sql { my $self = shift; my $column = shift; return ( 'ALTER TABLE ' . $column->table->name . ' CHANGE COLUMN ' . $column->former_name . ' ' . $self->column_sql($column) ); } sub reverse_engineer { my $self = shift; my $schema = shift; my $driver = $schema->driver; my $has_table_types = $driver->one_row( sql => 'SHOW VARIABLES LIKE ?', bind => 'table_type' ); foreach my $table ( $driver->tables ) { my $table_name = $self->_clean_table_name($table); my $t = $schema->make_table( name => $table_name ); foreach my $row ( $driver->rows( sql => "DESCRIBE $table" ) ) { my ($type, @a); if ( $row->[1] =~ /\A(?:ENUM|SET)/i ) { $type = $row->[1]; } else { ($type, @a) = split /\s+/, $row->[1]; } my $default = $row->[4] if defined $row->[4] && uc $row->[4] ne 'NULL'; my $seq = 0; foreach my $a ( split /\s+/, $row->[5] ) { if ( uc $a eq 'AUTO_INCREMENT' ) { $seq = 1; } else { push @a, $a; } } my %p; if ( $type !~ /ENUM|SET/i && $type =~ /(\w+)\((\d+)(?:\s*,\s*(\d+))?\)$/ ) { $type = uc $1; $type = 'INTEGER' if $type eq 'INT'; # skip defaults unless ( $type eq 'TINYINT' && ( $2 == 4 || $2 == 3 ) || $type eq 'SMALLINT' && ( $2 == 6 || $2 == 5 ) || $type eq 'MEDIUMINT' && ( $2 == 9 || $2 == 8 ) || $type eq 'INTEGER' && ( $2 == 11 || $2 == 10 ) || $type eq 'BIGINT' && ( $2 == 21 || $2 == 20 ) || $type eq 'YEAR' && $2 == 4 || $type eq 'TIMESTAMP' && $2 == 14 ) { $p{length} = $2; $p{precision} = $3; } } $type = $self->_capitalize_type($type); $default = undef if $self->_can_ignore_default( $type, $default ); my $c = $t->make_column( name => $row->[0], type => $type, nullable => $row->[2] eq 'YES', sequenced => $seq, default => $default, attributes => \@a, primary_key => $row->[3] eq 'PRI', %p, ); } my %i; foreach my $row ( $driver->rows( sql => "SHOW INDEX FROM $table" ) ) { next if $row->[2] eq 'PRIMARY'; my $type_i = $driver->major_version >= 4 ? 10 : 9; $i{ $row->[2] }{fulltext} = $row->[$type_i] && $row->[$type_i] =~ /fulltext/i ? 1 : 0; $i{ $row->[2] }{cols}[ $row->[3] - 1 ]{column} = $t->column( $row->[4] ); if ( defined $row->[7] ) { # MySQL (at least 4.0.17) reports a sub_part of 1 for # the second column of a fulltext index. if ( ! $i{ $row->[2] }{fulltext} || $row->[7] > 1 ) { $i{ $row->[2] }{cols}[ $row->[3] - 1 ]{prefix} = $row->[7] } } $i{ $row->[2] }{unique} = $row->[1] ? 0 : 1; } foreach my $index (keys %i) { $t->make_index( columns => $i{$index}{cols}, unique => $i{$index}{unique}, fulltext => $i{$index}{fulltext} ); } if ( $has_table_types ) { my $table_type = ( $driver->one_row( sql => 'SHOW TABLE STATUS LIKE ?', bind => $table_name ) )[1]; $t->add_attribute( 'TYPE=' . uc $table_type ); } } } my %ignored_defaults = ( DATETIME => '0000-00-00 00:00:00', DATE => '0000-00-00', YEAR => '0000', CHAR => '', VARCHAR => '', TINTYTEXT => '', SMALLTEXT => '', MEDIUMTEXT => '', TEXT => '', LONGTEXT => '', ); sub _can_ignore_default { my $self = shift; my $type = shift; my $default = shift; return 1 unless defined $default; return 1 if exists $ignored_defaults{$type} && $default eq $ignored_defaults{$type}; if ( $type eq 'DECIMAL' ) { return 1 if $default =~ /0\.0+/; } if ( $type =~ /INT/ ) { return 1 unless $default; } return 0; } sub rules_id { return 'MySQL'; } 1; __END__ =head1 NAME Alzabo::RDBMSRules::MySQL - MySQL specific database rules. =head1 SYNOPSIS use Alzabo::RDBMSRules::MySQL; =head1 DESCRIPTION This module implements all the methods descibed in Alzabo::RDBMSRules for the MySQL database. The syntax rules follow the more restrictive rules of version 3.22. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/RDBMSRules/PostgreSQL.pm0000444000175000017500000011147310721343227020723 0ustar autarchautarchpackage Alzabo::RDBMSRules::PostgreSQL; use strict; use vars qw($VERSION); use Alzabo::Exceptions ( abbr => [ 'recreate_table_exception' ] ); use Alzabo::RDBMSRules; use Digest::MD5; use Text::Balanced (); use base qw(Alzabo::RDBMSRules); use Params::Validate qw( validate_pos ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; return bless {}, $class; } sub validate_schema_name { my $self = shift; my $name = shift->name; $self->_check_name($name, 'schema'); Alzabo::Exception::RDBMSRules->throw( error => "Schema name ($name) contains a single quote char (')" ) if index($name, "'") != -1; } sub validate_table_name { my $self = shift; $self->_check_name( shift->name, 'table' ); } sub validate_column_name { my $self = shift; $self->_check_name( shift->name, 'column' ); } sub _check_name { my $self = shift; my $name = shift; Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) must be at least one character long" ) unless length $name; Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) is too long. Names must be 31 characters or less." ) if length $name > 31; Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) must start with an alpha or underscore(_) and must contain only alphanumerics and underscores." ) unless $name =~ /\A[a-zA-Z]\w*\z/; } sub validate_column_type { my $self = shift; my $type = uc shift; my $table = shift; if ( $table->primary_key_size > 1 ) { return 'INT4' if $type =~ /^SERIAL4?$/; return 'INT8' if $type eq 'BIGSERIAL' or $type eq 'SERIAL8'; } my %simple_types = map { $_ => 1 } qw( ABSTIME BIT BIGINT BIGSERIAL BOOL BOOLEAN BOX BYTEA CHAR CHARACTER CIDR CIRCLE DATE DECIMAL FLOAT FLOAT4 FLOAT8 INET SMALLINT INT INTEGER INT2 INT4 INT8 INTERVAL MACADDR MONEY NUMERIC OID RELTIME SERIAL SERIAL4 SERIAL8 TEXT TIME TIMESTAMP TIMESTAMPTZ TIMETZ VARBIT VARCHAR ); return 'INTEGER' if $type eq 'INT' || $type eq 'INT4'; return 'SERIAL' if $type eq 'SERIAL4'; return 'INT8' if $type eq 'BIGINT'; return $type if $simple_types{$type}; return $type if $type =~ /BIT\s+VARYING/; return $type if $type =~ /CHARACTER\s+VARYING/; return $type if $type =~ /\ABOX|CIRCLE|LINE|LSEG|PATH|POINT|POLYGON/; Alzabo::Exception::RDBMSRules->throw( error => "Invalid column type: $type" ); } sub validate_column_length { my $self = shift; my $column = shift; if ( defined $column->length ) { Alzabo::Exception::RDBMSRules->throw( error => "Length is not supported except for char, varchar, decimal, float, and numeric columns (" . $column->name . " column)" ) unless $column->type =~ /\A(?:(?:VAR)?CHAR|CHARACTER|DECIMAL|FLOAT|NUMERIC|(?:VAR)?BIT|BIT VARYING)\z/i; } if ( defined $column->precision ) { Alzabo::Exception::RDBMSRules->throw( error => "Precision is not supported except for decimal, float, and numeric columns" ) unless $column->type =~ /\A(?:DECIMAL|FLOAT|NUMERIC)\z/i; } } # placeholder in case we decide to try to do something better later sub validate_table_attribute { 1 } sub validate_column_attribute { my $self = shift; my %p = @_; my $column = $p{column}; my $type = $column->type; my $a = uc $p{attribute}; $a =~ s/\A\s//; $a =~ s/\s\z//; return if $a =~ /\A(?:UNIQUE\z|CHECK|CONSTRAINT|REFERENCES)/i; Alzabo::Exception::RDBMSRules->throw( error => "Only column constraints are supported as column attributes" ) } sub validate_primary_key { my $self = shift; my $col = shift; my $serial_col = (grep { $_->type =~ /^(?:SERIAL(?:4|8)?|BIGSERIAL)$/ } $col->table->primary_key)[0]; if ( defined $serial_col && $serial_col->name ne $col->name ) { $serial_col->set_type( $serial_col->type =~ /^SERIAL4?$/ ? 'INT4' : 'INT8' ); } } sub validate_sequenced_attribute { my $self = shift; my $col = shift; Alzabo::Exception::RDBMSRules->throw( error => 'Non-number columns cannot be sequenced' ) unless $col->is_integer || $col->is_floating_point; } sub validate_index { my $self = shift; my $index = shift; foreach my $c ( $index->columns ) { Alzabo::Exception::RDBMSRules->throw( error => "PostgreSQL does not support index prefixes" ) if defined $index->prefix($c) } Alzabo::Exception::RDBMSRules->throw( error => "PostgreSQL does not support fulltext indexes" ) if $index->fulltext; } sub type_is_integer { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /\A(?: INT(?:2|4|8)?| SMALLINT| INTEGER| OID| SERIAL(?:4|8)?| BIGSERIAL ) \z /x; } sub type_is_floating_point { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /\A(?: DECIMAL| FLOAT(?:4|8)?| MONEY| NUMERIC ) \z /x; } sub type_is_char { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /(?:CHAR|CHARACTER|TEXT)\z/; } sub type_is_date { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type eq 'DATE' || $self->type_is_datetime($col); } sub type_is_datetime { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /^TIMESTAMP/; } sub type_is_time { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type eq 'TIME'; } sub type_is_time_interval { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type eq 'INTERVAL'; } sub type_is_blob { my $self = shift; my $col = shift; my $type = uc $col->type; return 1 if $type =~ /\ABYTEA\z/; } sub blob_type { return 'BYTEA' } sub column_types { return ( qw( INTEGER INT2 INT8 NUMERIC FLOAT FLOAT4 CHAR VARCHAR TEXT BYTEA DATE TIME TIMESTAMP INTERVAL SERIAL BIGSERIAL BOOLEAN BIT ), 'BIT VARYING', qw( INET CIDR MACADDR ) ); } my %features = map { $_ => 1 } qw ( extended_column_types constraints functional_indexes allows_raw_default ); sub feature { shift; return $features{+shift}; } sub quote_identifiers { 1 } sub quote_identifiers_character { '"' } sub schema_sql { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Schema' } ); my $schema = shift; my @sql = $self->SUPER::schema_sql($schema); # This has to come at the end because we don't know which tables # reference other tables. foreach my $t ( $schema->tables ) { foreach my $con ( grep { /\s*(?:check|constraint)/i } $t->attributes ) { push @sql, $self->table_constraint_sql($t); } foreach my $fk ( $t->all_foreign_keys ) { push @sql, $self->foreign_key_sql($fk); } } return @sql; } sub table_sql { my $self = shift; my $table = shift; my $create_sequence = shift; # Create table sequence by default $create_sequence = 1 unless defined $create_sequence; my $sql = qq|CREATE TABLE "| . $table->name . qq|" (\n |; $sql .= join ",\n ", map { $self->column_sql($_) } $table->columns; my @att = $table->attributes; if (my @pk = $table->primary_key) { $sql .= ",\n"; $sql .= ' PRIMARY KEY ('; $sql .= join ', ', map { '"' . $_->name . '"' } @pk; $sql .= ")\n"; } $sql .= ")\n"; my @sql = ($sql); foreach my $i ( $table->indexes ) { push @sql, $self->index_sql($i); } if ($create_sequence) { foreach my $c ( grep { $_->sequenced } $table->columns ) { push @sql, $self->_sequence_sql($c); } } if (@att) { $sql .= ' '; $sql .= join ' ', grep { ! /\s*(?:check|constraint)/i } @att; } $self->{state}{table_sql}{ $table->name } = 1; return @sql; } sub _sequence_sql { my $self = shift; my $col = shift; return if $col->type =~ /^(?:SERIAL(?:4|8)?|BIGSERIAL)$/; my $seq_name = $self->_sequence_name($col); return qq|CREATE SEQUENCE "$seq_name";\n|; } sub _sequence_name { my $self = shift; my $col = shift; return join '___', $col->table->name, $col->name; } sub column_sql { my $self = shift; my $col = shift; my $p = shift; # hashref for skip_nullable, skip_default, && skip_name my @default; if ( ! $p->{skip_default} && defined $col->default ) { my $def = $self->_default_for_column($col); @default = ( "DEFAULT $def" ); } my $type = $col->type; my @length; if ( defined $col->length ) { my $length = '(' . $col->length; $length .= ', ' . $col->precision if defined $col->precision; $length .= ')'; $type .= $length; } my @nullable; unless ( $p->{skip_nullable} ) { @nullable = $col->nullable ? 'NULL' : 'NOT NULL'; } my @name = $p->{skip_name} ? () : '"' . $col->name . '"'; my $sql .= join ' ', ( @name, $type, @default, @nullable, $col->attributes ); return $sql; } sub _default_for_column { my $self = shift; my $col = shift; return unless defined $col->default; return $col->default if $col->is_numeric || $col->default_is_raw; my $d = $col->default; $d =~ s/'/''/g; qq|'$d'|; } sub foreign_key_sql { my $self = shift; my $fk = shift; if ( grep { $_->is_primary_key } $fk->columns_from ) { return unless $fk->from_is_dependent; } return () if $self->{state}{fk_sql}{ $fk->id }; my $sql = 'ALTER TABLE "'; $sql .= $fk->table_from->name; $sql .= '" ADD CONSTRAINT '; $sql .= $self->_fk_name($fk); $sql .= ' FOREIGN KEY ( '; $sql .= join ', ', map { '"' . $_->name . '"' } $fk->columns_from; $sql .= ' ) REFERENCES "'; $sql .= $fk->table_to->name; $sql .= '" ('; $sql .= join ', ', map { '"' . $_->name . '"' } $fk->columns_to; $sql .= ')'; $sql .= ' ON DELETE '; if ( $fk->from_is_dependent ) { $sql .= 'CASCADE'; } else { my @from = $fk->columns_from; unless ( ( grep { $_->nullable } @from ) == @from ) { $sql .= 'SET DEFAULT'; } else { $sql .= 'SET NULL'; } } $self->{state}{fk_sql}{ $fk->id } = 1; return $sql; } sub _fk_name { my $id = $_[1]->id; return ( length $id > 63 ? 'fk_' . Digest::MD5::md5_hex( $_[1]->id ) : $id ); } sub table_constraint_sql { my $self = shift; my $table = shift; return map { 'ALTER TABLE "' . $table->name . '" ADD ' . $_ } $table->attributes; } sub drop_table_sql { my $self = shift; my $table = shift; my $is_recreate = shift; my @sql; if ($is_recreate) { # We need to drop foreign keys referring to this table before # we drop it. foreach my $fk ( $table->all_foreign_keys ) { push @sql, $self->drop_foreign_key_sql( $fk->reverse ); } } push @sql, $self->SUPER::drop_table_sql($table); unless ($is_recreate) { foreach my $c ( $table->columns ) { push @sql, $self->_drop_sequence_sql($c) if $c->sequenced; } } return @sql; } sub _drop_sequence_sql { my $self = shift; my $col = shift; return if $col->type =~ /^(?:SERIAL(?:4|8)?|BIGSERIAL)$/; my $seq_name = $self->_sequence_name($col); return qq|DROP SEQUENCE "$seq_name";\n|; } sub drop_column_sql { my $self = shift; my %p = @_; recreate_table_exception(); } sub recreate_table_sql { my $self = shift; my %p = @_; # This is a hack to prevent this SQL from being made multiple # times (which would be pointless) return () if $self->{state}{table_sql}{ $p{new}->name }; push @{ $self->{state}{deferred_sql} }, $self->_restore_foreign_key_sql( $p{new} ); return ( $self->_temp_table_sql( $p{new}, $p{old} ), $self->drop_table_sql( $p{old}, 1 ), # the 0 param indicates that we should not create sequences $self->table_sql( $p{new}, 0 ), $self->_restore_table_data_sql( $p{new}, $p{old} ), $self->_drop_temp_table( $p{new} ), ); } sub _temp_table_sql { my $self = shift; my $new_table = shift; my $old_table = shift; my $temp_name = "TEMP" . $new_table->name; my $sql = "SELECT "; $sql .= join ', ', map { '"' . $_->name . '"' } $old_table->columns; $sql .= qq|\n INTO TEMPORARY "$temp_name" FROM "| . $old_table->name . '"'; return $sql; } sub _restore_table_data_sql { my $self = shift; my $new_table = shift; my $old_table = shift; my @cols; foreach my $column ( $new_table->columns ) { my $old_name = defined $column->former_name ? $column->former_name : $column->name; push @cols, [ $column->name, $old_name ] if $old_table->has_column($old_name); } my $temp_name = "TEMP" . $new_table->name; my $sql = 'INSERT INTO "' . $new_table->name . '" ('; $sql .= join ', ', map { qq|"$_->[0]"| } @cols; $sql .= " ) \n SELECT "; $sql .= join ', ', map { qq|"$_->[1]"| } @cols; $sql .= qq| FROM "$temp_name"|; return $sql; } sub _drop_temp_table { my $self = shift; my $table = shift; my $temp_name = "TEMP" . $table->name; return qq|DROP TABLE "$temp_name"|; } sub _restore_foreign_key_sql { my $self = shift; my $table = shift; my @sql; foreach my $fk ( $table->all_foreign_keys ) { push @sql, $self->foreign_key_sql($fk); push @sql, $self->foreign_key_sql( $fk->reverse ); } return @sql; } sub rename_sequences { my $self = shift; my %p = @_; return () if $self->{state}{rename_sequence_sql}{ $p{new}->name }; my @sql; for my $old_col ( grep { $_->sequenced } $p{old}->columns ) { my $new_col = $p{new}->column( $old_col->name ) or next; my $old_seq = $self->_sequence_name($old_col); my $new_seq = $self->_sequence_name($new_col); push @sql, qq|ALTER TABLE "$old_seq" RENAME TO "$new_seq";\n|; } $self->{state}{rename_sequence_sql}{ $p{new}->name } = 1; return @sql; } sub drop_foreign_key_sql { my $self = shift; my $fk = shift; if ( grep { $_->is_primary_key } $fk->columns_from ) { return unless $fk->from_is_dependent; } return () if $self->{state}{drop_fk_sql}{ $fk->id }; $self->{state}{drop_fk_sql}{ $fk->id } = 1; return 'ALTER TABLE "' . $fk->table_from->name . '" DROP CONSTRAINT ' . $self->_fk_name($fk); } sub drop_index_sql { my $self = shift; my $index = shift; return 'DROP INDEX "' . $index->id . '"'; } sub column_sql_add { my $self = shift; my $col = shift; return () if $self->{state}{table_sql}{ $col->table->name }; # Skip default and not null while adding column my @sql = 'ALTER TABLE "' . $col->table->name . '" ADD COLUMN ' . $self->column_sql($col, { skip_default => 1, skip_nullable => 1 }); my $def = $self->_default_for_column($col); if ($def) { push @sql, ( 'ALTER TABLE "' . $col->table->name . '" ALTER COLUMN "' . $col->name . qq|" SET DEFAULT $def| ); } if ( ! $col->nullable ) { push @sql, ( 'UPDATE "' . $col->table->name . '" SET "' . $col->name . qq|" = $def WHERE "| . $col->name . '" IS NULL' ); push @sql, ( 'ALTER TABLE "' . $col->table->name . '" ADD CONSTRAINT "' . $col->table->name . '_' . $col->name . '_not_null" CHECK ( "' . $col->name . '" IS NOT NULL )' ); } return @sql; } sub column_sql_diff { my $self = shift; my %p = @_; return $self->drop_column_sql( new_table => $p{new}->table, old => $p{old} ) unless $self->_columns_are_equivalent( $p{new}, $p{old} ); return; } sub _columns_are_equivalent { my $self = shift; my $new = shift; my $old = shift; return 0 unless $self->_types_are_equivalent( $new, $old ); return 0 unless $self->_defaults_are_equivalent( $new, $old ); return 0 unless $new->sequenced == $old->sequenced; my $new_att = join "\0", sort $new->attributes; $new_att ||= ''; my $old_att = join "\0", sort $old->attributes; $old_att ||= ''; return 0 unless $new_att eq $old_att; return 1; } { my %CanonicalTypes = ( BOOL => 'BOOLEAN', INT => 'INTEGER', INT4 => 'INTEGER', INT2 => 'SMALLINT', INT8 => 'BIGINT', VARBIT => 'BIT VARYING', VARCHAR => 'CHARACTER VARYING', CHAR => 'CHARACTER', FLOAT => 'DOUBLE PRECISION', FLOAT8 => 'DOUBLE PRECISION', FLOAT4 => 'REAL', DECIMAL => 'NUMERIC', ); sub _types_are_equivalent { shift; my $col1 = shift; my $col2 = shift; my $type1 = $col1->type; $type1 = $CanonicalTypes{ uc $type1 } if $CanonicalTypes{ uc $type1 }; my $type2 = $col2->type; $type2 = $CanonicalTypes{ uc $type2 } if $CanonicalTypes{ uc $type2 }; $type1 .= join '-', grep { defined && length } $col1->length, $col1->precision; $type2 .= join '-', grep { defined && length } $col1->length, $col1->precision; return 1 if $type1 eq $type2; } } sub _defaults_are_equivalent { my $self = shift; my $col1 = shift; my $col2 = shift; return 1 if ! defined $col1->default && ! defined $col2->default; return 0 if defined $col1->default && ! defined $col2->default; return 0 if ! defined $col1->default && defined $col2->default; if ( $col1->type =~ /^bool/i ) { return 1 if lc substr( $col1->default, 0, 1 ) eq lc substr( $col2->default, 0, 1 ); return 0; } elsif ( $col1->is_date && $col1->default_is_raw && $col2->default_is_raw ) { my $d1 = $col1->default; my $d2 = $col2->default; my $re = qr/^(?:current_timestamp|localtime|localtimestamp|now\(\))$/i; return 1 if $col1->default =~ /$re/ && $col2->default =~ /$re/; } return 1 if $self->_default_for_column($col1) eq $self->_default_for_column($col2); } sub alter_primary_key_sql { my $self = shift; my %p = @_; my @sql; push @sql, 'DROP INDEX "' . $p{old}->name . '_pkey"'; if ( $p{new}->primary_key ) { push @sql, ( 'CREATE UNIQUE INDEX "' . $p{new}->name . '_pkey" ON "' . $p{new}->name . '" (' . ( join ', ', map { '"' . $_->name . '"' } $p{new}->primary_key ) . ')' ); } return @sql; } # Actually, Postgres _can_ change table names, but it's inability to # change most aspects of a column definition make it very difficult to # properly change a table name and then change its column definitions, # so its easier just to recreate the table sub can_alter_table_name { 0; } # Not sure if this is possible sub alter_table_attributes_sql { my $self = shift; recreate_table_exception(); } sub alter_column_name_sql { my $self = shift; my $column = shift; return ( 'ALTER TABLE "' . $column->table->name . '" RENAME COLUMN ' . $column->former_name . ' TO ' . $column->name ); } sub reverse_engineer { my $self = shift; my $schema = shift; my $driver = $schema->driver; foreach my $table ( $driver->tables ) { $table =~ s/^[^\.]+\.//; $table =~ s/^\"|\"$//g; print STDERR "Adding table $table to schema\n" if Alzabo::Debug::REVERSE_ENGINEER; my $t = $schema->make_table( name => $table ); my $t_oid = $driver->one_row( sql => 'SELECT oid FROM pg_class WHERE relname = ?', bind => $table ); my $sql = <<'EOF'; SELECT a.attname, a.attnotnull, t.typname, a.attnum, a.atthasdef, a.atttypmod FROM pg_attribute a, pg_type t WHERE a.attrelid = ? AND a.atttypid = t.oid AND a.attnum > 0 EOF $sql .= ' AND NOT a.attisdropped' if $driver->rdbms_version ge '7.3'; $sql .= ' ORDER BY attnum'; my %cols_by_number; foreach my $row ( $driver->rows( sql => $sql, bind => $t_oid ) ) { my %p; $p{type} = $row->[2]; # has default if ( $row->[4] ) { $p{default} = $driver->one_row ( sql => 'SELECT adsrc FROM pg_attrdef WHERE adrelid = ? AND adnum = ?', bind => [ $t_oid, $row->[3] ] ); if ( $p{default} =~ /^nextval\(/ ) { $p{sequenced} = 1; $p{type} =~ s/(?:int(?:eger)?|numeric)/serial/; } else { # strip quotes (and type!) Postgres added $p{default} =~ s/^'//; #' if ( $driver->rdbms_version ge '7.4' ) { # 'grotesque' becomes 'grotesque'::character # varying. See # src/backend/utils/adt/format_type.c # This is from # src/backend/util/adt/format_type.c $p{default} =~ s/'(?:::[^']{3,})?$//; $p{default} =~ s/\('(\w+)$/$1/; } else { $p{'default'} =~ s/'$//; } if ( $p{default} =~ /\([^\)]*\)/ || $p{default} =~ /^(?:current_timestamp|localtime|localtimestamp|now)$/i ) { $p{default_is_raw} = 1; } $p{default} = 'now()' if $p{default} eq 'now'; } } if ( $p{type} =~ /char/i ) { # The real length is the value of: a.atttypmod - ((int32) sizeof(int32)) # # Sure wish I knew how to figure this out in Perl. # Its provided as VARHDRSZ in postgres.h but I can't # really get at it. On my linux machine this is 4. A # better way of doing this would be welcome. $p{length} = $row->[5] - 4; } if ( lc $p{type} eq 'numeric' ) { # see comment above. my $num = $row->[5] - 4; $p{length} = ($num >> 16) & 0xffff; $p{precision} = $num & 0xffff; } $p{type} = 'char' if lc $p{type} eq 'bpchar'; print STDERR "Adding $row->[0] column to $table\n" if Alzabo::Debug::REVERSE_ENGINEER; my $col = $t->make_column( name => $row->[0], nullable => ! $row->[1], %p ); if ( $col->is_integer ) { if ( $self->_re_sequence_exists( $driver, $col ) ) { $col->set_sequenced(1); } } $cols_by_number{ $row->[3] } = $row->[0]; } $sql = <<'EOF'; SELECT indkey FROM pg_index WHERE indisprimary AND indrelid = ? EOF foreach my $cols ( $driver->column( sql => $sql, bind => $t_oid ) ) { my @cols = @cols_by_number{ split ' ', $cols }; local $" = ", "; print STDERR "Setting @cols as primary key for $table\n" if Alzabo::Debug::REVERSE_ENGINEER; $t->add_primary_key( $_ ) for $t->columns( @cols ); } my %i; if ( $driver->rdbms_version ge '7.4' ) { %i = $self->_74_indexes( $driver, $t, $t_oid, \%cols_by_number ); } else { %i = $self->_pre_74_indexes( $driver, $t, $t_oid, \%cols_by_number ); } foreach my $idx (values %i) { my @c = map { { column => $_ } } @{ $idx->{cols} }; print STDERR "Adding index " . ( defined $idx->{'function'} ? $idx->{'function'} : join(', ', map $_->name, @{$idx->{'cols'}} ) ) . " to $table\n" if Alzabo::Debug::REVERSE_ENGINEER; $t->make_index( columns => \@c, unique => $idx->{unique}, function => $idx->{function}, ); } $sql = <<'EOF'; SELECT consrc, array_to_string(conkey,' ') FROM pg_constraint WHERE conrelid = ? AND contype = 'c' EOF my @att; foreach my $row ( $driver->rows( sql => $sql, bind => $t_oid ) ) { my ( $con, $cols ) = @$row; # this stuff is not needed $con =~ s/::(\w+)//g; # If $cols ever covers more than one value then this will fail. if ( $cols =~ /^(\d+)$/ ) { my $column = $cols_by_number{$1}; print STDERR qq|Adding constraint "$con" to $table.$column\n| if Alzabo::Debug::REVERSE_ENGINEER; $t->column($column)->add_attribute("CHECK $con"); } else { print STDERR qq|Adding constraint "$con" to $table\n| if Alzabo::Debug::REVERSE_ENGINEER; $t->add_attribute("CHECK $con"); } } } # Foreign key info is available in PG 7.3.0 and higher (could fake # it from pg_triggers with extensive gymnastics in version 7.0 and # higher, but that's a little iffy) $self->_foreign_keys_to_relationships($schema) if $driver->rdbms_version ge '7.3'; } sub _re_sequence_exists { my $self = shift; my $driver = shift; my $col = shift; my $seq_name = $self->_sequence_name($col); my $sql = <<'EOF'; SELECT 1 FROM pg_class WHERE relname = ? AND relkind = ? EOF return $driver->one_row( sql => $sql, bind => [ $seq_name, 'S' ], ); } sub _74_indexes { my $self = shift; my $driver = shift; my $table = shift; my $t_oid = shift; my $cols_by_number = shift; my $sql = <<'EOF'; SELECT indexrelid, indisunique, indkey, indnatts FROM pg_index WHERE indrelid = ? AND NOT indisprimary EOF my %i; INDEX: foreach my $row ( $driver->rows( sql => $sql, bind => $t_oid ) ) { my $function; my @col_numbers; my $spi = $driver->one_row ( sql => "SELECT COALESCE(indexprs,'') FROM pg_index WHERE indexrelid = ?", bind => $row->[0] ); if ( $spi ) { SPI_EXPRESSION: while ( my $spi_expr = Text::Balanced::extract_bracketed( $spi, '{}', '[^{}]*' ) ) { # A wanton lack of respect for boundaries. 'Parse' the # PostgreSQL internal SPI language to find out what # columns are being accessed. push( @col_numbers, join( ' ', $spi_expr =~ /:varattno (\d+)/g ) ); } } if ( scalar( @col_numbers ) > 1 ) { # Index objects are not prepared to handle functional # indexes that use more than one function. die "Alzabo " . Alzabo->VERSION . " does not support functional" . " indexes that are not strictly a single function." . " There are multiple functions on an index on the " . $table->name() . " table.\n"; } elsif ( scalar( @col_numbers ) == 1 ) { my $func = $driver->one_row ( sql => 'SELECT pg_catalog.pg_get_indexdef( ?, 1, true)', bind => $row->[0] ); # XXX - not sure if this is a good idea but it makes the # rev-eng tests pass $func =~ s/\b(\w+)::\w+\b/$1/g; my $col_in_func = $1; my @function; for my $num ( split / +/, $row->[2] ) { if ( $num == 0 ) { push @function, $func; } else { push @function, $cols_by_number->{$num}; push @col_numbers, $num; } } $function = join ', ', @function; } else { # A regular index! @col_numbers = split / +/, $row->[2]; } push( @{ $i{ $row->[0] }{cols} }, $table->columns( @{ $cols_by_number }{ @col_numbers } ) ); $i{ $row->[0] }{function} = $function; $i{ $row->[0] }{unique} = $row->[1]; } return %i; } sub _pre_74_indexes { my $self = shift; my $driver = shift; my $table = shift; my $t_oid = shift; my $cols_by_number = shift; my $sql = <<'EOF'; SELECT c.oid, a.attname, i.indisunique, i.indproc, i.indkey FROM pg_index i, pg_attribute a, pg_class c WHERE i.indrelid = ? AND NOT i.indisprimary AND i.indexrelid = c.oid AND c.oid = a.attrelid AND a.attnum > 0 ORDER BY a.attnum EOF my %i; foreach my $row ( $driver->rows( sql => $sql, bind => $t_oid ) ) { my @col_names = @{ $cols_by_number }{ split ' ', $row->[4] }; my $function; if ( $row->[3] && $row->[3] =~ /\w/ && $row->[3] ne '-' ) { # some function names come out as "pg_catalog.foo" $row->[3] =~ s/\w+\.(\w+)/$1/; $function = uc $row->[3]; $function .= '('; $function .= join ', ', @col_names; $function .= ')'; } push( @{ $i{ $row->[0] }{cols} }, $table->columns( @col_names ) ); $i{ $row->[0] }{unique} = $row->[2]; $i{ $row->[0] }{function} = $function; } return %i; } sub _foreign_keys_to_relationships { my ($self, $schema) = @_; my $driver = $schema->driver; my $constraint_sql = <<'EOF'; SELECT conrelid, confrelid, array_to_string(conkey,' '), array_to_string(confkey,' ') FROM pg_constraint WHERE contype = 'f' EOF my $table_sql = <<'EOF'; SELECT relname FROM pg_class WHERE oid = ? EOF my $column_sql = <<'EOF'; SELECT attname FROM pg_attribute WHERE attrelid = ? AND attnum = ? EOF foreach my $row ( $driver->rows( sql => $constraint_sql ) ) { my $from_table = $driver->one_row( sql => $table_sql, bind => $row->[0] ); my $to_table = $driver->one_row( sql => $table_sql, bind => $row->[1] ); # Column numbers are given as strings like "3 5" my @from_cols = split ' ', $row->[2] or die "Weird column specification $row->[2]"; my @to_cols = split ' ', $row->[3] or die "Weird column specification $row->[3]"; # Convert column numbers to names foreach (@from_cols) { $_ = $driver->one_row( sql => $column_sql, bind => [$row->[0], $_] ); } foreach (@to_cols) { $_ = $driver->one_row( sql => $column_sql, bind => [$row->[1], $_] ); } print STDERR "Adding $from_table foreign key to $to_table\n" if Alzabo::Debug::REVERSE_ENGINEER; # Convert to Alzabo objects $from_table = $schema->table($from_table); $to_table = $schema->table($to_table); @from_cols = map { $from_table->column($_) } @from_cols; @to_cols = map { $to_table->column($_) } @to_cols; # If there's a unique constraint on the "from" columns, treat # is as 1-to-1. Otherwise treat it as n-to-1. my $from_unique = 0; # Only use PK as determination of uniqueness if the FK is from # the _whole_ PK to something else. If the FK only includes # _part_ of the PK then it is not unique. $from_unique = 1 if ( ( @from_cols == grep { $_->is_primary_key } @from_cols ) && ( @from_cols == $from_table->primary_key_size ) ); $from_unique = 1 if @from_cols == grep { $_->has_attribute( attribute => 'UNIQUE' ) } @from_cols; INDEX: foreach my $i ( grep { $_->unique } $from_table->indexes ) { my @i_cols = $i->columns; next unless @i_cols == @from_cols; for ( my $x = 0; $x < @i_cols; $x++ ) { next INDEX unless $i_cols[$x] eq $from_cols[$x]; } $from_unique = 1; } my $from_cardinality = $from_unique ? '1' : 'n'; my $from_is_dependent = ( grep { $_->nullable || defined $_->default } @from_cols ) ? 0 : 1; my $to_is_dependent = ( grep { $_->nullable || $_->is_primary_key } @to_cols ) ? 0 : 1; $schema->add_relationship( cardinality => [ $from_cardinality, '1' ], table_from => $from_table, table_to => $to_table, columns_from => \@from_cols, columns_to => \@to_cols, from_is_dependent => $from_is_dependent, to_is_dependent => $to_is_dependent, ); } } sub rules_id { return 'PostgreSQL'; } __END__ =head1 NAME Alzabo::RDBMSRules::PostgreSQL - PostgreSQL specific database rules =head1 SYNOPSIS use Alzabo::RDBMSRules::PostgreSQL; =head1 DESCRIPTION This module implements all the methods descibed in Alzabo::RDBMSRules for the PostgreSQL database. The syntax rules follow those of the 7.0 releases. Older versions may work but are not supported. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/ColumnDefinition.pm0000444000175000017500000000263310721343227020301 0ustar autarchautarchpackage Alzabo::ColumnDefinition; use strict; use vars qw($VERSION); use Alzabo; $VERSION = 2.0; 1; sub type { my $self = shift; return $self->{type}; } sub length { my $self = shift; return $self->{length}; } sub precision { my $self = shift; return $self->{precision}; } sub owner { my $self = shift; return $self->{owner}; } __END__ =head1 NAME Alzabo::ColumnDefinition - Holds the type attribute for a column =head1 SYNOPSIS my $def = $column->definition; print $def->type; =head1 DESCRIPTION This object holds information on a column that might need to be shared with another column. The reason for this is that if a column is a key in two or more tables, then some of the information related to that column should change automatically for all tables (and all columns) whenever it is changed anywhere. Right now this is only type ('VARCHAR', 'NUMBER', etc) information. This object also has an 'owner', which is the column which created it. =head1 METHODS =head2 type Returns the object's type as a string. =head2 length Returns the length attribute of the column, or undef if there is none. =head2 precision Returns the precision attribute of the column, or undef if there is none. =head2 owner Returns the L|Alzabo::Column> object that owns this definitions (the column that created it). =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/FAQ.pod0000444000175000017500000000613110721343227015605 0ustar autarchautarch=head1 NAME Alzabo::FAQ - Frequently Asked Questions =head2 How can I generate the SQL to turn one schema into another? Assuming you have schema objects representing these already created (through reverse engineering for example) B both schemas are for the same RDBMS, you can simply do this: my @sql = $schema1->rules->schema_diff( old => $schema1, new => $schema2 ); The C<@sql> array will contain all the SQL statements necessary to transform the schema in C<$schema1> into the schema in C<$schema2>. If you want to sync a schema object to the current state of the RDBMS backend's schema, check out the Lsync_backend >>|Alzabo::Create::Schema/sync_backend> method. =head2 How can I make a local copy of the documentation as HTML? Alzabo comes with a script called C. It takes three arguments. The first is the source file directory root. The second is the target directory. The last is the absolute URL path that this target directory represents. If you have perl 5.6.0 or greated installed, it is recommended that you use it to run this script as the Pod::Html module included with more recent Perls does a much better job of making HTML. If you were in the root of the source directory you might run this as: perl ./make_html_docs.pl ./lib /usr/local/apache/htdocs/Alzabo_docs /Alzabo_docs The script will create an index.html file as well as turning the documentation into HTML. =head2 How can I optimize memory usage under mod_perl? You should simply preload the Alzabo::Runtime module (which loads all the other modules it needs). In addition, if you are using Alzabo::MethodMaker, make sure it runs in the parent. This module can create a lot of methods on the fly and each method eats up some memory. Finally, you can preload one or more schema objects. The easiest way to do this is to simply pass its name to Alzabo::Runtime when you use it, like this: use Alzabo::Runtime qw( schema1 schema2 ); =head2 How can I get objects for tables linked via the Mason GUI? =over 4 For example, if I have a websites2categories table which maps a list of categories that a given web site should display -- and uses website_id and category_id in a 1..n relationship -- what is the proper way to set that up in the GUI and then in my code? =back In the GUI, you can simply create a relationship from websites to categories, and declare it n..n. Alzabo will automatically create a table called websites_categories, and you're free to change the name to whatever you want. Then if you use C, Alzabo will see that you have a table with 2 cols, both of which are part of the PK, and that it has 1..n relationships with 2 other tables, and it will create the appropriate methods. You can see what methods are being created by setting the C environment variable to "METHODMAKER" before loading Alzabo::MethodMaker. It'll spit everything out to STDERR. There's also the generated documentation, which is available via the C<< docs_as_pod() >> schema method after MethodMaker does its thing. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Exceptions.pm0000444000175000017500000002237510721343227017161 0ustar autarchautarchpackage Alzabo::Exceptions; use strict; use vars qw($VERSION); use Alzabo::Utils; $VERSION = 2.0; my %e; BEGIN { %e = ( 'Alzabo::Exception' => { description => 'Generic exception within the Alzabo API. Should only be used as a base class.', alias => 'exception', }, 'Alzabo::Exception::Driver' => { description => 'An attempt to eval a string failed', fields => [ 'sql', 'bind' ], isa => 'Alzabo::Exception', alias => 'driver_exception', }, 'Alzabo::Exception::Eval' => { description => 'An attempt to eval a string failed', isa => 'Alzabo::Exception', alias => 'eval_exception', }, 'Alzabo::Exception::Logic' => { description => 'An internal logic error occurred (presumably, Alzabo was asked to do something that cannot be done)', isa => 'Alzabo::Exception', alias => 'logic_exception', }, 'Alzabo::Exception::NoSuchRow' => { description => 'An attempt to fetch data from the database for a primary key that did not exist in the specified table', isa => 'Alzabo::Exception', alias => 'no_such_row_exception', }, 'Alzabo::Exception::Params' => { description => 'An exception generated when there is an error in the parameters passed in a method of function call', isa => 'Alzabo::Exception', alias => 'params_exception', }, 'Alzabo::Exception::NotNullable' => { description => 'An exception generated when there is an attempt is made to set a non-nullable column to NULL', isa => 'Alzabo::Exception::Params', fields => [ 'column_name', 'table_name', 'schema_name' ], alias => 'not_nullable_exception', }, 'Alzabo::Exception::Panic' => { description => 'An exception generated when something totally unexpected happens', isa => 'Alzabo::Exception', alias => 'panic_exception', }, 'Alzabo::Exception::RDBMSRules' => { description => 'An RDBMS rule check failed', isa => 'Alzabo::Exception', alias => 'rdbms_rules_exception', }, 'Alzabo::Exception::RDBMSRules::RecreateTable' => { description => 'An exception generated to indicate the a table needs to be recreated as part of a schema SQL diff', isa => 'Alzabo::Exception', alias => 'recreate_table_exception', }, 'Alzabo::Exception::ReferentialIntegrity' => { description => 'An operation was attempted that would violate referential integrity', isa => 'Alzabo::Exception', alias => 'referential_integrity_exception', }, 'Alzabo::Exception::SQL' => { description => 'An exception generated when there a logical error in a set of operation on an Alzabo::SQLMaker object', isa => 'Alzabo::Exception', alias => 'sql_exception', }, 'Alzabo::Exception::Storable' => { description => 'An attempt to call a function from the Storable module failed', isa => 'Alzabo::Exception', alias => 'storable_exception', }, 'Alzabo::Exception::System' => { description => 'An attempt to interact with the system failed', isa => 'Alzabo::Exception', alias => 'system_exception', }, 'Alzabo::Exception::VirtualMethod' => { description => 'Indicates that the method called must be subclassed in the appropriate class', isa => 'Alzabo::Exception', alias => 'virtual_method_exception', }, ); } use Exception::Class (%e); Alzabo::Exception->Trace(1); sub import { my ($class, %args) = @_; my $caller = caller; if ( $args{abbr} ) { foreach my $name ( ref $args{abbr} ? @{ $args{abbr} } : $args{abbr} ) { no strict 'refs'; die "Unknown exception abbreviation '$name'" unless defined &{$name}; *{"${caller}::$name"} = \&{$name}; } } { no strict 'refs'; *{"${caller}::isa_alzabo_exception"} = \&isa_alzabo_exception; *{"${caller}::rethrow_exception"} = \&rethrow_exception; } } sub isa_alzabo_exception { my ($err, $name) = @_; return unless defined $err; my $class = ! $name ? 'Alzabo::Exception' : $name =~ /^Alzabo::Exception/ ? $name : "Alzabo::Exception::$name"; { no strict 'refs'; die "no such exception class $class" unless defined(${"${class}::VERSION"}); } return Alzabo::Utils::safe_isa($err, $class); } sub rethrow_exception { my $err = shift; return unless $err; if ( Alzabo::Utils::safe_can( $err, 'rethrow' ) ) { $err->rethrow; } elsif ( ref $err ) { die $err; } Alzabo::Exception->throw( error => $err ); } package Alzabo::Exception; sub format { my $self = shift; if (@_) { $self->{format} = shift eq 'html' ? 'html' : 'text'; } return $self->{format} || 'text'; } sub as_string { my $self = shift; my $stringify_function = "as_" . $self->format; return $self->$stringify_function(); } sub as_text { return $_[0]->full_message . "\n\n" . $_[0]->trace->as_string; } sub as_html { my $self = shift; my $msg = $self->full_message; require HTML::Entities; $msg = HTML::Entities::encode_entities($msg); $msg =~ s/\n/
/; my $html = <<"EOF";

System error

error:  $msg
code stack:  EOF foreach my $frame ( $self->trace->frames ) { my $filename = HTML::Entities::encode_entities( $frame->filename ); my $line = $frame->line; $html .= "$filename: $line
\n"; } $html .= <<'EOF';
EOF return $html; } package Alzabo::Exception::Driver; sub full_message { my $self = shift; my $msg = $self->error; $msg .= "\nSQL: " . $self->sql if $self->sql; if ( $self->bind ) { my @bind = map { defined $_ ? $_ : '' } @{ $self->bind }; $msg .= "\nBIND: @bind" if @bind; } return $msg; } 1; =head1 NAME Alzabo::Exceptions - Creates all exception subclasses used in Alzabo. =head1 SYNOPSIS use Alzabo::Exceptions; =head1 DESCRIPTION Using this class creates all the exceptions classes used by Alzabo (via the L|Exception::Class> class). See L|Exception::Class> for more information on how this is done. =head1 EXCEPTION CLASSES =over 4 =item * Alzabo::Exception This is the base class for all exceptions generated within Alzabo (all exceptions should return true for C<< $@->isa('Alzabo::Exception') >> except those that are generated via internal Perl errors). =item * Alzabo::Exception::Driver An error occured while accessing a database. See L|Alzabo::Driver> for more details. =item * Alzabo::Exception::Eval An attempt to eval something returned an error. =item * Alzabo::Exception::Logic Alzabo was asked to do something logically impossible, like retrieve rows for a table without a primary key. =item * Alzabo::Exception::NoSuchRow An attempt was made to fetch data from the database with a primary key that does not actually exist in the specified table. =item * Alzabo::Exception::NotNullable An attempt was made to set a non-nullable column to C. The "column_name", "table_name", and "schema_name" fields can be used to identify the exact column. =item * Alzabo::Exception::Panic This exception is thrown when something completely unexpected happens (think Monty Python). =item * Alzabo::Exception::Params This exception is thrown when there is a problem with the parameters passed to a method or function. These problems can include missing parameters, invalid values, etc. =item * Alzabo::Exception::RDBMSRules A rule for the relevant RDBMS was violated (bad schema name, table name, column attribute, etc.) =item * Alzabo::Exception::ReferentialIntegrity An insert/update/delete was attempted that would violate referential integrity constraints. =item * Alzabo::Exception::SQL An error thrown when there is an attempt to generate invalid SQL via the Alzabo::SQLMaker module. =item * Alzabo::Exception::Storable A error when trying to freeze, thaw, or clone an object using Storable. =item * Alzabo::Exception::System Some sort of system call (file read/write, stat, etc.) failed. =item * Alzabo::Exception::VirtualMethod A virtual method was called. This indicates that this method should be subclassed. =back =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/BackCompat.pm0000444000175000017500000001311110721343227017030 0ustar autarchautarchpackage Alzabo::BackCompat; use strict; use Alzabo::Config; use File::Basename; use File::Copy; use File::Spec; use Storable; use Tie::IxHash; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); use vars qw($VERSION); $VERSION = 2.0; # # Each pair represents a range of versions which are compatible with # each other. The first one is not quite right but it has to start # somewhere ;) # # Any extra elements are subroutines which should be run to update the # schema, if it's version is lower than the first element of the # version pair. # my @compat = ( [ 0, 0.64 ], [ 0.65, 0.70, \&add_comment_fields, ], [ 0.71, 0.73, \&convert_pk_to_array, ], [ 0.79, $Alzabo::VERSION, \&add_table_attributes, ], ); sub update_schema { my %p = validate( @_, { name => { type => SCALAR }, version => { type => SCALAR }, } ); my @cb; foreach my $c (@compat) { return if ( ( $p{version} >= $c->[0] && $p{version} <= $c->[1] ) && ( $Alzabo::VERSION >= $c->[0] && $Alzabo::VERSION <= $c->[1] ) ); if ( $p{version} < $c->[0] && @$c > 2 ) { push @cb, @{$c}[2..$#$c]; } } my $create_loaded; unless ( $Alzabo::Create::Schema::VERSION ) { require Alzabo::Create::Schema; $create_loaded = 1; } my $v = $p{version} = 0 ? '0.64 or earlier' : $p{version}; my $c_file = Alzabo::Create::Schema->_schema_filename( $p{name} ); unless ( -w $c_file ) { my $msg = <<"EOF"; The '$p{name}' schema was created by an older version of Alzabo ($v) than the one currently installed ($Alzabo::VERSION). Alzabo can update your schema objects but your schema file: $c_file is not writeable by this process. Loading this schema in a process which can write to this file will cause the schema to be updated. EOF die $msg; } my $dir = dirname($c_file); unless ( -w $dir ) { my $msg = <<"EOF"; The '$p{name}' schema was created by an older version of Alzabo ($v) than the one currently installed ($Alzabo::VERSION). Alzabo can update your schema objects but its director: $dir is not writeable by this process. Loading this schema in a process which can write to this file will cause the schema to be updated. EOF die $msg; } foreach my $file ( glob("$dir/*.alz"), glob("$dir/*.rdbms"), glob("$dir/*.version") ) { my $backup = "$file.bak.v$p{version}"; copy($file, $backup); } my $fh = do { local *FH; *FH }; open $fh, "<$c_file" or Alzabo::Exception::System->throw( error => "Unable to open $c_file: $!" ); my $raw = Storable::fd_retrieve($fh) or Alzabo::Exception::System->throw( error => "Can't read filehandle" ); close $fh or Alzabo::Exception::System->throw( error => "Unable to close $c_file: $!" ); foreach (@cb) { $_->($raw); $_->( $raw->{original} ) if $raw->{original}; } open $fh, ">$c_file" or Alzabo::Exception::System->throw( error => "Unable to write to $c_file: $!" ); Storable::nstore_fd( $raw, $fh ) or Alzabo::Exception::System->throw( error => "Can't store to filehandle" ); close $fh or Alzabo::Exception::System->throw( error => "Unable to close $c_file: $!" ); my $version_file = File::Spec->catfile( Alzabo::Config::schema_dir(), $p{name}, "$p{name}.version" ); open $fh, ">$version_file" or Alzabo::Exception::System->throw( error => "Unable to write to $version_file: $!" ); print $fh $Alzabo::VERSION or Alzabo::Exception::System->throw( error => "Can't write to $version_file: $!" ); close $fh or Alzabo::Exception::System->throw( error => "Unable to close $version_file: $!" ); Alzabo::Create::Schema->load_from_file( name => $p{name} )->save_to_file; if ($create_loaded) { warn <<"EOF" Your schema, $p{name}, has been updated to be compatible with the installed version of Alzabo. This required that the Alzabo::Create::* classes be loaded. If you were loading an Alzabo::Runtime::Schema object, your running process is now somewhat larger than it has to be. If this is a long running process you may want to reload it. EOF } } sub add_comment_fields { my $s = shift; foreach my $table ( $s->{tables}->Values ) { $table->{comment} = ''; foreach my $thing ( $table->{columns}->Values, values %{ $table->{fk} } ) { $table->{comment} = ''; } } } sub convert_pk_to_array { my $s = shift; foreach my $table ( $s->tables ) { my @names = map { $_->name } $table->{pk}->Values; my $pk = [ $table->{columns}->Indices(@names) ]; $table->{pk} = $pk; } } sub add_table_attributes { my $s = shift; foreach my $table ( $s->tables ) { tie %{ $table->{attributes} }, 'Tie::IxHash'; } } __END__ =head1 NAME Alzabo::BackCompat - Convert old data structures =head1 DESCRIPTION This module is used to magically convert schemas with an older data structure to the latest format. More details on how this works can be found in L. =cut Alzabo-0.92/lib/Alzabo/Create.pm0000444000175000017500000000120210721343227016225 0ustar autarchautarchpackage Alzabo::Create; use Alzabo; use Alzabo::Create::Column; use Alzabo::Create::ColumnDefinition; use Alzabo::Create::ForeignKey; use Alzabo::Create::Index; use Alzabo::Create::Table; use Alzabo::Create::Schema; use vars qw($VERSION); $VERSION = 2.0; 1; __END__ =head1 NAME Alzabo::Create - Loads all Alzabo::Create::* classes =head1 SYNOPSIS use Alzabo::Create; =head1 DESCRIPTION Using this module loads Alzabo::Create::* modules. These are the core modules that allow a new set of objects to be created. This module should be used by any schema creation interface. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Driver/0000755000175000017500000000000010721343227015726 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/Driver/MySQL.pm0000444000175000017500000001314610721343227017234 0ustar autarchautarchpackage Alzabo::Driver::MySQL; use strict; use vars qw($VERSION); use Alzabo::Driver; use Alzabo::Utils; use DBD::mysql; use DBI; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; use base qw(Alzabo::Driver); sub new { my $proto = shift; my $class = ref $proto || $proto; my $self = bless {}, $class; return $self; } sub connect { my $self = shift; $self->disconnect if $self->{dbh}; $self->{dbh} = $self->_make_dbh( @_, name => $self->{schema}->db_schema_name ); foreach ( $self->rows( sql => 'SHOW VARIABLES' ) ) { if ( $_->[0] eq 'sql_mode' ) { # some versions of mysql may return '' for sql_mode $self->{mysql_ansi_mode} = ( $_->[1] ? $_->[1] : 0 ) & 4; last; } } } sub quote_identifier { my $self = shift; my @ids = @_; my $quote = $self->{mysql_ansi_mode} ? '"' : '`'; foreach (@ids) { next unless defined; s/$quote/$quote$quote/g; $_ = "$quote$_$quote"; } return join '.', @ids; } sub supports_referential_integrity { my $self = shift; my ($maj, $min, $p) = $self->_version_components; if ( $maj == 3 ) { return 0 if $min < 23; # 3.23.50 && 4.0.2 are the first versions where InnoDB # actually honored CASCADE, SET NULL, and SET DEFAULT return 0 if $p < 50; } # same deal return 0 if $maj == 4 && $min == 0 && $p < 2; foreach my $row ( $self->rows_hashref( sql => 'SHOW TABLE STATUS' ) ) { return 0 if $row->{TYPE} !~ /innodb/i; } } sub _version_components { my $self = shift; return split /\./, $self->rdbms_version; } sub rdbms_version { my $self = shift; $self->_ensure_valid_dbh; my $version = $self->{dbh}{mysql_serverinfo}; $version =~ s/[^\d\.]//g; return $version; } sub major_version { ($_[0]->_version_components)[0] } sub schemas { my $self = shift; my $dbh = $self->_make_dbh( name => '', @_ ); my @schemas = $dbh->func('_ListDBs'); Alzabo::Exception::Driver->throw( error => $dbh->errstr ) if $dbh->errstr; return @schemas; } sub create_database { my $self = shift; my $db = $self->{schema}->db_schema_name; my $dbh = $self->_make_dbh( name => '', @_ ); $dbh->func( 'createdb', $db, 'admin' ); Alzabo::Exception::Driver->throw( error => $dbh->errstr ) if $dbh->errstr; $dbh->disconnect; } sub drop_database { my $self = shift; my $db = $self->{schema}->db_schema_name; my $dbh = $self->_make_dbh( name => '', @_ ); $dbh->func( 'dropdb', $db, 'admin' ); Alzabo::Exception::Driver->throw( error => $dbh->errstr ) if $dbh->errstr; $dbh->disconnect; } sub _connect_params { my $self = shift; my %p = @_; %p = validate( @_, { name => { type => SCALAR }, user => { type => SCALAR | UNDEF, optional => 1 }, password => { type => SCALAR | UNDEF, optional => 1 }, host => { type => SCALAR | UNDEF, optional => 1 }, port => { type => SCALAR | UNDEF, optional => 1 }, map { $_ => 0 } grep { /^mysql_/ } keys %p, } ); my $dsn = "DBI:mysql:$p{name}"; $dsn .= ";host=$p{host}" if $p{host}; $dsn .= ";port=$p{port}" if $p{port}; foreach my $k ( grep { /^mysql_/ } keys %p ) { $dsn .= ";$k=$p{$k}"; } return [ $dsn, $p{user}, $p{password}, { RaiseError => 1, AutoCommit => 1, PrintError => 0, } ]; } sub next_sequence_number { # This will cause an auto_increment column to go up (because we're # inserting a NULL into it). return undef; } sub rollback { my $self = shift; eval { $self->SUPER::rollback }; if ( my $e = $@ ) { unless ( $e->error =~ /Some non-transactional changed tables/ ) { if ( Alzabo::Utils::safe_can( $e, 'rethrow' ) ) { $e->rethrow; } else { Alzabo::Exception->throw( error => $e ); } } } } sub get_last_id { my $self = shift; return $self->{dbh}->{mysql_insertid}; } sub driver_id { return 'MySQL'; } sub dbi_driver_name { return 'mysql'; } 1; __END__ =head1 NAME Alzabo::Driver::MySQL - MySQL specific Alzabo driver subclass =head1 SYNOPSIS use Alzabo::Driver::MySQL; =head1 DESCRIPTION This provides some MySQL specific implementations for the virtual methods in Alzabo::Driver. =head1 METHODS =head2 connect, create_database, drop_database Besides the parameters listed in L, these methods will also include any parameter starting with C in the DSN used to connect to the database. This allows you to pass parameters such as "mysql_default_file". See the DBD::mysql docs for more details. =head2 schemas This method accepts optional "host" and "port" parameters. =head2 get_last_id Returns the last id created via an AUTO_INCREMENT column. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Driver/PostgreSQL.pm0000444000175000017500000001744310721343227020276 0ustar autarchautarchpackage Alzabo::Driver::PostgreSQL; use strict; use vars qw($VERSION); use Alzabo::Driver; use DBD::Pg; use DBI; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; use base qw(Alzabo::Driver); sub new { my $proto = shift; my $class = ref $proto || $proto; return bless {}, $class; } sub connect { my $self = shift; $self->{tran_count} = undef; # This database handle is stale or nonexistent, so we need to (re)connect $self->disconnect if $self->{dbh}; $self->{dbh} = $self->_make_dbh( @_, name => $self->{schema}->db_schema_name ); } sub supports_referential_integrity { 1 } sub schemas { my $self = shift; my %p = validate( @_, { user => { type => SCALAR | UNDEF, optional => 1 }, password => { type => SCALAR | UNDEF, optional => 1 }, host => { type => SCALAR | UNDEF, optional => 1 }, port => { type => SCALAR | UNDEF, optional => 1 }, options => { type => SCALAR | UNDEF, optional => 1 }, tty => { type => SCALAR | UNDEF, optional => 1 }, } ); local %ENV; foreach ( grep { defined $p{$_} && length $p{$_} } keys %p ) { my $key = uc "pg$_"; $ENV{$key} = $p{$_}; } my @schemas = ( map { if ( defined ) { /dbi:\w+:dbname="?(\w+)"?/i; $1 ? $1 : (); } else { (); } } DBI->data_sources( $self->dbi_driver_name ) ); return @schemas; } sub tables { my $self = shift; # It seems that with DBD::Pg 1.31 & 1.32 you can't just the # database's table, you also get the system tables back return grep { ! /^(?:pg_catalog|information_schema)\./ } $self->SUPER::tables( @_ ); } sub create_database { my $self = shift; # Obviously we can't connect to the main database if it doesn't # exist yet, but postgres doesn't let us be databaseless, so we # connect to something else. "template1" should always be there. my $dbh = $self->_make_dbh( @_, name => 'template1' ); eval { $dbh->do( "CREATE DATABASE " . $dbh->quote_identifier( $self->{schema}->db_schema_name ) ); }; my $e = $@; eval { $dbh->disconnect; }; Alzabo::Exception::Driver->throw( error => $e ) if $e; Alzabo::Exception::Driver->throw( error => $@ ) if $@; } sub drop_database { my $self = shift; # We can't drop the current database, so we have to connect to # something else. "template1" should always be there. $self->disconnect; my $dbh = $self->_make_dbh( @_, name => 'template1' ); eval { $dbh->do( "DROP DATABASE " . $dbh->quote_identifier( $self->{schema}->db_schema_name ) ); }; my $e = $@; eval { $dbh->disconnect; }; $e ||= $@; Alzabo::Exception::Driver->throw( error => $e ) if $e; } sub _connect_params { my $self = shift; my %p = @_; %p = validate( @_, { name => { type => SCALAR }, user => { type => SCALAR | UNDEF, optional => 1 }, password => { type => SCALAR | UNDEF, optional => 1 }, host => { type => SCALAR | UNDEF, optional => 1 }, port => { type => SCALAR | UNDEF, optional => 1 }, options => { type => SCALAR | UNDEF, optional => 1 }, tty => { type => SCALAR | UNDEF, optional => 1 }, service => { type => SCALAR | UNDEF, optional => 1 }, sslmode => { type => SCALAR | UNDEF, optional => 1 }, map { $_ => 0 } grep { /^pg_/ } keys %p, } ); my $dsn = "dbi:Pg:dbname=$p{name}"; foreach ( qw( host port options tty service sslmode ) ) { $dsn .= ";$_=$p{$_}" if grep { defined && length } $p{$_}; } my %pg_keys = map { $_ => $p{$_} } grep { /^pg_/ } keys %p; return [ $dsn, $p{user}, $p{password}, { RaiseError => 1, AutoCommit => 1, PrintError => 0, %pg_keys, }, ]; } sub next_sequence_number { my $self = shift; my $col = shift; $self->_ensure_valid_dbh; Alzabo::Exception::Params->throw ( error => "This column (" . $col->name . ") is not sequenced" ) unless $col->sequenced; my $seq_name; if ( $col->type =~ /SERIAL/ ) { $seq_name = join '_', $col->table->name, $col->name; my $maxlen = $self->identifier_length; $seq_name = substr( $seq_name, 0, $maxlen - 4 ) if length $seq_name > ($maxlen - 4); $seq_name .= '_seq'; } else { $seq_name = join '___', $col->table->name, $col->name; } $seq_name = $self->{dbh}->quote_identifier($seq_name) if $self->{schema}->quote_identifiers; $self->{last_id} = $self->one_row( sql => "SELECT NEXTVAL('$seq_name')" ); return $self->{last_id}; } sub get_last_id { my $self = shift; return $self->{last_id}; } sub driver_id { return 'PostgreSQL'; } sub dbi_driver_name { return 'Pg'; } sub rdbms_version { my $self = shift; my $version_string = $self->one_row( sql => 'SELECT version()' ); my ($version) = $version_string =~ /^PostgreSQL ([\d.]+)/ or die "Couldn't determine version number from version string '$version_string'"; return $version; } sub identifier_length { my $self = shift; return $self->{identifier_length} if $self->{identifier_length}; return $self->{identifier_length} = $self->rdbms_version ge '7.3' ? 63 : 31; } 1; __END__ =head1 NAME Alzabo::Driver::PostgreSQL - PostgreSQL specific Alzabo driver subclass =head1 SYNOPSIS use Alzabo::Driver::PostgreSQL; =head1 DESCRIPTION This provides some PostgreSQL specific implementations for the virtual methods in Alzabo::Driver. =head1 METHODS =head2 connect, create_database, drop_database Besides the parameters listed in L, the following parameters are accepted: =over 4 =item * options =item * tty =back =head2 schemas This method accepts the same parameters as the C method. =head2 get_last_id Returns the last id created for a sequenced column. =head2 identifier_length Returns the maximum identifier length allowed by the database. This is really a guess based on the server version, since the actual value is set when the server is compiled. =head1 BUGS In testing, I found that there were some problems using Postgres in a situation where you start the app, connect to the database, get some data, fork, reconnect, and and then get more data. I suspect that this has more to do with the DBD::Pg driver and/or Postgres itself than Alzabo. I don't believe this would be a problem with an app which forks before ever connecting to the database (such as mod_perl). =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Schema.pm0000444000175000017500000001771710721343227016244 0ustar autarchautarchpackage Alzabo::Schema; use strict; use vars qw($VERSION %CACHE); use Alzabo; use Alzabo::Config; use Alzabo::Driver; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Alzabo::RDBMSRules; use Alzabo::SQLMaker; use Alzabo::Utils; use File::Spec; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); use Storable (); use Tie::IxHash (); $VERSION = 2.0; 1; sub _load_from_file { my $class = shift; my %p = validate( @_, { name => { type => SCALAR }, } ); # Making these (particularly from files) is expensive. return $class->_cached_schema($p{name}) if $class->_cached_schema($p{name}); my $schema_dir = Alzabo::Config::schema_dir; my $file = $class->_schema_filename( $p{name} ); -e $file or Alzabo::Exception::Params->throw( error => "No saved schema named $p{name} ($file)" ); my $version_file = File::Spec->catfile( $schema_dir, $p{name}, "$p{name}.version" ); my $version = 0; my $fh = do { local *FH; }; if ( -e $version_file ) { open $fh, "<$version_file" or Alzabo::Exception::System->throw( error => "Unable to open $version_file: $!\n" ); $version = join '', <$fh>; close $fh or Alzabo::Exception::System->throw( error => "Unable to close $version_file: $!" ); } if ( $version < $Alzabo::VERSION ) { require Alzabo::BackCompat; Alzabo::BackCompat::update_schema( name => $p{name}, version => $version ); } open $fh, "<$file" or Alzabo::Exception::System->throw( error => "Unable to open $file: $!" ); my $schema = Storable::retrieve_fd($fh) or Alzabo::Exception::System->throw( error => "Can't retrieve from filehandle" ); close $fh or Alzabo::Exception::System->throw( error => "Unable to close $file: $!" ); my $rdbms_file = File::Spec->catfile( $schema_dir, $p{name}, "$p{name}.rdbms" ); open $fh, "<$rdbms_file" or Alzabo::Exception::System->throw( error => "Unable to open $rdbms_file: $!\n" ); my $rdbms = join '', <$fh>; close $fh or Alzabo::Exception::System->throw( error => "Unable to close $rdbms_file: $!" ); $rdbms =~ s/\s//g; ($rdbms) = $rdbms =~ /(\w+)/; # This is important because if the user is using MethodMaker, they # might be calling this as My::Schema->load_from_file ... bless $schema, $class; $schema->{driver} = Alzabo::Driver->new( rdbms => $rdbms, schema => $schema ); $schema->{rules} = Alzabo::RDBMSRules->new( rdbms => $rdbms ); $schema->{sql} = Alzabo::SQLMaker->load( rdbms => $rdbms ); $schema->_save_to_cache; return $schema; } sub _cached_schema { my $class = shift->isa('Alzabo::Runtime::Schema') ? 'Alzabo::Runtime::Schema' : 'Alzabo::Create::Schema'; validate_pos( @_, { type => SCALAR } ); my $name = shift; my $schema_dir = Alzabo::Config::schema_dir(); my $file = $class->_schema_filename($name); if (exists $CACHE{$name}{$class}{object}) { my $mtime = (stat($file))[9] or Alzabo::Exception::System->throw( error => "can't stat $file: $!" ); return $CACHE{$name}{$class}{object} if $mtime <= $CACHE{$name}{$class}{mtime}; } } sub _schema_filename { my $class = shift; return $class->_base_filename(shift) . '.' . $class->_schema_file_type . '.alz'; } sub _base_filename { shift; my $name = shift; return File::Spec->catfile( Alzabo::Config::schema_dir(), $name, $name ); } sub _save_to_cache { my $self = shift; my $class = $self->isa('Alzabo::Runtime::Schema') ? 'Alzabo::Runtime::Schema' : 'Alzabo::Create::Schema'; my $name = $self->name; $CACHE{$name}{$class} = { object => $self, mtime => time }; } sub name { my $self = shift; return $self->{name}; } sub db_schema_name { my $self = shift; return ( exists $self->{db_schema_name} ? $self->{db_schema_name} : $self->name ); } sub has_table { my $self = shift; validate_pos( @_, { type => SCALAR } ); return $self->{tables}->FETCH(shift); } use constant TABLE_SPEC => { type => SCALAR }; sub table { my $self = shift; my ($name) = validate_pos( @_, TABLE_SPEC ); return $self->{tables}->FETCH($name) || params_exception "Table $name doesn't exist in $self->{name}"; } sub tables { my $self = shift; return $self->table(@_) if @_ == 1; return map { $self->table($_) } @_ if @_ > 1; return $self->{tables}->Values; } sub begin_work { shift->driver->begin_work; } *start_transaction = \&begin_work; sub rollback { shift->driver->rollback; } sub commit { shift->driver->commit; } *finish_transaction = \&commit; sub run_in_transaction { my $self = shift; my $code = shift; $self->begin_work; my @r; if (wantarray) { @r = eval { $code->() }; } else { $r[0] = eval { $code->() }; } if (my $e = $@) { eval { $self->rollback }; if ( Alzabo::Utils::safe_can( $e, 'rethrow' ) ) { $e->rethrow; } else { Alzabo::Exception->throw( error => $e ); } } $self->commit; return wantarray ? @r : $r[0]; } sub driver { my $self = shift; return $self->{driver}; } sub rules { my $self = shift; return $self->{rules}; } sub quote_identifiers { $_[0]->{quote_identifiers} } sub sqlmaker { my $self = shift; my %p = validate( @_, { quote_identifiers => { type => BOOLEAN, default => $self->{quote_identifiers}, }, }, ); return $self->{sql}->new( driver => $self->driver, quote_identifiers => $p{quote_identifiers}, ); } __END__ =head1 NAME Alzabo::Schema - Schema objects =head1 SYNOPSIS use base qw(Alzabo::Schema); =head1 DESCRIPTION This is the base class for schema objects.. =head1 METHODS =head2 name Returns a string containing the name of the schema. =head2 table ($name) Returns an L|Alzabo::Table> object representing the specified table. An L|Alzabo::Exceptions> exception is throws if the schema does not contain the table. =head2 tables (@optional_list) If no arguments are given, this method returns a list of all L|Alzabo::Table> objects in the schema, or in a scalar context the number of such tables. If one or more arguments are given, returns a list of table objects with those names, in the same order given (or the number of such tables in a scalar context, but this isn't terribly useful). An L|Alzabo::Exceptions> exception is throws if the schema does not contain one or more of the specified tables. =head2 has_table ($name) Returns a boolean value indicating whether the table exists in the schema. =head2 begin_work Starts a transaction. Calls to this function may be nested and it will be handled properly. =head2 rollback Rollback a transaction. =head2 commit Finishes a transaction with a commit. If you make multiple calls to C, make sure to call this method the same number of times. =head2 run_in_transaction ( sub { code... } ) This method takes a subroutine reference and wraps it in a transaction. It will preserve the context of the caller and returns whatever the wrapped code would have returned. =head2 driver Returns the L|Alzabo::Driver> object for the schema. =head2 rules Returns the L|Alzabo::RDBMSRules> object for the schema. =head2 sqlmaker Returns the L|Alzabo::SQLMaker> object for the schema. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/QuickRef.pod0000444000175000017500000002302610721343227016711 0ustar autarchautarch=head1 NAME Alzabo::QuickRef - A quick reference to methods in the Alzabo classes =head1 GENERAL This reference is intended to provide a quick reference to I of the more commonly used methods that Alzabo provides. In addition, this reference can give you an idea of what classes contain certain I of methods, so you have an idea of where to look in order to figure out how to achieve a certain task. =head2 Alzabo, Alzabo::Create, and Alzabo::Runtime These modules are mostly used just to load other modules. The C module can be used to preload schemas at compile time by doing: use Alzabo::Runtime qw( schema1 schema2 schema3 ); =head2 Alzabo::MethodMaker This module can be used to generate many useful convenience methods. This is done by auto-generating methods in new packages and re-blessing some of the schema objects into these packages. To have it generate all the possible methods for a schema you would do: use Alzabo::MethodMaker ( schema => 'some_schema', # Root for new packages class_root => 'My::Data', # Make all possible methods all => 1 ); This will make convenience methods for such things as getting table and column objects, following various types of foreign keys, and getting data from row objects. =head1 METHODS =head2 Retrieving data =head3 Alzabo::Runtime::Schema This object allows you to connect to the database. It contains several data retrieval methods including L|Alzabo::QuickRef/join>. =over 4 =item * load_from_file =for html_docs type=class Load an existing schema object from disk. Returns a new schema object. =for html_docs link=L =item * set_user ($user) =for html_docs type=object Set the username to be used when connecting to the database. =for html_docs link=L =item * set_password ($password) =for html_docs type=object Set the password to be used when connecting to the database. =for html_docs link=L =item * set_host ($host) =for html_docs type=object Set the host to be used when connecting to the database. =for html_docs link=L =item * connect (%params) =for html_docs type=object Connect to the RDBMS. This will use the previously set username/password/host, though these can be overridden by the C<%params> given to the call. B: This method must be called before any data retrieval is attempted. =for html_docs link=L =item * join =for html_docs type=object Fetch rows from one or more tables based on a table join. Returns either a L|Alzabo::Runtime::RowCursor> or L|Alzabo::Runtime::JoinCursor> object. =for html_docs link=L =item * function/select =for html_docs type=object Allows you to execute arbitrary column aggregate SQL functions such as C or C with a multi-table join. =for html_docs link=L =item * table ($name) =for html_docs type=object Returns an L|Alzabo::Runtime::Table> object. This is important because most of the row fetching operations are table object methods. =for html_docs link=L =back =head3 Alzabo::Runtime::Table Objects in this class have methods allowing you to insert new rows as well as retrieving exist data in the form of L|Alzabo::Runtime::Row> or L|Alzabo::Runtime::RowCursor> objects. All methods that return a single row return an L|Alzabo::Runtime::Row> object. All methods that return multiple rows return an L|Alzabo::Runtime::RowCursor> object. All methods that return rows can be given the C parameter, which ensures that the row(s) returned will not be cached. Rows obtained in this manner should not be updated or deleted, as this will play havoc with the caching system. See the L|Alzabo::Runtime::Row> documentation for more details. All methods that return multiple rows in the form of a cursor object can take an C parameter. See the L|Alzabo::Runtime::Table> documentation for more details. =over 4 =item * insert =for html_docs type=object Insert a new row and return it. =for html_docs link=L =item * row_by_pk =for html_docs type=object Returns the row identified by the primary key give. =for html_docs link=L =item * rows_where =for html_docs type=object Retrieves a set of rows based on a where clause. Please see the method documentation for details on how where clauses are constructed. =for html_docs link=L =item * all_rows =for html_docs type=object Retrieves all the rows in the table. =for html_docs link=L =item * function/select =for html_docs type=object Allows you to execute arbitrary column aggregate SQL functions such as C or C. =for html_docs link=L =item * potential_row =for html_docs type=object Make a new L|Alzabo::Runtime::Row> in the "potential" state. =for html_docs link=L =back =head3 Alzabo::Runtime::Row Objects in this class represent a single row of data. You can retrieve the actual column values from it, update it, or delete it. =over 4 =item * select (@list_of_column_names) =for html_docs type=object Given a list of column names, this method returns the values for those columns. =for html_docs link=L =item * update (%hash_of_columns_and_values) =for html_docs type=object Given a hash of columns and values, this method will update the database and the object to match those values. =for html_docs link=L =item * delete =for html_docs type=object Deletes the row from the database. Further attempts to retrieve data from this row will throw an exception. =for html_docs link=L =item * rows_by_foreign_key =for html_docs type=object Given a foreign key object from the row's table to another table, returns either an L|Alzabo::Runtime::Row> object or an L|Alzabo::Runtime::RowCursor> object for the row(s) in the table to which the relationship exists, based on the value of the relevant column(s) in the current row. This method can also take a C and/or C parameter. =for html_docs link=L =back =head3 Alzabo::Runtime::RowCursor Objects in this class are used to return multiple rows as a cursor, rather than as a list. This is much more efficient, at the expense of a few extra lines in your code. =over 4 =item * next =for html_docs type=object Returns the next L|Alzabo::Runtime::Row> object, or undef if there are no more. =for html_docs link=L =item * all_rows =for html_docs type=object Returns a list of all the remaining L|Alzabo::Runtime::Row> objects, or an empty list if there are no more. =for html_docs link=L =back =head2 Creating/removing a schema =head3 Alzabo::Create::Schema This object represents a schema, and contains one or more table objects. It is only used when creating or altering a schema, as opposed to when fetching data. Data manipulation is done via the C classes. =over 4 =item * reverse_engineer =for html_docs type=class Connect to a database and reverse engineer a schema. Returns a new schema object. =for html_docs link=L =item * load_from_file =for html_docs type=class Load an existing schema object from disk. Returns a new schema object. =for html_docs link=L =item * create =for html_docs type=object If the schema has not yet been instantiated in an RDBMS, this method will instantiate the schema. If it has been previously instantiated, it will bring the schema in the RDBMS into sync with its object representation (altering tables/columns, etc.) Where possible, exist data will be preserved. =for html_docs link=L =item * make_sql =for html_docs type=object Returns an array, each element of which is a SQL statement. The SQL is either the SQL to create the schema from scratch or the SQL needed to update the RDBMS to match the current object. See the L|Alzabo::QuickRef/create> method for more details. =for html_docs link=L =item * drop =for html_docs type=object Drop the database from the RDBMS where it was created. Does not remove the schema object itself from disk. =for html_docs link=L =item * delete =for html_docs type=object Delete the schema object files from disk. Does not drop the database from the RDBMS. =for html_docs link=L =back =head1 AUTHOR Dave Rolsky, Eautarch@urth.orgE =cut Alzabo-0.92/lib/Alzabo/MethodMaker.pm0000444000175000017500000014263210721343227017237 0ustar autarchautarchpackage Alzabo::MethodMaker; use strict; use vars qw($VERSION); use Alzabo::Exceptions; use Alzabo::Runtime; use Alzabo::Utils; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; # types of methods that can be made - only ones that haven't been # deprecated my @options = qw( foreign_keys linking_tables lookup_columns row_columns self_relations tables table_columns insert_hooks update_hooks select_hooks delete_hooks ); sub import { my $class = shift; validate( @_, { schema => { type => SCALAR }, class_root => { type => SCALAR, optional => 1 }, name_maker => { type => CODEREF, optional => 1 }, ( map { $_ => { optional => 1 } } 'all', @options ) } ); my %p = @_; return unless exists $p{schema}; return unless grep { exists $p{$_} && $p{$_} } 'all', @options; my $maker = $class->new(%p); $maker->make; } sub new { my $class = shift; my %p = @_; if ( delete $p{all} ) { foreach (@options) { $p{$_} = 1 unless exists $p{$_} && ! $p{$_}; } } my $s = Alzabo::Runtime::Schema->load_from_file( name => delete $p{schema} ); my $class_root; if ( $p{class_root} ) { $class_root = $p{class_root}; } else { my $x = 0; do { $class_root = caller($x++); die "No base class could be determined\n" unless $class_root; } while ( $class_root->isa(__PACKAGE__) ); } my $self; $p{name_maker} = sub { $self->name(@_) } unless ref $p{name_maker}; $self = bless { opts => \%p, class_root => $class_root, schema => $s, }, $class; return $self; } sub make { my $self = shift; $self->{schema_class} = join '::', $self->{class_root}, 'Schema'; bless $self->{schema}, $self->{schema_class}; $self->eval_schema_class; $self->load_class( $self->{schema_class} ); { # Users can add methods to these superclasses no strict 'refs'; foreach my $thing ( qw( Table Row ) ) { @{ "$self->{class_root}::${thing}::ISA" } = ( "Alzabo::Runtime::$thing", "Alzabo::DocumentationContainer" ); } } foreach my $t ( sort { $a->name cmp $b->name } $self->{schema}->tables ) { $self->{table_class} = join '::', $self->{class_root}, 'Table', $t->name; $self->{row_class} = join '::', $self->{class_root}, 'Row', $t->name; bless $t, $self->{table_class}; $self->eval_table_class; $self->{schema}->add_contained_class( table => $self->{table_class} ); $self->eval_row_class; $t->add_contained_class( row => $self->{row_class} ); if ( $self->{opts}{tables} ) { $self->make_table_method($t); } $self->load_class( $self->{table_class} ); $self->load_class( $self->{row_class} ); if ( $self->{opts}{table_columns} ) { $self->make_table_column_methods($t); } if ( $self->{opts}{row_columns} ) { $self->make_row_column_methods($t); } if ( grep { $self->{opts}{$_} } qw( foreign_keys linking_tables lookup_columns ) ) { $self->make_foreign_key_methods($t); } foreach ( qw( insert update select delete ) ) { if ( $self->{opts}{"$_\_hooks"} ) { $self->make_hooks($t, $_); } } } } sub eval_schema_class { my $self = shift; eval <<"EOF"; package $self->{schema_class}; use base qw( Alzabo::Runtime::Schema Alzabo::DocumentationContainer ); EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; } sub eval_table_class { my $self = shift; eval <<"EOF"; package $self->{table_class}; use base qw( $self->{class_root}::Table ); sub _row_class { '$self->{row_class}' } EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; } sub eval_row_class { my $self = shift; # Need to load this so that ->can checks can see them require Alzabo::Runtime; eval <<"EOF"; package $self->{row_class}; use base qw( $self->{class_root}::Row Alzabo::DocumentationContainer ); EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; } sub make_table_method { my $self = shift; my $t = shift; my $name = $self->_make_method ( type => 'table', class => $self->{schema_class}, returns => 'table object', code => sub { return $t; }, table => $t, ) or return; $self->{schema_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that return table objects', description => "returns the " . $t->name . " table object", ) ); } sub load_class { my $self = shift; my $class = shift; eval "use $class;"; die $@ if $@ && $@ !~ /^Can\'t locate .* in \@INC/; } sub make_table_column_methods { my $self = shift; my $t = shift; foreach my $c ( sort { $a->name cmp $b->name } $t->columns ) { my $col_name = $c->name; my $name = $self->_make_method ( type => 'table_column', class => $self->{table_class}, returns => 'column_object', # We can't just return $c because we may need to go # through the alias bits. And we need to use $_[0] for # the same reason. code => sub { return $_[0]->column($col_name) }, column => $c, ) or next; $self->{table_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that return column objects', description => "returns the " . $c->name . " column object", ) ); } } sub make_row_column_methods { my $self = shift; my $t = shift; foreach my $c ( sort { $a->name cmp $b->name } $t->columns ) { my $col_name = $c->name; my $name = $self->_make_method ( type => 'row_column', class => $self->{row_class}, returns => 'scalar value/takes new value', code => sub { my $self = shift; if (@_) { $self->update( $col_name => $_[0] ); } return $self->select($col_name); }, column => $c, ) or next; $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that update/return a column value', spec => [ { type => SCALAR } ], description => "returns the value of the " . $c->name . " column for a row. Given a value, it will also update the row first.", ) ); } } sub make_foreign_key_methods { my $self = shift; my $t = shift; foreach my $other_t ( sort { $a->name cmp $b->name } $t->schema->tables ) { my @fk = $t->foreign_keys_by_table($other_t) or next; if ( @fk == 2 && $fk[0]->table_from eq $fk[0]->table_to && $fk[1]->table_from eq $fk[1]->table_to ) { unless ($fk[0]->is_one_to_one) { $self->make_self_relation($fk[0]) if $self->{opts}{self_relations}; } next; } foreach my $fk (@fk) { $self->_make_fk_method($fk); } } } sub _make_method { my $self = shift; my %p = validate @_, { type => { type => SCALAR }, class => { type => SCALAR }, returns => { type => SCALAR, optional => 1 }, code => { type => CODEREF }, # Stuff we can pass through to name_maker foreign_key => { optional => 1 }, foreign_key_2 => { optional => 1 }, column => { optional => 1 }, table => { optional => 1 }, parent => { optional => 1 }, plural => { optional => 1 }, }; my $name = $self->{opts}{name_maker}->( %p ) or return; my ($code_name, $debug_name) = ("$p{class}::$name", "$p{class}\->$name"); if ( $p{class}->can($name) ) { warn "MethodMaker: Creating $p{type} method $debug_name will override" . " the method of the same name in the parent class\n"; } no strict 'refs'; # We use symbolic references here if ( defined &$code_name ) { # This should probably always be shown to the user, not just # when debugging mode is turned on, because name clashes can # cause confusion - whichever subroutine happens first will # arbitrarily win. warn "MethodMaker: skipping $p{type} method $debug_name, subroutine already exists\n"; return; } if (Alzabo::Debug::METHODMAKER) { my $message = "Making $p{type} method $debug_name"; $message .= ": returns $p{returns}" if $p{returns}; print STDERR "$message\n"; } *$code_name = $p{code}; return $name; } sub _make_fk_method { my $self = shift; my $fk = shift; my $table_to = $fk->table_to->name; # The table may be a linking or lookup table. If we are # supposed to make that kind of method we will and then we'll # skip to the next foreign table. $self->make_linking_table_method($fk) if $self->{opts}{linking_tables}; $self->make_lookup_columns_methods($fk) if $self->{opts}{lookup_columns}; return unless $self->{opts}{foreign_keys}; if ($fk->is_one_to_many) { my $name = $self->_make_method ( type => 'foreign_key', class => $self->{row_class}, returns => 'row cursor', code => sub { my $self = shift; return $self->rows_by_foreign_key( foreign_key => $fk, @_ ); }, foreign_key => $fk, plural => 1, ) or return; $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that return cursors for foreign keys', description => "returns a cursor containing related rows from the " . $fk->table_to->name . " table", spec => 'same as Alzabo::Runtime::Table->rows_where', ) ); } # Singular method name else { my $name = $self->_make_method ( type => 'foreign_key', class => $self->{row_class}, returns => 'single row', code => sub { my $self = shift; return $self->rows_by_foreign_key( foreign_key => $fk, @_ ); }, foreign_key => $fk, plural => 0, ) or return; $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that return a single row for foreign keys', description => "returns a single related row from the " . $fk->table_to->name . " table", spec => 'same as Alzabo::Runtime::Table->one_row', ) ); } } sub make_self_relation { my $self = shift; my $fk = shift; my (@pairs, @reverse_pairs); if ($fk->is_one_to_many) { @pairs = map { [ $_->[0], $_->[1]->name ] } $fk->column_pairs; @reverse_pairs = map { [ $_->[1], $_->[0]->name ] } $fk->column_pairs; } else { @pairs = map { [ $_->[1], $_->[0]->name ] } $fk->column_pairs; @reverse_pairs = map { [ $_->[0], $_->[1]->name ] } $fk->column_pairs; } my $table = $fk->table_from; my $name = $self->_make_method ( type => 'self_relation', class => $self->{row_class}, returns => 'single row', code => sub { my $self = shift; my @where = map { [ $_->[0], '=', $self->select( $_->[1] ) ] } @pairs; return $table->one_row( where => \@where, @_ ); }, foreign_key => $fk, parent => 1, ) or last; if ($name) { $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that return a parent row', description => "a single parent row from the same table", spec => 'same as Alzabo::Runtime::Table->one_row', ) ); } $name = $self->_make_method ( type => 'self_relation', class => $self->{row_class}, returns => 'row cursor', code => sub { my $self = shift; my %p = @_; my @where = map { [ $_->[0], '=', $self->select( $_->[1] ) ] } @reverse_pairs; if ( $p{where} ) { @where = ( '(', @where, ')' ); push @where, Alzabo::Utils::is_arrayref( $p{where}->[0] ) ? @{ $p{where} } : $p{where}; delete $p{where}; } return $table->rows_where( where => \@where, %p ); }, foreign_key => $fk, parent => 0, ) or return; $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that return child rows', description => "a row cursor of child rows from the same table", spec => 'same as Alzabo::Runtime::Table->rows_where', ) ); } sub make_linking_table_method { my $self = shift; my $fk = shift; return unless $fk->table_to->primary_key_size == 2; # Find the foreign key from the linking table to the _other_ table my $fk_2; { my @fk = $fk->table_to->all_foreign_keys; return unless @fk == 2; # Get the foreign key that's not the one we already have $fk_2 = $fk[0]->is_same_relationship_as($fk) ? $fk[1] : $fk[0]; } return unless $fk_2; # Not a linking table unless all the PK columns in the linking # table are part of the link. return unless $fk->table_to->primary_key_size == $fk->table_to->columns; # Not a linking table unless the PK in the middle table is the # same size as the sum of the two table's PK sizes return unless ( $fk->table_to->primary_key_size == ( $fk->table_from->primary_key_size + $fk_2->table_to->primary_key_size ) ); my $s = $fk->table_to->schema; my @t = ( $fk->table_to, $fk_2->table_to ); my $select = [ $t[1] ]; my $name = $self->_make_method ( type => 'linking_table', class => $self->{row_class}, returns => 'row cursor', code => sub { my $self = shift; my %p = @_; if ( $p{where} ) { $p{where} = [ $p{where} ] unless Alzabo::Utils::is_arrayref( $p{where}[0] ); } foreach my $pair ( $fk->column_pairs ) { push @{ $p{where} }, [ $pair->[1], '=', $self->select( $pair->[0]->name ) ]; } return $s->join( tables => [[@t, $fk_2]], select => $select, %p ); }, foreign_key => $fk, foreign_key_2 => $fk_2, ) or return; $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that follow a linking table', description => "a row cursor of related rows from the " . $fk_2->table_to->name . " table, " . "via the " . $fk->table_to->name . " linking table", spec => 'same as Alzabo::Runtime::Table->rows_where', ) ); } sub make_lookup_columns_methods { my $self = shift; my $fk = shift; return if $fk->is_one_to_many; # Make sure the relationship is to the foreign table's primary key my @to = $fk->columns_to; return unless ( ( scalar grep { $_->is_primary_key } @to ) == @to && ( $fk->table_to->primary_key_size == @to ) ); foreach ( sort { $a->name cmp $b->name } $fk->table_to->columns ) { next if $_->is_primary_key; my $col_name = $_->name; my $name = $self->_make_method ( type => 'lookup_columns', class => $self->{row_class}, returns => 'scalar value of column', code => sub { my $self = shift; my $row = $self->rows_by_foreign_key( foreign_key => $fk, @_ ); return unless $row; return $row->select($col_name) }, foreign_key => $fk, column => $_, ) or next; $self->{row_class}->add_method_docs ( Alzabo::MethodDocs->new ( name => $name, group => 'Methods that follow a lookup table', description => "returns the value of " . (join '.', $fk->table_to->name, $col_name) . " for the given row by following the foreign key relationship", spec => 'same as Alzabo::Runtime::Table->rows_where', ) ); } } sub make_hooks { my $self = shift; my $table = shift; my $type = shift; my $class = $type eq 'insert' ? $self->{table_class} : $self->{row_class}; my $pre = "pre_$type"; my $post = "post_$type"; return unless $class->can($pre) || $class->can($post); my $method = join '::', $class, $type; { no strict 'refs'; return if *{$method}{CODE}; } print STDERR "Making $type hooks method $class\->$type\n" if Alzabo::Debug::METHODMAKER; my $meth = "make_$type\_hooks"; $self->$meth($table); } sub make_insert_hooks { my $self = shift; my $code = ''; $code .= " return \$s->schema->run_in_transaction( sub {\n"; $code .= " my \$new;\n"; $code .= " \$s->pre_insert(\\\%p);\n" if $self->{table_class}->can('pre_insert'); $code .= " \$new = \$s->SUPER::insert(\%p);\n"; $code .= " \$s->post_insert({\%p, row => \$new});\n" if $self->{table_class}->can('post_insert'); $code .= " return \$new;\n"; $code .= " } );\n"; eval <<"EOF"; { package $self->{table_class}; sub insert { my \$s = shift; my \%p = \@_; $code } } EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; my $hooks = $self->_hooks_doc_string( $self->{table_class}, 'pre_insert', 'post_insert' ); $self->{table_class}->add_class_docs ( Alzabo::ClassDocs->new ( group => 'Hooks', description => "$hooks", ) ); } sub _hooks_doc_string { my $self = shift; my ($class, $hook1, $hook2) = @_; my @hooks; push @hooks, $hook1 if $class->can($hook1); push @hooks, $hook2 if $class->can($hook2); my $hooks = 'has'; $hooks .= @hooks > 1 ? '' : ' a '; $hooks .= join ' and ', @hooks; $hooks .= @hooks > 1 ? ' hooks' : ' hook'; return $hooks; } sub make_update_hooks { my $self = shift; my $code = ''; $code .= " \$s->schema->run_in_transaction( sub {\n"; $code .= " \$s->pre_update(\\\%p);\n" if $self->{row_class}->can('pre_update'); $code .= " \$s->SUPER::update(\%p);\n"; $code .= " \$s->post_update(\\\%p);\n" if $self->{row_class}->can('post_update'); $code .= " } );\n"; eval <<"EOF"; { package $self->{row_class}; sub update { my \$s = shift; my \%p = \@_; $code } } EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; my $hooks = $self->_hooks_doc_string( $self->{row_class}, 'pre_update', 'post_update' ); $self->{row_class}->add_class_docs ( Alzabo::ClassDocs->new ( group => 'Hooks', description => "$hooks", ) ); } sub make_select_hooks { my $self = shift; my ($pre, $post) = ('', ''); $pre = " \$s->pre_select(\\\@cols);\n" if $self->{row_class}->can('pre_update'); $post = " \$s->post_select(\\\%r);\n" if $self->{row_class}->can('post_update'); eval <<"EOF"; { package $self->{row_class}; sub select { my \$s = shift; my \@cols = \@_; return \$s->schema->run_in_transaction( sub { $pre my \@r; my %r; if (wantarray) { \@r{ \@cols } = \$s->SUPER::select(\@cols); } else { \$r{ \$cols[0] } = (scalar \$s->SUPER::select(\$cols[0])); } $post return wantarray ? \@r{\@cols} : \$r{ \$cols[0] }; } ); } sub select_hash { my \$s = shift; my \@cols = \@_; return \$s->schema->run_in_transaction( sub { $pre my \%r = \$s->SUPER::select_hash(\@cols); $post return \%r; } ); } } EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; my $hooks = $self->_hooks_doc_string( $self->{row_class}, 'pre_select', 'post_select' ); $self->{row_class}->add_class_docs ( Alzabo::ClassDocs->new ( group => 'Hooks', description => "$hooks", ) ); } sub make_delete_hooks { my $self = shift; my $code = ''; $code .= " \$s->schema->run_in_transaction( sub {\n"; $code .= " \$s->pre_delete(\\\%p);\n" if $self->{row_class}->can('pre_delete'); $code .= " \$s->SUPER::delete(\%p);\n"; $code .= " \$s->post_delete(\\\%p);\n" if $self->{row_class}->can('post_delete'); $code .= " } );\n"; eval <<"EOF"; package $self->{row_class}; sub delete { my \$s = shift; my \%p = \@_; $code } EOF Alzabo::Exception::Eval->throw( error => $@ ) if $@; my $hooks = $self->_hooks_doc_string( $self->{row_class}, 'pre_delete', 'post_delete' ); $self->{row_class}->add_class_docs ( Alzabo::ClassDocs->new ( group => 'Hooks', description => "$hooks", ) ); } sub name { my $self = shift; my %p = @_; return $p{table}->name if $p{type} eq 'table'; return $p{column}->name if $p{type} eq 'table_column'; return $p{column}->name if $p{type} eq 'row_column'; if ( $p{type} eq 'foreign_key' ) { return $p{foreign_key}->table_to->name; } if ( $p{type} eq 'linking_table' ) { my $method = $p{foreign_key}->table_to->name; my $tname = $p{foreign_key}->table_from->name; $method =~ s/^$tname\_?//; $method =~ s/_?$tname$//; return $method; } return join '_', map { lc $_->name } $p{foreign_key}->table_to, $p{column} if $p{type} eq 'lookup_columns'; return $p{column}->name if $p{type} eq 'lookup_columns'; return $p{parent} ? 'parent' : 'children' if $p{type} eq 'self_relation'; die "unknown type in call to naming sub: $p{type}\n"; } package Alzabo::DocumentationContainer; my %store; sub add_method_docs { my $class = shift; my $docs = shift; my $store = $class->_get_store($class); my $group = $docs->group; my $name = $docs->name; $store->{methods}{by_group}{$group} ||= Tie::IxHash->new; $store->{methods}{by_group}{$group}->Push( $name => $docs ); $store->{methods}{by_name} ||= Tie::IxHash->new; $store->{methods}{by_name}->Push( $name => $docs ); } sub add_class_docs { my $class = shift; my $docs = shift; my $store = $class->_get_store($class); my $group = $docs->group; $store->{class}{by_group}{$group} ||= []; push @{ $store->{class}{by_group}{$group} }, $docs; } sub add_contained_class { my $class = shift; my ($type, $contained) = @_; my $store = $class->_get_store($class); push @{ $store->{contained_classes}{by_name} }, $contained; push @{ $store->{contained_classes}{by_type}{$type} }, $contained; } sub _get_store { my $class = shift; $class = ref $class || $class; $store{$class} ||= {}; return $store{$class}; } sub method_names { my $class = shift; my $store = $class->_get_store($class); return $store->{methods}{by_name}->Keys; } sub methods_by_name { my $class = shift; my $store = $class->_get_store($class); return $store->{methods}{by_name}->Values; } sub method_groups { my $class = shift; my $store = $class->_get_store($class); return keys %{ $store->{methods}{by_group} }; } sub methods_by_group { my $class = shift; my $store = $class->_get_store($class); my $group = shift; return $store->{methods}{by_group}{$group}->Values if exists $store->{methods}{by_group}{$group}; } sub class_groups { my $class = shift; my $store = $class->_get_store($class); return keys %{ $store->{class}{by_group} }; } sub class_docs_by_group { my $class = shift; my $store = $class->_get_store($class); my $group = shift; return @{ $store->{class}{by_name}{$group} } if exists $store->{class}{by_name}{$group}; } sub class_docs { my $class = shift; my $store = $class->_get_store($class); my $group = shift; return map { @{ $store->{class}{by_group}{$_} } } keys %{ $store->{class}{by_group} }; } sub contained_classes { my $class = shift; my $store = $class->_get_store($class); return @{ $store->{contained_classes}{by_name} } if exists $store->{contained_classes}{by_name}; return; } sub method { my $class = shift; my $store = $class->_get_store($class); my $name = shift; return $store->{methods}{by_name}->FETCH($name) if exists $store->{methods}{by_name}; } sub docs_as_pod { my $self = shift; my $class = ref $self || $self; my $contained = shift; my $store = $class->_get_store($class); my $pod; $pod .= "=pod\n\n" unless $contained; $pod .= "=head1 $class\n\n"; foreach my $class_doc ( $class->class_docs ) { $pod .= $class_doc->as_pod; } foreach my $group ( $class->method_groups ) { $pod .= "=head2 $group\n\n"; foreach my $method ( $class->methods_by_group($group) ) { $pod .= $method->as_pod; } } $pod .= $_ foreach $self->contained_docs; $pod .= "=cut\n\n" unless $contained; return $pod; } sub contained_docs { my $self = shift; return map { $_->docs_as_pod(1) } $self->contained_classes; } package Alzabo::Docs; sub group { shift->{group} } sub description { shift->{description} } # copied from Params::ValidatePP { my %type_to_string = ( Params::Validate::SCALAR() => 'scalar', Params::Validate::ARRAYREF() => 'arrayref', Params::Validate::HASHREF() => 'hashref', Params::Validate::CODEREF() => 'coderef', Params::Validate::GLOB() => 'glob', Params::Validate::GLOBREF() => 'globref', Params::Validate::SCALARREF() => 'scalarref', Params::Validate::UNDEF() => 'undef', Params::Validate::OBJECT() => 'object', ); sub _typemask_to_strings { shift; my $mask = shift; my @types; foreach ( Params::Validate::SCALAR, Params::Validate::ARRAYREF, Params::Validate::HASHREF, Params::Validate::CODEREF, Params::Validate::GLOB, Params::Validate::GLOBREF, Params::Validate::SCALARREF, Params::Validate::UNDEF, Params::Validate::OBJECT ) { push @types, $type_to_string{$_} if $mask & $_; } return @types ? @types : ('unknown'); } } package Alzabo::MethodDocs; use Params::Validate qw( validate SCALAR ARRAYREF HASHREF ); use base qw(Alzabo::Docs); sub new { my $class = shift; my %p = validate( @_, { name => { type => SCALAR }, group => { type => SCALAR }, description => { type => SCALAR }, spec => { type => SCALAR | ARRAYREF | HASHREF, default => undef }, } ); return bless \%p, $class; } sub name { shift->{name} } sub spec { shift->{spec} } sub as_pod { my $self = shift; my $desc = ucfirst $self->{description}; my $spec = $self->spec; my $params; if ( defined $spec ) { if ( Alzabo::Utils::is_arrayref( $spec ) ) { $params = "=over 4\n\n"; foreach my $p (@$spec) { $params .= "=item * "; if ( exists $p->{type} ) { # hack! my $types = join ', ', $self->_typemask_to_strings( $p->{type} ); $params .= "($types)"; } $params .= "\n\n"; } $params .= "=back\n\n"; } elsif ( Alzabo::Utils::is_hashref($spec) ) { $params = "=over 4\n\n"; while ( my ($name, $p) = each %$spec ) { $params .= "=item * $name "; if ( exists $p->{type} ) { # hack! my $types = join ', ', $self->_typemask_to_strings( $p->{type} ); $params .= "($types)"; } $params .= "\n\n"; } $params .= "=back\n\n"; } else { $params = "Parameters: $spec\n\n"; } } my $pod = <<"EOF"; =head3 $self->{name} $desc EOF $pod .= $params if $params; return $pod; } package Alzabo::ClassDocs; use Params::Validate qw( validate SCALAR ); use base qw(Alzabo::Docs); sub new { my $class = shift; my %p = validate( @_, { group => { type => SCALAR }, description => { type => SCALAR }, } ); return bless \%p, $class; } sub as_pod { my $self = shift; return ucfirst "$self->{description}\n\n"; } 1; __END__ =head1 NAME Alzabo::MethodMaker - Auto-generate useful methods based on an existing schema =head1 SYNOPSIS use Alzabo::MethodMaker ( schema => 'schema_name', all => 1 ); =head1 DESCRIPTION This module can take an existing schema and generate a number of useful methods for this schema and its tables and rows. The method making is controlled by the parameters given along with the use statement, as seen in the L. =head1 PARAMETERS These parameters are all passed to the module when it is imported via C. =over 4 =item * schema => $schema_name This parameter is B. =item * class_root => $class_name If given, this will be used as the root of the class names generated by this module. This root should not end in '::'. If none is given, then the calling module's name is used as the root. See L for more information. =item * all => $bool This tells this module to make all of the methods it possibly can. See L for more details. If individual method creation options are set as false, then that setting will be respected, so you could use use Alzabo::MethodMaker( schema => 'foo', all => 1, tables => 0 ); to turn on all of the regular options B for "tables". =item * name_maker => \&naming_sub If provided, then this callback will be called any time a method name needs to be generated. This allows you to have full control over the resulting names. Otherwise names are generated as described in the documentation. The callback is expected to return a name for the method to be used. This name should not be fully qualified or contain any class designation as this will be handled by MethodMaker. It is important that none of the names returned conflict with existing methods for the object the method is being added to. For example, when adding methods that return column objects to a table, if you have a column called 'name' and try to use that as the method name, it won't work. C objects already have such a method, which returns the name of the table. See the relevant documentation of the schema, table, and row objects for a list of methods they contain. The L section contains the details of what parameters are passed to this callback. I that if you have a large complex schema you will almost certainly need to provide a custom naming subroutine to avoid name conflicts. =back =head1 EFFECTS Using this module has several effects on your schema's objects. =head2 New Class Names Your schema, table, and row objects to be blessed into subclasses of L|Alzabo::Runtime::Schema>, L|Alzabo::Runtime::Table>, L|Alzabo::Runtime::Row>, respectively. These subclasses contain the various methods created by this module. The new class names are formed by using the L<"class_root"|Alzabo::MethodMaker/PARAMETERS> parameter and adding onto it. In order to make it convenient to add new methods to the table and row classes, the created table classes are all subclasses of a new class based on your class root, and the same thing is done for all created row classes. =over 4 =item * Schema ::Schema =item * Tables ::Table:: All tables will be subclasses of: ::Table =item * Rows ::Row::
All rows will be subclasses of: ::Row =back With a root of "My::MovieDB", and a schema with only two tables, "Movie" and "Image", this would result in the following class names: My::MovieDB::Schema My::MovieDB::Table::Movie - subclass of My::MovieDB::Table My::MovieDB::Row::Movie - subclass of My::MovieDB::Row My::MovieDB::Table::Image - subclass of My::MovieDB::Table My::MovieDB::Row::Image - subclass of My::MovieDB::Row =head2 Loading Classes For each class into which an object is blessed, this module will attempt to load that class via a C statement. If there is no module found this will not cause an error. If this class defines any methods that have the same name as those this module generates, then this module will not attempt to generate them. =head1 METHOD CREATION OPTIONS When using Alzabo::MethodMaker, you may specify any of the following parameters. Specifying "all" causes all of them to be used. =head2 Schema object methods =over 4 =item * tables => $bool Creates methods for the schema that return the table object matching the name of the method. For example, given a schema containing tables named "Movie" and "Image", this would create methods that could be called as C<< $schema->Movie >> and C<< $schema->Image >>. =back =head2 Table object methods. =over 4 =item * table_columns => $bool Creates methods for the tables that return the column object matching the name of the method. This is quite similar to the C option for schemas. So if our "Movie" table had a column called "title", we could write C<< $schema->Movie->title >>. =item * insert_hooks => $bool Look for hooks to wrap around the C method in L|Alzabo::Runtime::Table>. See L for more details. You have to define either a C and/or C method for the generated table class or this parameter will not do anything. See the L section for more details. =back =head2 Row object methods =over 4 =item * row_columns => $bool This tells MethodMaker to create get/set methods for each column a row has. These methods take a single optional argument, which if given will cause that column to be updated for the row. =item * update_hooks => $bool Look for hooks to wrap around the C method in L|Alzabo::Runtime::Row>. See L for more details. You have to define a C and/or C method for the generated row class or this parameter will not do anything. See the L section for more details. =item * select_hooks => $bool Look for hooks to wrap around the C
. It is the table object the schema object's method will return. =back When the type is "table_column" or "row_column": =over 4 =item * column => Alzabo::Column object When the type is "table_column", this is the column object the method will return. When the type is "row_column", then it is the column whose B the method will return. =back When the type is "foreign_key", "linking_table", or "self_relation": =over 4 =item * foreign_key => Alzabo::ForeignKey object This is the foreign key on which the method is based. =back It is possible to create an n..n relationship between a table and itself, and MethodMaker will attempt to generate linking table methods for such relationships, so your naming sub may need to take this into account. When the type is "foreign_key": =over 4 =item * plural => $bool This indicates whether or not the method that is being created will return a cursor object (true) or a row object (false). =back When the type is "linking_table": =over 4 =item * foreign_key_2 => Alzabo::ForeignKey object When making a linking table method, two foreign keys are used. The C is from the table being linked from to the linking table. This parameter is the foreign key from the linking table to the table being linked to. =back When the type is "lookup_columns": =over 4 =item * column => Alzabo::Column object When making lookup column methods, this column is the column in the foreign table for which a method is being made. =back When the type is "self_relation": =over 4 =item * parent => $boolean This indicates whether or not the method being created will return parent objects (true) or child objects (false). =back =head1 NAMING SUB EXAMPLE Here is an example that covers all of the possible options: use Lingua::EN::Inflect; sub namer { my %p = @_; # Table object can be returned from the schema via methods such as $schema->User_t; return $p{table}->name . '_t' if $p{type} eq 'table'; # Column objects are returned similarly, via $schema->User_t->username_c; return $p{column}->name . '_c' if $p{type} eq 'table_column'; # If I have a row object, I can get at the columns via their # names, for example $user->username; return $p{column}->name if $p{type} eq 'row_column'; # This manipulates the table names a bit to generate names. For # example, if I have a table called UserRating and a 1..n # relationship from User to UserRating, I'll end up with a method # on rows in the User table called ->Ratings which returns a row # cursor of rows from the UserRating table. if ( $p{type} eq 'foreign_key' ) { my $name = $p{foreign_key}->table_to->name; my $from = $p{foreign_key}->table_from->name; $name =~ s/$from//; if ($p{plural}) { return my_PL( $name ); } else { return $name; } } # This is very similar to how foreign keys are handled. Assume # we have the tables Restaurant, Cuisine, and RestaurantCuisine. # If we are generating a method for the link from Restaurant # through to Cuisine, we'll have a method on Restaurant table # rows called ->Cuisines, which will return a cursor of rows from # the Cuisine table. # # Note: this will generate a bad name if given a linking table # that links a table to itself. if ( $p{type} eq 'linking_table' ) { my $method = $p{foreign_key}->table_to->name; my $tname = $p{foreign_key}->table_from->name; $method =~ s/$tname//; return my_PL($method); } # Lookup columns are columns if foreign tables for which there # exists a one-to-one or many-to-one relationship. In cases such # as these, it is often the case that the foreign table is rarely # used on its own, but rather it primarily used as a lookup table # for values that should appear to be part of other tables. # # For example, an Address table might have a many-to-one # relationship with a State table. The State table would contain # the columns 'name' and 'abbreviation'. If we have # an Address table row, it is convenient to simply be able to say # $address->state_name and $address->state_abbreviation. if ( $p{type} eq 'lookup_columns' ) { return join '_', map { lc $_->name } $p{foreign_key}->table_to, $p{column}; } # This should be fairly self-explanatory. return $p{parent} ? 'parent' : 'children' if $p{type} eq 'self_relation'; # And just to make sure that nothing slips by us we do this. die "unknown type in call to naming sub: $p{type}\n"; } # Lingua::EN::Inflect did not handle the word 'hours' properly when this was written sub my_PL { my $name = shift; return $name if $name =~ /hours$/i; return Lingua::EN::Inflect::PL($name); } =head1 GENERATED DOCUMENTATION This module keeps track of methods that are generated and can in turn generate basic POD for those methods. Any schema that has had methods generated for it by Alzabo::MethodMaker will have an additional method, C. This will return documentation for the schema object's methods, as well as any documentation available for objects that the schema contains, in this case tables. The tables in turn return their own documentation plus that of their contained row classes. It is also possible to call the C method on any generated table or row class individually. A simple script like the following can be used to send all of the generated documentation to C. use Alzabo::MethodMaker ( schema => 'foo', all => 1 ); my $s = Alzabo::Runtime::Schema->load_from_file( name => 'foo' ); print $s->docs_as_pod; =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Table.pm0000444000175000017500000002365710721343227016073 0ustar autarchautarchpackage Alzabo::Table; use strict; use vars qw($VERSION); use Alzabo; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); use Tie::IxHash; $VERSION = 2.0; 1; sub schema { my $self = shift; return $self->{schema}; } sub name { my $self = shift; return $self->{name}; } use constant HAS_COLUMN_SPEC => { type => SCALAR }; sub has_column { my $self = shift; validate_pos( @_, HAS_COLUMN_SPEC ); return $self->{columns}->FETCH(shift); } sub column { my $self = shift; my $name = shift; if ( my $col = $self->{columns}->FETCH($name) ) { return $col; } else { Alzabo::Exception::Params->throw ( error => "Column $name doesn't exist in $self->{name}" ); } } sub columns { my $self = shift; return $self->column(@_) if @_ ==1 ; return map { $self->column($_) } @_ if @_ > 1; return $self->{columns}->Values; } sub primary_key { my $self = shift; return unless @{ $self->{pk} }; return ( wantarray ? $self->{columns}->Values( @{ $self->{pk} } ) : $self->{columns}->Values( $self->{pk}[0] ) ); } sub primary_key_size { my $self = shift; return scalar @{ $self->{pk} }; } use constant COLUMN_IS_PRIMARY_KEY_SPEC => { isa => 'Alzabo::Column' }; sub column_is_primary_key { my $self = shift; validate_pos( @_, COLUMN_IS_PRIMARY_KEY_SPEC ); my $name = shift->name; Alzabo::Exception::Params->throw( error => "Column $name doesn't exist in $self->{name}" ) unless $self->{columns}->EXISTS($name); my $idx = $self->{columns}->Indices($name); return 1 if grep { $idx == $_ } @{ $self->{pk} }; return 0; } sub attributes { return keys %{ $_[0]->{attributes} }; } use constant HAS_ATTRIBUTE_SPEC => { attribute => { type => SCALAR }, case_sensitive => { type => SCALAR, default => 0 }, }; sub has_attribute { my $self = shift; my %p = validate( @_, HAS_ATTRIBUTE_SPEC ); if ( $p{case_sensitive} ) { return exists $self->{attributes}{ $p{attribute} }; } else { return 1 if grep { lc $p{attribute} eq lc $_ } keys %{ $self->{attributes} }; } } use constant FOREIGN_KEYS_SPEC => { column => { isa => 'Alzabo::Column' }, table => { isa => 'Alzabo::Table' }, }; sub foreign_keys { my $self = shift; validate( @_, FOREIGN_KEYS_SPEC ); my %p = @_; my $c_name = $p{column}->name; my $t_name = $p{table}->name; Alzabo::Exception::Params->throw( error => "Column $c_name doesn't exist in $self->{name}" ) unless $self->{columns}->EXISTS($c_name); Alzabo::Exception::Params->throw( error => "No foreign keys to $t_name exist in $self->{name}" ) unless exists $self->{fk}{$t_name}; Alzabo::Exception::Params->throw( error => "Column $c_name is not a foreign key to $t_name in $self->{name}" ) unless exists $self->{fk}{$t_name}{$c_name}; return wantarray ? @{ $self->{fk}{$t_name}{$c_name} } : $self->{fk}{$t_name}{$c_name}[0]; } use constant FOREIGN_KEYS_BY_TABLE_SPEC => { isa => 'Alzabo::Table' }; sub foreign_keys_by_table { my $self = shift; validate_pos( @_, FOREIGN_KEYS_BY_TABLE_SPEC ); my $name = shift->name; my $fk = $self->{fk}; my %fk; if ( exists $fk->{$name} ) { foreach my $c ( keys %{ $fk->{$name} } ) { return $fk->{$name}{$c}[0] unless wantarray; $fk{$_} = $_ for @{ $fk->{$name}{$c} }; } } return values %fk; } use constant FOREIGN_KEYS_BY_COLUMN_SPEC => { isa => 'Alzabo::Column' }; sub foreign_keys_by_column { my $self = shift; my ($col) = validate_pos( @_, FOREIGN_KEYS_BY_COLUMN_SPEC ); Alzabo::Exception::Params->throw( error => "Column " . $col->name . " doesn't exist in $self->{name}" ) unless $self->{columns}->EXISTS( $col->name ); my $fk = $self->{fk}; my %fk; foreach my $t (keys %$fk) { if ( exists $fk->{$t}{ $col->name } ) { return $fk->{$t}{ $col->name }[0] unless wantarray; $fk{$_} = $_ for @{ $fk->{$t}{ $col->name } }; } } return values %fk; } sub all_foreign_keys { my $self = shift; my %seen; my @fk; my $fk = $self->{fk}; foreach my $t (keys %$fk) { foreach my $c ( keys %{ $fk->{$t} } ) { foreach my $key ( @{ $fk->{$t}{$c} } ) { next if $seen{$key}; push @fk, $key; $seen{$key} = 1; } } } return wantarray ? @fk : $fk[0]; } sub index { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $id = shift; Alzabo::Exception::Params->throw( error => "Index $id doesn't exist in $self->{name}" ) unless $self->{indexes}->EXISTS($id); return $self->{indexes}->FETCH($id); } sub has_index { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $id = shift; return $self->{indexes}->EXISTS($id); } sub indexes { my $self = shift; return $self->{indexes}->Values; } sub comment { $_[0]->{comment} } __END__ =head1 NAME Alzabo::Table - Table objects =head1 SYNOPSIS use Alzabo::Table; my $t = $schema->table('foo'); foreach $pk ($t->primary_keys) { print $pk->name; } =head1 DESCRIPTION Objects in this class represent tables. They contain foreign key, index, and column objects. =head1 METHODS =head2 schema Returns the L|Alzabo::Schema> object to which this table belongs. =head2 name Returns the name of the table. =head2 column ($name) Returns the L|Alzabo::Column> object that matches the name given. An L|Alzabo::Exceptions> exception is throws if the table does not contain the column. =head2 columns (@optional_list_of_column_names) If no arguments are given, returns a list of all L|Alzabo::Column> objects in the schema, or in a scalar context the number of such tables. If one or more arguments are given, returns a list of table objects with those names, in the same order given. An L|Alzabo::Exceptions> exception is throws if the table does not contain one or more of the specified columns. =head2 has_column ($name) Returns a voolean value indicating whether the column exists in the table. =head2 primary_key In array context, return an ordered list of column objects that make up the primary key for the table. In scalar context, it returns the first element of that list. =head2 primary_key_size The number of columns in the table's primary key. =head2 column_is_primary_key (C object) Returns a boolean value indicating whether the column given is part of the table's primary key. This method is really only needed if you're not sure that the column belongs to the table. Otherwise just call the Lis_primary_key >>|Alzabo::Column/is_primary_key> method on the column object. =head2 attributes A table's attributes are strings describing the table (for example, valid attributes in MySQL are thing like "TYPE = INNODB". Returns a list of strings. =head2 has_attribute This method can be used to test whether or not a table has a particular attribute. By default, the check is case-insensitive. =over 4 =item * attribute => $attribute =item * case_sensitive => 0 or 1 (defaults to 0) =back Returns a boolean value indicating whether the table has this particular attribute. =head2 foreign_keys Thie method takes two parameters: =over 4 =item * column => C object =item * table => C object =back It returns a list of L|Alzabo::ForeignKey> objects B the given column B the given table, if they exist. In scalar context, it returns the first item in the list. There is no guarantee as to what the first item will be. An L|Alzabo::Exceptions> exception is throws if the table does not contain the specified column. =head2 foreign_keys_by_table (C object) Returns a list of all the L|Alzabo::ForeignKey> objects B the given table. In scalar context, it returns the first item in the list. There is no guarantee as to what the first item will be. =head2 foreign_keys_by_column (C object) Returns a list of all the L|Alzabo::ForeignKey> objects that the given column is a part of, if any. In scalar context, it returns the first item in the list. There is no guarantee as to what the first item will be. An L|Alzabo::Exceptions> exception is throws if the table does not contain the specified column. =head2 all_foreign_keys Returns a list of all the L|Alzabo::ForeignKey> objects for this table. In scalar context, it returns the first item in the list. There is no guarantee as to what the first item will be. =head2 index ($index_id) This method expects an index id as returned by the Lid>|Alzabo::Index/id> method as its parameter. The L|Alzabo::Index> object matching this id, if it exists in the table. An L|Alzabo::Exceptions> exception is throws if the table does not contain the specified index. =head2 has_index ($index_id) This method expects an index id as returned by the Lid>|Alzabo::Index/id> method as its parameter. Returns a boolean indicating whether the table has an index with the same id. =head2 indexes Returns all the L|Alzabo::Index> objects for the table. =head2 comment Returns the comment associated with the table object, if any. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Driver.pm0000444000175000017500000005640310721343227016272 0ustar autarchautarchpackage Alzabo::Driver; use strict; use vars qw($VERSION); use Alzabo::Exceptions; use Class::Factory::Util; use DBI; use Params::Validate qw( validate validate_pos UNDEF SCALAR ARRAYREF ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; 1; sub new { shift; my %p = @_; eval "use Alzabo::Driver::$p{rdbms}"; Alzabo::Exception::Eval->throw( error => $@ ) if $@; my $self = "Alzabo::Driver::$p{rdbms}"->new(@_); $self->{schema} = $p{schema}; return $self; } sub available { __PACKAGE__->subclasses } sub _ensure_valid_dbh { my $self = shift; unless ( $self->{dbh} ) { my $sub = (caller(1))[3]; Alzabo::Exception::Driver->throw( error => "Cannot call $sub before calling connect." ); } $self->{dbh} = $self->_dbi_connect( $self->{connect_params} ) if $$ != $self->{connect_pid}; } sub quote { my $self = shift; $self->_ensure_valid_dbh; return $self->{dbh}->quote(@_); } sub quote_identifier { my $self = shift; $self->_ensure_valid_dbh; return $self->{dbh}->quote_identifier(@_); } sub rows { my $self = shift; $self->_ensure_valid_dbh; my %p = @_; my $sth = $self->_prepare_and_execute(%p); my @data; eval { my @row; $sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) ); push @data, [@row] while $sth->fetch; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return wantarray ? @data : $data[0]; } sub rows_hashref { my $self = shift; my %p = @_; $self->_ensure_valid_dbh; my $sth = $self->_prepare_and_execute(%p); my @data; eval { my %hash; $sth->bind_columns( \ ( @hash{ @{ $sth->{NAME_uc} } } ) ); push @data, {%hash} while $sth->fetch; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return @data; } sub one_row { my $self = shift; my %p = @_; $self->_ensure_valid_dbh; my $sth = $self->_prepare_and_execute(%p); my @row; eval { @row = $sth->fetchrow_array; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return wantarray ? @row : $row[0]; } sub one_row_hash { my $self = shift; my %p = @_; $self->_ensure_valid_dbh; my $sth = $self->_prepare_and_execute(%p); my %hash; eval { my @row = $sth->fetchrow_array; @hash{ @{ $sth->{NAME_uc} } } = @row if @row; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return %hash; } sub column { my $self = shift; my %p = @_; $self->_ensure_valid_dbh; my $sth = $self->_prepare_and_execute(%p); my @data; eval { my @row; $sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) ); push @data, $row[0] while ($sth->fetch); $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return wantarray ? @data : $data[0]; } use constant _PREPARE_AND_EXECUTE_SPEC => { sql => { type => SCALAR }, bind => { type => UNDEF | SCALAR | ARRAYREF, optional => 1 }, }; sub _prepare_and_execute { my $self = shift; validate( @_, _PREPARE_AND_EXECUTE_SPEC ); my %p = @_; Alzabo::Exception::Driver->throw( error => "Attempt to access the database without database handle. Was ->connect called?" ) unless $self->{dbh}; my @bind = exists $p{bind} ? ( ref $p{bind} ? @{ $p{bind} } : $p{bind} ) : (); my $sth; eval { $sth = $self->{dbh}->prepare( $p{sql} ); $sth->execute(@bind); }; if ($@) { Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return $sth; } sub do { my $self = shift; my %p = @_; $self->_ensure_valid_dbh; my $sth = $self->_prepare_and_execute(%p); my $rows; eval { $rows = $sth->rows; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => \@bind ); } return $rows; } sub tables { my $self = shift; $self->_ensure_valid_dbh; my @t = eval { $self->{dbh}->tables( '', '', '%', 'table' ); }; Alzabo::Exception::Driver->throw( error => $@ ) if $@; return @t; } sub schemas { my $self = shift; shift()->_virtual; } sub _make_dbh { my $self = shift; return $self->_dbi_connect( $self->_connect_params(@_) ); } sub _dbi_connect { my $self = shift; my $connect = shift; my $dbh = eval { DBI->connect(@$connect) }; Alzabo::Exception::Driver->throw( error => $@ ) if $@; Alzabo::Exception::Driver->throw( error => "Unable to connect to database\n" ) unless $dbh; $self->{connect_params} = $connect; $self->{connect_pid} = $$; return $dbh; } sub statement { my $self = shift; $self->_ensure_valid_dbh; return Alzabo::DriverStatement->new( dbh => $self->{dbh}, @_ ); } sub statement_no_execute { my $self = shift; $self->_ensure_valid_dbh; return Alzabo::DriverStatement->new_no_execute( dbh => $self->{dbh}, @_ ); } sub func { my $self = shift; $self->_ensure_valid_dbh; my @r; eval { if (wantarray) { @r = $self->{dbh}->func(@_); return @r; } else { $r[0] = $self->{dbh}->func(@_); return $r[0]; } }; Alzabo::Exception::Driver->throw( error => $self->{dbh}->errstr ) if $self->{dbh}->errstr; } sub DESTROY { my $self = shift; $self->disconnect; } sub disconnect { my $self = shift; $self->{dbh}->disconnect if $self->{dbh}; delete $self->{dbh}; } sub handle { my $self = shift; if (@_) { validate_pos( @_, { isa => 'DBI::db' } ); $self->{dbh} = shift; } return $self->{dbh}; } sub rdbms_version { shift()->_virtual; } sub connect { shift()->_virtual; } sub supports_referential_integrity { shift()->_virtual; } sub create_database { shift()->_virtual; } sub drop_database { shift()->_virtual; } sub next_sequence_number { shift()->_virtual; } sub begin_work { my $self = shift; $self->_ensure_valid_dbh; $self->{tran_count} = 0 unless defined $self->{tran_count}; $self->{dbh}->begin_work if $self->{dbh}->{AutoCommit}; $self->{tran_count}++; } sub rollback { my $self = shift; $self->_ensure_valid_dbh; $self->{tran_count} = undef; eval { $self->{dbh}->rollback unless $self->{dbh}->{AutoCommit} }; Alzabo::Exception::Driver->throw( error => $@ ) if $@; $self->{dbh}->{AutoCommit} = 1; } sub commit { my $self = shift; $self->_ensure_valid_dbh; my $callee = (caller(1))[3]; # More commits than begin_tran. Not correct. if ( defined $self->{tran_count} ) { $self->{tran_count}--; } else { my $caller = (caller(1))[3]; require Carp; Carp::cluck( "$caller called commit without corresponding begin_work call\n" ); } # Don't actually commit until we reach 'uber-commit' return if $self->{tran_count}; unless ( $self->{dbh}->{AutoCommit} ) { $self->{dbh}->commit; } $self->{dbh}->{AutoCommit} = 1; $self->{tran_count} = undef; } sub get_last_id { shift()->_virtual; } sub driver_id { shift()->_virtual; } sub _virtual { my $self = shift; my $sub = (caller(1))[3]; Alzabo::Exception::VirtualMethod->throw( error => "$sub is a virtual method and must be subclassed in " . ref $self ); } package Alzabo::DriverStatement; use strict; use vars qw($VERSION); use Alzabo::Exceptions; use DBI; use Params::Validate qw( validate UNDEF SCALAR ARRAYREF ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = '0.1'; sub new { my $self = shift->new_no_execute(@_); $self->execute; return $self; } use constant NEW_NO_EXECUTE_SPEC => { dbh => { can => 'prepare' }, sql => { type => SCALAR }, bind => { type => SCALAR | ARRAYREF, optional => 1 }, limit => { type => UNDEF | ARRAYREF, optional => 1 }, }; sub new_no_execute { my $proto = shift; my $class = ref $proto || $proto; my %p = validate( @_, NEW_NO_EXECUTE_SPEC ); my $self = bless {}, $class; $self->{limit} = $p{limit} ? $p{limit}[0] : 0; $self->{offset} = $p{limit} && $p{limit}[1] ? $p{limit}[1] : 0; $self->{rows_fetched} = 0; eval { $self->{sth} = $p{dbh}->prepare( $p{sql} ); $self->{bind} = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [ $p{bind} ] ) : []; }; Alzabo::Exception::Driver->throw( error => $@, sql => $p{sql}, bind => $self->{bind} ) if $@; return $self; } sub execute { my $self = shift; eval { $self->{sth}->finish if $self->{sth}->{Active}; $self->{rows_fetched} = 0; $self->{sth}->execute( @_ ? @_ : @{ $self->{bind} } ); $self->{result} = []; $self->{count} = 0; $self->{sth}->bind_columns ( \ ( @{ $self->{result} }[ 0..$#{ $self->{sth}->{NAME_lc} } ] ) ); }; Alzabo::Exception::Driver->throw( error => $@, sql => $self->{sth}{Statement}, bind => $self->{bind} ) if $@; } sub execute_no_result { my $self = shift; eval { $self->{sth}->execute(@_); }; Alzabo::Exception::Driver->throw( error => $@, sql => $self->{sth}{Statement}, bind => $self->{bind} ) if $@; } sub next { my $self = shift; my %p = @_; return unless $self->{sth}->{Active}; my $active; eval { do { $active = $self->{sth}->fetch; } while ( $active && $self->{rows_fetched}++ < $self->{offset} ); }; Alzabo::Exception::Driver->throw( error => $@, sql => $self->{sth}{Statement}, bind => $self->{bind} ) if $@; return unless $active; $self->{count}++; return wantarray ? @{ $self->{result} } : $self->{result}[0]; } sub next_as_hash { my $self = shift; return unless $self->{sth}->{Active}; my $active; eval { do { $active = $self->{sth}->fetch; } while ( $active && $self->{rows_fetched}++ < $self->{offset} ); }; Alzabo::Exception::Driver->throw( error => $@, sql => $self->{sth}{Statement}, bind => $self->{bind} ) if $@; return unless $active; my %hash; @hash{ @{ $self->{sth}->{NAME_lc} } } = @{ $self->{result} }; $self->{count}++; return %hash; } *next_hash = \&next_as_hash; sub all_rows { my $self = shift; my @rows; while (my @row = $self->next) { push @rows, @row > 1 ? \@row : $row[0]; } $self->{count} = scalar @rows; return @rows; } sub all_rows_hash { my $self = shift; my @rows; while (my %h = $self->next_as_hash) { push @rows, \%h; } $self->{count} = scalar @rows; return @rows; } sub bind { my $self = shift; return @{ $self->{bind} }; } sub count { $_[0]->{count} } sub DESTROY { my $self = shift; local $@; eval { $self->{sth}->finish if $self->{sth}; }; Alzabo::Exception::Driver->throw( error => $@ ) if $@; } 1; __END__ =head1 NAME Alzabo::Driver - Alzabo base class for RDBMS drivers =head1 SYNOPSIS use Alzabo::Driver; my $driver = Alzabo::Driver->new( rdbms => 'MySQL', schema => $schema ); =head1 DESCRIPTION This is the base class for all Alzabo::Driver modules. To instantiate a driver call this class's C method. See L for information on how to make a driver for the RDBMS of your choice. This class throws several, exceptions, one of which, C, has additional methods not present in other exception classes. See L for a description of these methods. =head1 METHODS =head2 available Returns a list of names representing the available C subclasses. Any one of these names would be appropriate as the "rdbms" parameter for the Lnew >>|Alzabo::Driver/new> method. =head2 new The constructor takes the following parameters: =over 4 =item * rdbms => $rdbms_name The name of the RDBMS being used. =item * schema => C object =back It returns a new C object of the appropriate subclass. Throws: L|Alzabo::Exceptions> =head2 tables Returns a list of strings containing the names of the tables in the database. See the C documentation of the Ctables> method for more details. Throws: L|Alzabo::Exceptions> =head2 handle ($optional_dbh) This method takes one optional parameter, a connected DBI handle. If this is given, then this handle is the new handle for the driver. It returns the active database handle. Throws: L|Alzabo::Exceptions> =head2 Data Retrieval methods Some of these methods return lists of data (the L|Alzabo::Driver/rows>, L|Alzabo::Driver/rows_hashref>, and L|Alzabo::Driver/column> methods). With large result sets, this can use a lot memory as these lists are created in memory before being returned to the caller. To avoid this, it may be desirable to use the functionality provided by the L|Alzabo::DriverStatement> class, which allows you to fetch results one row at a time. These methods all accept the following parameters: =over 4 =item * sql => $sql_string =item * bind => $bind_value or \@bind_values =item * limit => [ $max, optional $offset ] (optional) The C<$offset> defaults to 0. This parameter has no effect for the methods that return only one row. For the others, it causes the drivers to skip C<$offset> rows and then return only C<$max> rows. This is useful if the RDBMS being used does not support C clauses. =back =head2 rows Returns an array of array references containing the data requested. =head2 rows_hashref Returns an array of hash references containing the data requested. The hash reference keys are the columns being selected. All the key names are in uppercase. =head2 one_row Returns an array or scalar containing the data returned, depending on context. =head2 one_row_hash Returns a hash containing the data requested. The hash keys are the columns being selected. All the key names are in uppercase. =head2 column Returns an array containing the values for the first column of each row returned. =head2 do Use this for non-SELECT SQL statements. Returns the number of rows affected. Throws: L|Alzabo::Exceptions> =head2 statement This methods returns a new L|Alzabo::DriverStatement> handle, ready to return data via the Lnext() >>|Alzabo::DriverStatement/next> or Lnext_as_hash() >>|Alzabo::DriverStatement/next_as_hash> methods. Throws: L|Alzabo::Exceptions> =head2 rdbms_version Returns the version string of the database backend currently in use. The form of this string will vary depending on which driver subclass is being used. =head2 quote (@strings) This methods calls the underlying DBI handles C method on the array of strings provided, and returns the quoted versions. =head2 quote_identifier (@strings) This methods calls the underlying DBI handles C method on the array of strings provided, and returns the quoted versions. =head1 Alzabo::DriverStatement This class is a wrapper around C's statement handles. It finishes automatically as appropriate so the end user does need not worry about doing this. =head2 next Use this method in a while loop to fetch all the data from a statement. Returns an array containing the next row of data for statement or an empty list if no more data is available. Throws: L|Alzabo::Exceptions> =head2 next_as_hash For backwards compatibility, this is also available as C. Returns a hash containing the next row of data for statement or an empty list if no more data is available. All the keys of the hash will be lowercased. Throws: L|Alzabo::Exceptions> =head2 all_rows If the select for which this statement is cursor was for a single column (or aggregate value), then this method returns an array containing each B value from the database. Otherwise, it returns an array of array references, each one containing a returned row from the database. Throws: L|Alzabo::Exceptions> =head2 all_rows_hash Returns an array of hashes, each hash representing a single row returned from the database. The hash keys are all in lowercase. Throws: L|Alzabo::Exceptions> =head2 execute (@bind_values) Executes the associated statement handle with the given bound parameters. If the statement handle is still active (it was previously executed and has more data left) then its C method will be called first. Throws: L|Alzabo::Exceptions> =head2 count Returns the number of rows returned so far. =head1 Alzabo::Exception::Driver METHODS In addition to the methods inherited from L|Exception::Class::Base>, objects in this class also contain several methods specific to this subclass. =head2 sql Returns the SQL statement in use at the time the error occurred, if any. =head2 bind Returns an array reference contaning the bound parameters for the SQL statement, if any. =head1 SUBCLASSING Alzabo::Driver To create a subclass of C for your particular RDBMS is fairly simple. First of all, there must be a C driver for it, as C is built on top of C. Here's a sample header to the module using a fictional RDBMS called FooDB: package Alzabo::Driver::FooDB; use strict; use vars qw($VERSION); use Alzabo::Driver; use DBI; use DBD::FooDB; use base qw(Alzabo::Driver); The next step is to implement a C method and the methods listed under L. The C method should look a bit like this: 1: sub new 2: { 3: my $proto = shift; 4: my $class = ref $proto || $proto; 5: my %p = @_; 6: 7: my $self = bless {}, $class; 8: 9: return $self; 10: } The hash %p contains any values passed to the Cnew> method by its caller. Lines 1-7 should probably be copied verbatim into your own C method. Line 5 can be deleted if you don't need to look at the parameters. Look at the included C subclasses for examples. Feel free to contact me for further help if you get stuck. Please tell me what database you're attempting to implement, what its DBD::* driver is, and include the code you've written so far. =head2 Virtual Methods The following methods are not implemented in C itself and must be implemented in a subclass. =head3 Parameters for connect(), create_database(), and drop_database() =over 4 =item * user => $db_username =item * password => $db_pw =item * host => $hostname =item * port => $port =back All of these default to undef. See the appropriate DBD driver documentation for more details. After the driver is created, it will have access to its associated schema object in C<< $self->{schema} >>. =head2 connect Some drivers may accept or require more arguments than specified above. Note that C subclasses are not expected to cache connections. If you want to do this please use C under mod_perl or don't call C more than once per process. =head2 create_database Attempts to create a new database for the schema attached to the driver. Some drivers may accept or require more arguments than specified above. =head2 drop_database Attempts to drop the database for the schema attached to the driver. =head2 schemas Returns a list of schemas in the specified RDBMS. This method may accept some or all of the parameters which can be given to C. =head2 supports_referential_integrity Should return a boolean value indicating whether or not the RDBMS supports referential integrity constraints. =head2 next_sequence_number (C object) This method is expected to return the value of the next sequence number based on a column object. For some databases (MySQL, for example), the appropriate value is C. This is accounted for in the Alzabo code that calls this method. =head2 begin_work Notify Alzabo that you wish to start a transaction. =head2 rollback Rolls back the current transaction. =head2 commit Notify Alzabo that you wish to finish a transaction. This is basically the equivalent of calling commit. =head2 get_last_id Returns the last primary key id created via a sequenced column. =head2 rdbms_version Returns the version of the server to which the driver is connected. =head2 driver_id Returns the driver's name. This should be something that can be passed to C<< Alzabo::Driver->new() >> as a "name" parameter. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Debug.pm0000444000175000017500000000400510721343227016054 0ustar autarchautarchpackage Alzabo::Debug; use strict; BEGIN { my %constants = ( SQL => 0, TRACE => 0, METHODMAKER => 0, REVERSE_ENGINEER => 0, ); if ( $ENV{ALZABO_DEBUG} ) { my %debug = map { uc $_ => 1 } split /\|/, $ENV{ALZABO_DEBUG}; if ( $debug{ALL} ) { @constants{ keys %constants } = (1) x keys %constants; } else { foreach ( grep { exists $constants{$_} } keys %debug ) { $constants{$_} = $debug{$_} ? 1 : 0; } } } while ( my ($k, $v) = each %constants ) { eval "use constant $k => $v"; die $@ if $@; } } 1; __END__ =head1 NAME Alzabo::Debug - Creates constants used to turn on debugging =head1 SYNOPSIS export ALZABO_DEBUG='SQL|TRACE' ... load and run code using Alzabo ... export ALZABO_DEBUG=METHODMAKER ... load and run code using Alzabo ... =head1 DESCRIPTION This module creates constants used by other modules in order to determine what debugging output should be generated. The interface is currently experimental. =head1 USAGE Currently, the only way to turn on debugging is by setting the C environment variable. This variable can contain various flags, each separated by a pipe char (|). Each flag turns on different types of debugging output. These flags B, as debugging is turned on or off through the use of constants. The current flags are: =over 4 =item * SQL Generated SQL and its associated bound variables. =item * TRACE A stack trace will be generated any time SQL is generated. =item * METHODMAKER The C module will generate verbose output describing the methods it is creating. =item * REVERSE_ENGINEER The modules involved in reverse-engineering will generate output describing what it finds during reverse-engineering. =item * ALL Turn on all flags. =back For now, all debugging output is sent to C. =cut Alzabo-0.92/lib/Alzabo/SQLMaker.pm0000444000175000017500000010773610721343227016464 0ustar autarchautarchpackage Alzabo::SQLMaker; use strict; use vars qw($VERSION $AUTOLOAD); use Alzabo::Exceptions; use Alzabo::Utils; use Class::Factory::Util; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; 1; sub make_function { my $class = caller; my %p = validate( @_, { function => { type => SCALAR }, min => { type => SCALAR, optional => 1 }, max => { type => UNDEF | SCALAR, optional => 1 }, groups => { type => ARRAYREF }, quote => { type => ARRAYREF, optional => 1 }, format => { type => SCALAR, optional => 1 }, is_modifier => { type => SCALAR, default => 0 }, has_spaces => { type => SCALAR, default => 0 }, allows_alias => { type => SCALAR, default => 1 }, no_parens => { type => SCALAR, default => 0 }, } ); my $valid = ''; if ( $p{min} || $p{max} ) { $valid .= 'validate_pos( @_, '; $valid .= join ', ', ('1') x $p{min}; } if ( defined $p{min} && defined $p{max} && $p{max} > $p{min} ) { $valid .= ', '; $valid .= join ', ', ('0') x ( $p{max} - $p{min} ); } elsif ( exists $p{min} && ! defined $p{max} ) { $valid .= ", ('1') x (\@_ - $p{min})"; } $valid .= ' );' if $valid; my @args = "function => '$p{function}'"; if ( ! defined $p{max} || $p{max} > 0 ) { push @args, ' args => [@_]'; } if ( $p{format} ) { push @args, " format => '$p{format}'"; } if ( $p{quote} ) { my $quote .= ' quote => ['; $quote .= join ', ', @{ $p{quote} }; $quote .= ']'; push @args, $quote; } for my $k ( qw( is_modifier has_spaces allows_alias no_parens ) ) { if ( $p{$k} ) { push @args, " $k => 1"; } } my $args = join ",\n", @args; my $code = <<"EOF"; sub ${class}::$p{function} { shift if defined \$_[0] && Alzabo::Utils::safe_isa( \$_[0], 'Alzabo::SQLMaker' ); $valid return Alzabo::SQLMaker::Function->new( $args ); } EOF eval $code; { no strict 'refs'; push @{ "$class\::EXPORT_OK" }, $p{function}; my $exp = \%{ "$class\::EXPORT_TAGS" }; foreach ( @{ $p{groups} } ) { push @{ $exp->{$_} }, $p{function}; } push @{ $exp->{all} }, $p{function}; } } sub load { shift; my %p = @_; my $class = "Alzabo::SQLMaker::$p{rdbms}"; eval "use $class"; Alzabo::Exception::Eval->throw( error => $@ ) if $@; $class->init(@_); return $class; } sub available { __PACKAGE__->subclasses } sub init { 1; } use constant NEW_SPEC => { driver => { isa => 'Alzabo::Driver' }, quote_identifiers => { type => BOOLEAN, default => 0 }, }; sub new { my $class = shift; my %p = validate( @_, NEW_SPEC ); return bless { last_op => undef, expect => undef, type => undef, sql => '', bind => [], placeholders => [], as_id => 'aaaaa10000', alias_in_having => 1, %p, }, $class; } # this just needs to be some unique thing that won't ever look like a # valid bound parameter my $placeholder = do { my $x = 1; bless \$x, 'Alzabo::SQLMaker::Placeholder' }; sub placeholder { $placeholder } sub last_op { return shift->{last_op}; } sub select { my $self = shift; Alzabo::Exception::Params->throw( error => "The select method requires at least one parameter" ) unless @_; $self->{sql} .= 'SELECT '; if ( lc $_[0] eq 'distinct' ) { $self->{sql} .= ' DISTINCT '; shift; } my @sql; foreach my $elt (@_) { if ( Alzabo::Utils::safe_can( $elt, 'table' ) ) { my $table = $elt->table; $self->{column_tables}{"$table"} = 1; my $sql = ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier ( $table->alias_name, $elt->name ) : $table->alias_name . '.' . $elt->name ); $sql .= ' AS ' . ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $elt->alias_name ) : $elt->alias_name ); push @sql, $sql; } elsif ( Alzabo::Utils::safe_can( $elt, 'columns' ) ) { $self->{column_tables}{"$elt"} = 1; my @cols; foreach my $col ( $elt->columns ) { my $sql = ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier ( $elt->alias_name, $col->name ) : $elt->alias_name . '.' . $col->name ); $sql .= ' AS ' . ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $elt->alias_name ) : $elt->alias_name ); push @cols, $sql; } push @sql, join ', ', @cols; } elsif ( Alzabo::Utils::safe_isa( $elt, 'Alzabo::SQLMaker::Function' ) ) { my $string = $elt->as_string( $self->{driver}, $self->{quote_identifiers} ); if ( $elt->allows_alias ) { push @sql, " $string AS " . $self->{as_id}; $self->{functions}{$string} = $self->{as_id}; ++$self->{as_id}; } else { push @sql, $string; } } elsif ( ! ref $elt ) { push @sql, $elt; } else { Alzabo::Exception::SQL->throw ( error => 'Arguments to select must be either column objects,' . ' table objects, function objects, or plain scalars' ); } } $self->{sql} .= join ', ', @sql; $self->{type} = 'select'; $self->{last_op} = 'select'; return $self; } sub from { my $self = shift; $self->_assert_last_op( qw( select delete function ) ); my $spec = $self->{last_op} eq 'select' ? { type => OBJECT | ARRAYREF } : { can => 'alias_name' }; validate_pos( @_, ( $spec ) x @_ ); $self->{sql} .= ' FROM '; if ( $self->{last_op} eq 'delete' ) { $self->{sql} .= join ', ', map { ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $_->name ) : $_->name ) } @_; $self->{tables} = { map { $_ => 1 } @_ }; } else { my $sql; $self->{tables} = {}; my @plain; foreach my $elt (@_) { if ( Alzabo::Utils::is_arrayref($elt) ) { $sql .= ' ' if $sql; $sql .= $self->_outer_join(@$elt); } else { push @plain, $elt; } } foreach my $elt ( grep { ! exists $self->{tables}{$_ } } @plain ) { $sql .= ', ' if $sql; if ( $self->{quote_identifiers} ) { $sql .= ( $self->{driver}->quote_identifier( $elt->name ) . ' AS ' . $self->{driver}->quote_identifier( $elt->alias_name ) ); } else { $sql .= $elt->name . ' AS ' . $elt->alias_name; } $self->{tables}{$elt} = 1; } $self->{sql} .= $sql; } if ($self->{type} eq 'select') { foreach my $t ( keys %{ $self->{column_tables} } ) { unless ( $self->{tables}{$t} ) { my $err = 'Cannot select column '; $err .= 'unless its table is included in the FROM clause'; Alzabo::Exception::SQL->throw( error => $err ); } } } $self->{last_op} = 'from'; return $self; } use constant _OUTER_JOIN_SPEC => ( { type => SCALAR }, ( { can => 'alias_name' } ) x 2, { type => UNDEF | ARRAYREF | OBJECT, optional => 1 }, { type => UNDEF | ARRAYREF, optional => 1 }, ); sub _outer_join { my $self = shift; my $tables = @_ - 1; validate_pos( @_, _OUTER_JOIN_SPEC ); my $type = uc shift; my $join_from = shift; my $join_on = shift; my $fk; $fk = shift if $_[0] && Alzabo::Utils::safe_isa( $_[0], 'Alzabo::ForeignKey' ); my $where = shift; unless ($fk) { my @fk = $join_from->foreign_keys_by_table($join_on); Alzabo::Exception::Params->throw( error => "The " . $join_from->name . " table has no foreign keys to the " . $join_on->name . " table" ) unless @fk; Alzabo::Exception::Params->throw( error => "The " . $join_from->name . " table has more than 1 foreign key to the " . $join_on->name . " table" ) if @fk > 1; $fk = $fk[0]; } my $sql; unless ( $self->{tables}{$join_from} ) { $sql .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $join_from->name ) : $join_from->name ); $sql .= ' AS '; $sql .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $join_from->alias_name ) : $join_from->alias_name ); } $sql .= " $type OUTER JOIN "; $sql .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $join_on->name ) : $join_on->name ); $sql .= ' AS '; $sql .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $join_on->alias_name ) : $join_on->alias_name ); $sql .= ' ON '; if ( $self->{quote_identifiers} ) { $sql .= ( join ' AND ', map { $self->{driver}->quote_identifier ( $join_from->alias_name, $_->[0]->name ) . ' = ' . $self->{driver}->quote_identifier ( $join_on->alias_name, $_->[1]->name ) } $fk->column_pairs ); } else { $sql .= ( join ' AND ', map { $join_from->alias_name . '.' . $_->[0]->name . ' = ' . $join_on->alias_name . '.' . $_->[1]->name } $fk->column_pairs ); } @{ $self->{tables} }{ $join_from, $join_on } = (1, 1); if ($where) { $sql .= ' AND '; # make a clone my $sql_maker = bless { %$self }, ref $self; $sql_maker->{sql} = ''; # sharing same ref intentionally $sql_maker->{bind} = $self->{bind}; $sql_maker->{tables} = $self->{tables}; # lie to Alzabo::Runtime::process_where_clause $sql_maker->{last_op} = 'where'; Alzabo::Runtime::process_where_clause( $sql_maker, $where ); $sql .= $sql_maker->sql; $sql .= ' '; $self->{as_id} = $sql_maker->{as_id}; } return $sql; } sub where { my $self = shift; $self->_assert_last_op( qw( from set ) ); $self->{sql} .= ' WHERE '; $self->{last_op} = 'where'; $self->condition(@_) if @_; return $self; } sub having { my $self = shift; $self->_assert_last_op( qw( group_by ) ); $self->{sql} .= ' HAVING '; $self->{last_op} = 'having'; $self->condition(@_) if @_; return $self; } sub and { my $self = shift; $self->_assert_last_op( qw( subgroup_end condition ) ); return $self->_and_or( 'and', @_ ); } sub or { my $self = shift; $self->_assert_last_op( qw( subgroup_end condition ) ); return $self->_and_or( 'or', @_ ); } sub _and_or { my $self = shift; my $op = shift; $self->{sql} .= " \U$op "; $self->{last_op} = $op; $self->condition(@_) if @_; return $self; } sub subgroup_start { my $self = shift; $self->_assert_last_op( qw( where having and or subgroup_start ) ); $self->{sql} .= ' ('; $self->{subgroup} ||= 0; $self->{subgroup}++; $self->{last_op} = 'subgroup_start'; return $self; } sub subgroup_end { my $self = shift; $self->_assert_last_op( qw( condition subgroup_end ) ); Alzabo::Exception::SQL->throw( error => "Can't end a subgroup unless one has been started already" ) unless $self->{subgroup}; $self->{sql} .= ' )'; $self->{subgroup}--; $self->{last_op} = $self->{subgroup} ? 'subgroup_end' : 'condition'; return $self; } sub condition { my $self = shift; validate_pos( @_, { type => OBJECT }, { type => SCALAR }, { type => UNDEF | SCALAR | OBJECT }, ( { type => UNDEF | SCALAR | OBJECT, optional => 1 } ) x (@_ - 3) ); my $lhs = shift; my $comp = uc shift; my $rhs = shift; my $in_having = $self->{last_op} eq 'having' ? 1 : 0; $self->{last_op} = 'condition'; if ( $lhs->can('table') && $lhs->can('name') ) { unless ( $self->{tables}{ $lhs->table } ) { my $err = 'Cannot use column ('; $err .= join '.', $lhs->table->name, $lhs->name; $err .= ") in $self->{type} unless its table is included in the "; $err .= $self->{type} eq 'update' ? 'UPDATE' : 'FROM'; $err .= ' clause'; Alzabo::Exception::SQL->throw( error => $err ); } $self->{sql} .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $lhs->table->alias_name, $lhs->name ) : $lhs->table->alias_name . '.' . $lhs->name ); } elsif ( $lhs->isa('Alzabo::SQLMaker::Function') ) { my $string = $lhs->as_string( $self->{driver}, $self->{quote_identifiers} ); if ( exists $self->{functions}{$string} && ( ! $in_having || $self->{alias_in_having} ) ) { $self->{sql} .= $self->{functions}{$string}; } else { $self->{sql} .= $string; } } else { Alzabo::Exception::SQL->throw ( error => "Cannot use " . (ref $lhs) . " object as part of condition" ); } if ( $comp eq 'BETWEEN' ) { Alzabo::Exception::SQL->throw ( error => "The BETWEEN comparison operator requires an additional argument" ) unless @_ == 1; my $rhs2 = shift; Alzabo::Exception::SQL->throw ( error => "The BETWEEN comparison operator cannot accept a subselect" ) if grep { Alzabo::Utils::safe_isa( $_, 'Alzabo::SQLMaker' ) } $rhs, $rhs2; $self->{sql} .= ' BETWEEN '; $self->{sql} .= $self->_rhs($rhs); $self->{sql} .= " AND "; $self->{sql} .= $self->_rhs($rhs2); return; } if ( $comp eq 'IN' || $comp eq 'NOT IN' ) { $self->{sql} .= " $comp ("; $self->{sql} .= join ', ', map { Alzabo::Utils::safe_isa( $_, 'Alzabo::SQLMaker' ) ? '(' . $self->_subselect($_) . ')' : $self->_rhs($_) } $rhs, @_; $self->{sql} .= ')'; return; } Alzabo::Exception::Params->throw ( error => 'Too many parameters to Alzabo::SQLMaker->condition method' ) if @_; if ( ! ref $rhs && defined $rhs ) { $self->{sql} .= " $comp "; $self->{sql} .= $self->_rhs($rhs); } elsif ( ! defined $rhs ) { if ( $comp eq '=' ) { $self->{sql} .= ' IS NULL'; } elsif ( $comp eq '!=' || $comp eq '<>' ) { $self->{sql} .= ' IS NOT NULL'; } else { Alzabo::Exception::SQL->throw ( error => "Cannot compare a column to a NULL with '$comp'" ); } } elsif ( ref $rhs ) { $self->{sql} .= " $comp "; if( $rhs->isa('Alzabo::SQLMaker') ) { $self->{sql} .= '('; $self->{sql} .= $self->_subselect($rhs); $self->{sql} .= ')'; } else { $self->{sql} .= $self->_rhs($rhs); } } } sub _rhs { my $self = shift; my $rhs = shift; if ( Alzabo::Utils::safe_can( $rhs, 'table' ) ) { unless ( $self->{tables}{ $rhs->table } ) { my $err = 'Cannot use column ('; $err .= join '.', $rhs->table->name, $rhs->name; $err .= ") in $self->{type} unless its table is included in the "; $err .= $self->{type} eq 'update' ? 'UPDATE' : 'FROM'; $err .= ' clause'; Alzabo::Exception::SQL->throw( error => $err ); } return ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $rhs->table->alias_name, $rhs->name ) : $rhs->table->alias_name . '.' . $rhs->name ); } else { return $self->_bind_val($rhs); } } sub _subselect { my $self = shift; my $sql = shift; push @{ $self->{bind} }, @{ $sql->bind }; return $sql->sql; } sub order_by { my $self = shift; $self->_assert_last_op( qw( select from condition group_by ) ); Alzabo::Exception::SQL->throw ( error => "Cannot use order by in a '$self->{type}' statement" ) unless $self->{type} eq 'select'; validate_pos( @_, ( { type => SCALAR | OBJECT, callbacks => { 'column_or_function_or_sort' => sub { Alzabo::Utils::safe_can( $_[0], 'table' ) || Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' ) || $_[0] =~ /^(?:ASC|DESC)$/i } } } ) x @_ ); $self->{sql} .= ' ORDER BY '; my $x = 0; my $last = ''; foreach my $i (@_) { if ( Alzabo::Utils::safe_can( $i, 'table' ) ) { unless ( $self->{tables}{ $i->table } ) { my $err = 'Cannot use column ('; $err .= join '.', $i->table->name, $i->name; $err .= ") in $self->{type} unless its table is included in the FROM clause"; Alzabo::Exception::SQL->throw( error => $err ); } # no comma needed for first column $self->{sql} .= ', ', if $x++; $self->{sql} .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $i->table->alias_name, $i->alias_name ) : $i->table->alias_name . '.' . $i->alias_name ); $last = 'column'; } elsif ( Alzabo::Utils::safe_isa( $i, 'Alzabo::SQLMaker::Function' ) ) { my $string = $i->as_string( $self->{driver}, $self->{quote_identifiers} ); if ( exists $self->{functions}{$string} ) { $self->{sql} .= ', ', if $x++; $self->{sql} .= $self->{functions}{$string}; } else { $self->{sql} .= ', ', if $x++; $self->{sql} .= $string; } $last = 'function'; } else { Alzabo::Exception::Params->throw ( error => 'A sort specifier cannot follow another sort specifier in an ORDER BY clause' ) if $last eq 'sort'; $self->{sql} .= " \U$i"; $last = 'sort'; } } $self->{last_op} = 'order_by'; return $self; } sub group_by { my $self = shift; $self->_assert_last_op( qw( select from condition ) ); Alzabo::Exception::SQL->throw ( error => "Cannot use group by in a '$self->{type}' statement" ) unless $self->{type} eq 'select'; validate_pos( @_, ( { can => 'table' } ) x @_ ); foreach my $c (@_) { unless ( $self->{tables}{ $c->table } ) { my $err = 'Cannot use column ('; $err .= join '.', $c->table->name, $c->name; $err .= ") in $self->{type} unless its table is included in the FROM clause"; Alzabo::Exception::SQL->throw( error => $err ); } } $self->{sql} .= ' GROUP BY '; $self->{sql} .= ( join ', ', map { ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $_->table->alias_name, $_->alias_name ) : $_->table->alias_name . '.' . $_->alias_name ) } @_ ); $self->{last_op} = 'group_by'; return $self; } sub insert { my $self = shift; $self->{sql} .= 'INSERT '; $self->{type} = 'insert'; $self->{last_op} = 'insert'; return $self; } sub into { my $self = shift; $self->_assert_last_op( qw( insert ) ); validate_pos( @_, { can => 'alias_name' }, ( { can => 'table' } ) x (@_ - 1) ); my $table = shift; $self->{tables} = { $table => 1 }; foreach my $c (@_) { unless ( $c->table eq $table ) { my $err = 'Cannot into column ('; $err .= join '.', $c->table->name, $c->name; $err .= ') because its table was not the one specified in the INTO clause'; Alzabo::Exception::SQL->throw( error => $err ); } } $self->{columns} = [ @_ ? @_ : $table->columns ]; $self->{sql} .= 'INTO '; $self->{sql} .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $table->name ) : $table->name ); $self->{sql} .= ' ('; $self->{sql} .= ( join ', ', map { ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $_->name ) : $_->name ) } @{ $self->{columns} } ); $self->{sql} .= ') '; $self->{last_op} = 'into'; return $self; } sub values { my $self = shift; $self->_assert_last_op( qw( into ) ); validate_pos( @_, ( { type => UNDEF | SCALAR | OBJECT } ) x @_ ); if ( ref $_[0] && $_[0]->isa('Alzabo::SQLMaker') ) { $self->{sql} = $_[0]->sql; push @{ $self->{bind} }, $_[0]->bind; } else { my @vals = @_; Alzabo::Exception::Params->throw ( error => "'values' method expects key/value pairs of column objects and values'" ) if !@vals || @vals % 2; my %vals = map { ref $_ && $_->can('table') ? $_->name : $_ } @vals; foreach my $c ( @vals[ map { $_ * 2 } 0 .. int($#vals/2) ] ) { Alzabo::Exception::SQL->throw ( error => $c->name . " column was not specified in the into method call" ) unless grep { $c eq $_ } @{ $self->{columns} }; } foreach my $c ( @{ $self->{columns } } ) { Alzabo::Exception::SQL->throw ( error => $c->name . " was specified in the into method call but no value was provided" ) unless exists $vals{ $c->name }; } $self->{sql} .= 'VALUES ('; $self->{sql} .= join ', ', ( map { $self->_bind_val_for_insert( $_, $vals{ $_->name } ) } @{ $self->{columns} } ); $self->{sql} .= ')'; } if ( @{ $self->{placeholders} } && @{ $self->{bind} } ) { Alzabo::Exception::SQL->throw ( error => "Cannot mix actual bound values and placeholders in call to values()" ); } $self->{last_op} = 'values'; return $self; } use constant UPDATE_SPEC => { can => 'alias_name' }; sub update { my $self = shift; validate_pos( @_, UPDATE_SPEC ); my $table = shift; $self->{sql} = 'UPDATE '; $self->{sql} .= ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $table->name ) : $table->name ); $self->{tables} = { $table => 1 }; $self->{type} = 'update'; $self->{last_op} = 'update'; return $self; } sub set { my $self = shift; my @vals = @_; $self->_assert_last_op('update'); Alzabo::Exception::Params->throw ( error => "'set' method expects key/value pairs of column objects and values'" ) if !@vals || @vals % 2; validate_pos( @_, ( { can => 'table' }, { type => UNDEF | SCALAR | OBJECT } ) x (@vals / 2) ); $self->{sql} .= ' SET '; my @set; my $table = ( keys %{ $self->{tables} } )[0]; while ( my ($col, $val) = splice @vals, 0, 2 ) { unless ( $table eq $col->table ) { my $err = 'Cannot set column ('; $err .= join '.', $col->table->name, $col->name; $err .= ') unless its table is included in the UPDATE clause'; Alzabo::Exception::SQL->throw( error => $err ); } push @set, ( $self->{quote_identifiers} ? $self->{driver}->quote_identifier( $col->name ) : $col->name ) . ' = ' . $self->_bind_val($val); } $self->{sql} .= join ', ', @set; $self->{last_op} = 'set'; return $self; } sub delete { my $self = shift; $self->{sql} .= 'DELETE '; $self->{type} = 'delete'; $self->{last_op} = 'delete'; return $self; } sub _assert_last_op { my $self = shift; unless ( grep { $self->{last_op} eq $_ } @_ ) { my $op = (caller(1))[3]; $op =~ s/.*::(.*?)$/$1/; Alzabo::Exception::SQL->throw( error => "Cannot follow $self->{last_op} with $op" ); } } use constant _BIND_VAL_FOR_INSERT_SPEC => ( { isa => 'Alzabo::Runtime::Column' }, { type => UNDEF | SCALAR | OBJECT } ); sub _bind_val_for_insert { my $self = shift; my ( $col, $val ) = validate_pos( @_, _BIND_VAL_FOR_INSERT_SPEC ); if ( defined $val && $val eq $placeholder ) { push @{ $self->{placeholders} }, $col->name; return '?'; } else { return $self->_bind_val($val); } } use constant _BIND_VAL_SPEC => { type => UNDEF | SCALAR | OBJECT }; sub _bind_val { my $self = shift; validate_pos( @_, _BIND_VAL_SPEC ); return $_[0]->as_string( $self->{driver}, $self->{quote_identifiers} ) if Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' ); push @{ $self->{bind} }, $_[0]; return '?'; } sub sql { my $self = shift; Alzabo::Exception::SQL->throw( error => "SQL contains unbalanced parentheses subgrouping: $self->{sql}" ) if $self->{subgroup}; return $self->{sql}; } sub bind { my $self = shift; return $self->{bind}; } sub placeholders { my $self = shift; my $x = 0; return map { $_ => $x++ } @{ $self->{placeholders} }; } sub limit { shift()->_virtual; } sub get_limit { shift()->_virtual; } sub sqlmaker_id { shift()->_virtual; } sub distinct_requires_order_by_in_select { 0 } sub _virtual { my $self = shift; my $sub = (caller(1))[3]; $sub =~ s/.*::(.*?)$/$1/; Alzabo::Exception::VirtualMethod->throw( error => "$sub is a virtual method and must be subclassed in " . ref $self ); } sub debug { my $self = shift; my $fh = shift; print $fh '-' x 75 . "\n"; print $fh "SQL\n - " . $self->sql . "\n"; print $fh "Bound values\n"; foreach my $b ( @{ $self->bind } ) { my $out = $b; if ( defined $out ) { if ( length $out > 75 ) { $out = substr( $out, 0, 71 ) . ' ...'; } } else { $out = 'NULL'; } print $fh " - [$out]\n"; } } package Alzabo::SQLMaker::Function; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); sub new { my $class = shift; my %p = @_; $p{args} = [] unless defined $p{args}; $p{quote} ||= []; return bless \%p, $class; } sub allows_alias { shift->{allows_alias} } sub as_string { my $self = shift; my $driver = shift; my $quote = shift; my @args; foreach ( 0..$#{ $self->{args} } ) { if ( Alzabo::Utils::safe_can( $self->{args}[$_], 'table' ) ) { push @args, ( $quote ? $driver->quote_identifier( $self->{args}[$_]->table->alias_name, $self->{args}[$_]->name ) : $self->{args}[$_]->table->alias_name . '.' . $self->{args}[$_]->name ); next; } elsif ( Alzabo::Utils::safe_isa( $self->{args}[$_], 'Alzabo::SQLMaker::Function' ) ) { push @args, $self->{args}[$_]->as_string( $driver, $quote ); next; } # if there are more args than specified in the quote param # then this function must allow an unlimited number of # arguments, in which case the last value in the quote param # is the value that should be used for all of the extra # arguments. my $i = $_ > $#{ $self->{quote} } ? -1 : $_; push @args, $self->{quote}[$i] ? $driver->quote( $self->{args}[$_] ) : $self->{args}[$_]; } my $sql = $self->{function}; $sql =~ s/_/ /g if $self->{has_spaces}; return $sql if $self->{is_modifier}; $sql .= '(' unless $self->{no_parens}; if ( $self->{format} ) { $sql .= sprintf( $self->{format}, @args ); } else { $sql .= join ', ', @args; } $sql .= ')' unless $self->{no_parens}; return $sql; } __END__ =head1 NAME Alzabo::SQLMaker - Alzabo base class for RDBMS drivers =head1 SYNOPSIS use Alzabo::SQLMaker::MySQL; my $sql = Alzabo::SQLMaker::MySQL->new( driver => $driver_object ); # or better yet my $sql = $runtime_schema->sqlmaker; =head1 DESCRIPTION This is the base class for all Alzabo::SQLMaker modules. To instantiate a driver call this class's C method. See L for information on how to make a driver for the RDBMS of your choice. =head1 METHODS =head2 available Returns A list of names representing the available C subclasses. Any one of these names would be appropriate as a parameter for the Lload() >>|"load"> method. =head2 load Load the specified subclass. This takes one parameter, the name of the RDBMS being used. Throws: L|Alzabo::Exceptions> =head2 new This takes two parameters: =over 4 =item * driver The driver object being used by the schema. =item * quote_identifiers A boolean value indicating whether or not identifiers should be quoted. This defaults to false. =back =head1 GENERATING SQL This class can be used to generate SQL by calling methods that are the same as those used in SQL (C, C, etc.) in sequence, with the appropriate parameters. There are four entry point methods, L|"select (Alzabo::Table and/or Alzabo::Column objects)">, L|"insert">, L|"update (Alzabo::Table)">, and L|"delete">. Attempting to call any other method without first calling one of these is an error. =head2 Entry Points These methods are called as class methods and return a new object. =head2 select (C and/or C objects) This begins a select. The columns to be selected are the column(s) passed in, and/or the columns of the table(s) passed in as arguments. Followed by: =over 4 L|"from (Alzabo::Table object, ...)"> L|"** function (Alzabo::Table object(s) and/or $string(s))"> =back =head2 insert Followed by: =over 4 L|"into (Alzabo::Table object, optional Alzabo::Column objects)"> =back =head2 update (C) Followed by: =over 4 L|"set (Alzabo::Column object =E $value, ...)"> =back =head2 delete Followed by: =over 4 L|"from (Alzabo::Table object, ...)"> =back =head2 Other Methods All of these methods return the object itself, making it possible to chain together method calls such as: Alzabo::SQLMaker->select($column)->from($table)->where($other_column, '>', 2); =head2 from (C object, ...) The table(s) from which we are selecting data. Follows: =over 4 L|"select (Alzabo::Table and/or Alzabo::Column objects)"> L|"** function (Alzabo::Table object(s) and/or $string(s))"> L|"delete"> =back Followed by: =over 4 L|"where "> L|"order_by (Alzabo::Column objects)"> =back Throws: L|Alzabo::Exceptions> =head2 where The first parameter to where must be an C object or SQL function. The second is a comparison operator of some sort, given as a string. The third argument can be an C object, a value (a number or string), or an C object. The latter is treated as a subselect. Values given as parameters will be properly quoted and escaped. Some comparison operators allow additional parameters. The C comparison operator requires a fourth argument. This must be either an C object or a value. The C and operators allow any number of additional parameters, which may be C objects, values, or C objects. Follows: =over 4 L|"from (Alzabo::Table object, ...)"> =back Followed by: =over 4 L|"and (same as where)"> L|"or (same as where)"> L|"order_by (Alzabo::Column objects)"> =back Throws: L|Alzabo::Exceptions> =head2 and (same as C) =head2 or (same as C) These methods take the same parameters as the L|"where "> method. Follows: =over 4 L|"where "> L|"and (same as where)"> L|"or (same as where)"> =back Followed by: =over 4 L|"and (same as where)"> L|"or (same as where)"> L|"order_by (Alzabo::Column objects)"> =back Throws: L|Alzabo::Exceptions> =head2 order_by (C objects) Adds an C clause to your SQL. Follows: =over 4 L|"from (Alzabo::Table object, ...)"> L|"where "> L|"and (same as where)"> L|"or (same as where)"> =back Followed by: =over 4 L|"limit ($max, optional $offset)"> =back Throws: L|Alzabo::Exceptions> =head2 limit ($max, optional $offset) Specifies a limit on the number of rows to be returned. The offset parameter is optional. Follows: =over 4 L|"from (Alzabo::Table object, ...)"> L|"where "> L|"and (same as where)"> L|"or (same as where)"> L|"order_by (Alzabo::Column objects)"> =back =over 4 L|Alzabo::Exceptions> =back =head2 into (C object, optional C objects) Used to specify what table an insert is into. If column objects are given then it is expected that values will only be given for that object. Otherwise, it assumed that all columns will be specified in the L|"values (Alzabo::Column object =E $value, ...)"> method. Follows: =over 4 L|"insert"> =back Followed by: =over 4 L|"values (Alzabo::Column object =E $value, ...)"> =back Throws: L|Alzabo::Exceptions> =head2 values (C object => $value, ...) This method expects to recive an structured like a hash where the keys are C objects and the values are the value to be inserted into that column. Follows: =over 4 L|"into (Alzabo::Table object, optional Alzabo::Column objects)"> =back Throws: L|Alzabo::Exceptions> =head2 set (C object => $value, ...) This method'a parameter are exactly like those given to the L|values ( Alzabo::Column object =E $value, ... )> method. Follows: =over 4 L|"update (Alzabo::Table)"> =back Followed by: =over 4 L|"where "> =back Throws: L|Alzabo::Exceptions> =head1 RETRIEVING SQL FROM THE OBJECT =head2 sql This method can be called at any time, though obviously it will not return valid SQL unless called at a natural end point. In the future, an exception may be thrown if called when the SQL is not in a valid state. Returns the SQL generated so far as a string. =head2 bind Returns an array reference containing the parameters to be bound to the SQL statement. =head1 SUBCLASSING Alzabo::SQLMaker To create a subclass of C for your particular RDBMS requires only that the L listed below be implemented. In addition, you may choose to override any of the other methods described in this documentation. For example, the MySQL subclass override the L|"_subselect"> method because MySQL cannot support sub-selects. Subclasses are also expected to offer for export various sets of functions matching SQL functions. See the C subclass implementation for details. =head1 VIRTUAL METHODS The following methods must be implemented by the subclass: =head2 limit See above for the definition of this method. =head2 get_limit This method may return C even if the L|"limit ($max, optional $offset)"> method was called. Some RDBMS's have special SQL syntax for C clauses. For those that don't support this, the L|Alzabo::Driver> module takes a "limit" parameter. The return value of this method can be passed in as that parameter. If the RDBMS does not support C clauses, the return value is an array reference containing two values, the maximum number of rows allowed and the row offset (the first row that should be used). If the RDBMS does support C clauses, then the return value is C. =head2 sqlmaker_id Returns the subclass's name. This should be something that can be passed to C<< Alzabo::SQLMaker->load() >> as a parameter. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/0000755000175000017500000000000010721343227016116 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/Runtime/ColumnDefinition.pm0000444000175000017500000000072710721343227021726 0ustar autarchautarchpackage Alzabo::Runtime::ColumnDefinition; use strict; use vars qw($VERSION); use Alzabo::Runtime; use base qw(Alzabo::ColumnDefinition); $VERSION = 2.0; 1; __END__ =head1 NAME Alzabo::Runtime::ColumnDefinition - Column definition objects =head1 SYNOPSIS use Alzabo::Runtime::ColumnDefinition; =for pod_merge DESCRIPTION =head1 INHERITS FROM C =for pod_merge merged =for pod_merge METHODS Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/Schema.pm0000444000175000017500000007661710721343227017673 0ustar autarchautarchpackage Alzabo::Runtime::Schema; use strict; use vars qw($VERSION); use Alzabo::Exceptions ( abbr => [ qw( logic_exception params_exception ) ] ); use Alzabo::Runtime; use Alzabo::Utils; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { params_exception join '', @_ } ); use base qw(Alzabo::Schema); $VERSION = 2.0; 1; sub load_from_file { my $class = shift; my $self = $class->_load_from_file(@_); $self->prefetch_all_but_blobs; return $self; } sub _schema_file_type { return 'runtime'; } sub user { my $self = shift; return $self->{user}; } sub password { my $self = shift; return $self->{password}; } sub host { my $self = shift; return $self->{host}; } sub port { my $self = shift; return $self->{port}; } sub referential_integrity { my $self = shift; return defined $self->{maintain_integrity} ? $self->{maintain_integrity} : 0; } sub set_db_schema_name { my $self = shift; $self->{db_schema_name} = shift; } sub set_user { my $self = shift; $self->{user} = shift; } sub set_password { my $self = shift; $self->{password} = shift; } sub set_host { my $self = shift; $self->{host} = shift; } sub set_port { my $self = shift; $self->{port} = shift; } sub set_referential_integrity { my $self = shift; my $val = shift; $self->{maintain_integrity} = $val if defined $val; } sub set_quote_identifiers { my $self = shift; my $val = shift; $self->{quote_identifiers} = $val if defined $val; } sub connect { my $self = shift; my %p; $p{user} = $self->user if defined $self->user; $p{password} = $self->password if defined $self->password; $p{host} = $self->host if defined $self->host; $p{port} = $self->port if defined $self->port; $self->driver->connect( %p, @_ ); # $self->set_referential_integrity( ! $self->driver->supports_referential_integrity ); } sub disconnect { my $self = shift; $self->driver->disconnect; } sub one_row { # could be replaced with something potentially more efficient return shift->join(@_)->next; } use constant JOIN_SPEC => { join => { type => ARRAYREF | OBJECT, optional => 1 }, tables => { type => ARRAYREF | OBJECT, optional => 1 }, select => { type => ARRAYREF | OBJECT, optional => 1 }, where => { type => ARRAYREF, optional => 1 }, order_by => { type => ARRAYREF | HASHREF | OBJECT, optional => 1 }, limit => { type => SCALAR | ARRAYREF, optional => 1 }, distinct => { type => ARRAYREF | OBJECT, optional => 1 }, quote_identifiers => { type => BOOLEAN, optional => 1 }, }; sub join { my $self = shift; my %p = validate( @_, JOIN_SPEC ); $p{join} ||= delete $p{tables}; $p{join} = [ $p{join} ] unless Alzabo::Utils::is_arrayref( $p{join} ); my @tables; if ( Alzabo::Utils::is_arrayref( $p{join}->[0] ) ) { # flattens the nested structure and produces a unique set of # tables @tables = values %{ { map { $_ => $_ } grep { Alzabo::Utils::safe_isa( $_, 'Alzabo::Table' ) } map { @$_ } @{ $p{join} } } }; } else { @tables = grep { Alzabo::Utils::safe_isa($_, 'Alzabo::Table') } @{ $p{join} }; } if ( $p{distinct} ) { $p{distinct} = Alzabo::Utils::is_arrayref( $p{distinct} ) ? $p{distinct} : [ $p{distinct} ]; } if ( $p{order_by} ) { $p{order_by} = Alzabo::Utils::is_arrayref( $p{order_by} ) ? $p{order_by} : $p{order_by} ? [ $p{order_by} ] : undef; } # We go in this order: $p{select}, $p{distinct}, @tables my @select_tables = ( $p{select} ? ( Alzabo::Utils::is_arrayref( $p{select} ) ? @{ $p{select} } : $p{select} ) : $p{distinct} ? @{ $p{distinct} } : @tables ); my $sql = Alzabo::Runtime::sqlmaker( $self, \%p ); my @select_cols; if ( $p{distinct} ) { my %distinct = map { $_ => 1 } @{ $p{distinct} }; # hack so distinct is not treated as a function, just a # bareword in the SQL @select_cols = ( 'DISTINCT', map { ( $_->primary_key, $_->prefetch ? $_->columns( $_->prefetch ) : () ) } @{ $p{distinct} } ); foreach my $t (@select_tables) { next if $distinct{$t}; push @select_cols, $t->primary_key; push @select_cols, $t->columns( $t->prefetch ) if $t->prefetch; } if ( $p{order_by} && $sql->distinct_requires_order_by_in_select ) { my %select_cols = map { $_ => 1 } @select_cols; push @select_cols, grep { ref } @{ $p{order_by} }; } @select_tables = ( @{ $p{distinct} }, grep { ! $distinct{$_} } @select_tables ); } else { @select_cols = ( map { ( $_->primary_key, $_->prefetch ? $_->columns( $_->prefetch ) : () ) } @select_tables ); } $sql->select(@select_cols); $self->_join_all_tables( sql => $sql, join => $p{join} ); Alzabo::Runtime::process_where_clause( $sql, $p{where} ) if exists $p{where}; Alzabo::Runtime::process_order_by_clause( $sql, $p{order_by} ) if $p{order_by}; $sql->limit( ref $p{limit} ? @{ $p{limit} } : $p{limit} ) if $p{limit}; $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; my $statement = $self->driver->statement( sql => $sql->sql, bind => $sql->bind ); if (@select_tables == 1) { return Alzabo::Runtime::RowCursor->new ( statement => $statement, table => $select_tables[0]->real_table, ); } else { return Alzabo::Runtime::JoinCursor->new ( statement => $statement, tables => [ map { $_->real_table } @select_tables ], ); } } sub row_count { my $self = shift; my %p = @_; return $self->function( select => Alzabo::Runtime::sqlmaker( $self, \%p )->COUNT('*'), %p, ); } sub function { my $self = shift; my %p = @_; my $sql = $self->_select_sql(%p); my $method = Alzabo::Utils::is_arrayref( $p{select} ) && @{ $p{select} } > 1 ? 'rows' : 'column'; $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return $self->driver->$method( sql => $sql->sql, bind => $sql->bind ); } sub select { my $self = shift; my $sql = $self->_select_sql(@_); $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return $self->driver->statement( sql => $sql->sql, bind => $sql->bind ); } use constant _SELECT_SQL_SPEC => { join => { type => ARRAYREF | OBJECT, optional => 1 }, tables => { type => ARRAYREF | OBJECT, optional => 1 }, select => { type => SCALAR | ARRAYREF | OBJECT, optional => 1 }, where => { type => ARRAYREF, optional => 1 }, group_by => { type => ARRAYREF | HASHREF | OBJECT, optional => 1 }, order_by => { type => ARRAYREF | HASHREF | OBJECT, optional => 1 }, having => { type => ARRAYREF, optional => 1 }, limit => { type => SCALAR | ARRAYREF, optional => 1 }, quote_identifiers => { type => BOOLEAN, optional => 1 }, }; sub _select_sql { my $self = shift; my %p = validate( @_, _SELECT_SQL_SPEC ); $p{join} ||= delete $p{tables}; $p{join} = [ $p{join} ] unless Alzabo::Utils::is_arrayref( $p{join} ); my @tables; if ( Alzabo::Utils::is_arrayref( $p{join}->[0] ) ) { # flattens the nested structure and produces a unique set of # tables @tables = values %{ { map { $_ => $_ } grep { Alzabo::Utils::safe_isa( 'Alzabo::Table', $_ ) } map { @$_ } @{ $p{join} } } }; } else { @tables = grep { Alzabo::Utils::safe_isa( 'Alzabo::Table', $_ ) } @{ $p{join} }; } my @funcs = Alzabo::Utils::is_arrayref( $p{select} ) ? @{ $p{select} } : $p{select}; my $sql = ( Alzabo::Runtime::sqlmaker( $self, \%p )-> select(@funcs) ); $self->_join_all_tables( sql => $sql, join => $p{join} ); Alzabo::Runtime::process_where_clause( $sql, $p{where} ) if exists $p{where}; Alzabo::Runtime::process_group_by_clause( $sql, $p{group_by} ) if exists $p{group_by}; Alzabo::Runtime::process_having_clause( $sql, $p{having} ) if exists $p{having}; Alzabo::Runtime::process_order_by_clause( $sql, $p{order_by} ) if exists $p{order_by}; $sql->limit( ref $p{limit} ? @{ $p{limit} } : $p{limit} ) if $p{limit}; return $sql; } use constant _JOIN_ALL_TABLES_SPEC => { join => { type => ARRAYREF }, sql => { isa => 'Alzabo::SQLMaker' } }; sub _join_all_tables { my $self = shift; my %p = validate( @_, _JOIN_ALL_TABLES_SPEC ); my @from; my @joins; # outer join given as only join $p{join} = [ $p{join} ] unless ref $p{join}->[0]; # A structure like: # # [ [ $t_1 => $t_2 ], # [ $t_1 => $t_3, $fk ], # [ left_outer_join => $t_3 => $t_4 ], # [ left_outer_join => $t_3 => $t_5, undef, [ $where_clause ] ] # if ( Alzabo::Utils::is_arrayref( $p{join}->[0] ) ) { my %map; my %tables; foreach my $set ( @{ $p{join} } ) { # we take some care not to change the contents of $set, # because the caller may reuse the variable being # referenced, and changes here could break that. # XXX - improve params_exception 'The table map must contain only two tables per array reference' if @$set > 5; my @tables; if ( ! ref $set->[0] ) { $set->[0] =~ /^(right|left|full)_outer_join$/i or params_exception "Invalid join type: $set->[0]"; @tables = @$set[1,2]; push @from, [ $1, @tables, @$set[3, 4] ]; } else { @tables = @$set[0,1]; push @from, grep { ! exists $tables{ $_->alias_name } } @tables; push @joins, [ @tables, $set->[2] ]; } # Track the tables we've seen @tables{ $tables[0]->alias_name, $tables[1]->alias_name } = (1, 1); # Track their relationships push @{ $map{ $tables[0]->alias_name } }, $tables[1]->alias_name; push @{ $map{ $tables[1]->alias_name } }, $tables[0]->alias_name; } # just get one key to start with my ($key) = (each %tables)[0]; delete $tables{$key}; my @t = @{ delete $map{$key} }; while (my $t = shift @t) { delete $tables{$t}; push @t, @{ delete $map{$t} } if $map{$t}; } logic_exception "The specified table parameter does not connect all the tables involved in the join" if keys %tables; } # A structure like: # # [ $t_1 => $t_2 => $t_3 => $t_4 ] # else { for (my $x = 0; $x < @{ $p{join} } - 1; $x++) { push @joins, [ $p{join}->[$x], $p{join}->[$x + 1] ]; } @from = @{ $p{join} }; } $p{sql}->from(@from); return unless @joins; foreach my $join (@joins) { $self->_join_two_tables( $p{sql}, @$join ); } $p{sql}->subgroup_end; } sub _join_two_tables { my $self = shift; my ($sql, $table_1, $table_2, $fk) = @_; my $op = $sql->last_op eq 'and' || $sql->last_op eq 'condition' ? 'and' : 'where'; if ($fk) { unless ( $fk->table_from eq $table_1 && $fk->table_to eq $table_2 ) { if ( $fk->table_from eq $table_2 && $fk->table_to eq $table_1 ) { $fk = $fk->reverse; } else { params_exception ( "The foreign key given to join together " . $table_1->alias_name . " and " . $table_2->alias_name . " does not represent a relationship between those two tables" ); } } } else { my @fk = $table_1->foreign_keys_by_table($table_2); logic_exception ( "The " . $table_1->name . " table has no foreign keys to the " . $table_2->name . " table" ) unless @fk; logic_exception ( "The " . $table_1->name . " table has more than 1 foreign key to the " . $table_2->name . " table" ) if @fk > 1; $fk = $fk[0]; } foreach my $cp ( $fk->column_pair_names ) { if ( $op eq 'where' ) { # first time through loop only $sql->where; $sql->subgroup_start; $sql->condition( $table_1->column( $cp->[0] ), '=', $table_2->column( $cp->[1] ) ); } else { $sql->$op( $table_1->column( $cp->[0] ), '=', $table_2->column( $cp->[1] ) ); } $op = 'and'; } } sub prefetch_all { my $self = shift; $_->set_prefetch( $_->columns ) for $self->tables; } sub prefetch_all_but_blobs { my $self = shift; $_->set_prefetch( grep { ! $_->is_blob } $_->columns ) for $self->tables; } sub prefetch_none { my $self = shift; $_->set_prefetch() for $self->tables; } __END__ =head1 NAME Alzabo::Runtime::Schema - Schema objects =head1 SYNOPSIS use Alzabo::Runtime::Schema qw(some_schema); my $schema = Alzabo::Runtime::Schema->load_from_file( name => 'foo' ); $schema->set_user( $username ); $schema->set_password( $password ); $schema->connect; =head1 DESCRIPTION Objects in this class represent schemas, and can be used to retrieve data from that schema. This object can only be loaded from a file. The file is created whenever a corresponding L|Alzabo::Create::Schema> object is saved. =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 load_from_file ( name => $schema_name ) Loads a schema from a file. This is the only constructor for this class. It returns an C object. Loaded objects are cached in memory, so future calls to this method may return the same object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 set_user ($user) Sets the username to use when connecting to the database. =head2 user Return the username used by the schema when connecting to the database. =head2 set_password ($password) Set the password to use when connecting to the database. =head2 password Returns the password used by the schema when connecting to the database. =head2 set_host ($host) Set the host to use when connecting to the database. =head2 host Returns the host used by the schema when connecting to the database. =head2 set_port ($port) Set the port to use when connecting to the database. =head2 port Returns the port used by the schema when connecting to the database. =head2 set_referential_integrity ($boolean) Turns referential integrity checking on or off. If it is on, then when L|Alzabo::Runtime::Row> objects are deleted, updated, or inserted, they will report this activity to any relevant L|Alzabo::Runtime::ForeignKey> objects for the row, so that the foreign key objects can take appropriate action. This defaults to false. If your RDBMS supports foreign key constraints, these should be used instead of Alzabo's built-in referential integrity checking, as they will be much faster. =head2 referential_integrity Returns a boolean value indicating whether this schema will attempt to maintain referential integrity. =head2 set_quote_identifiers ($boolean) If this is true, then all SQL constructed for this schema will have quoted identifiers (like `Table`.`column` in MySQL). This defaults to false. Turning this on adds some overhead to all SQL generation. =head2 connect (%params) Calls the Lconnect>|Alzabo::Driver/connect> method for the driver owned by the schema. The username, password, host, and port set for the schema will be passed to the driver, as will any additional parameters given to this method. See the Lconnect() method >>|Alzabo::Driver/connect> for more details. =head2 disconnect Calls the Ldisconnect() >>|Alzabo::Driver/disconnect> method for the driver owned by the schema. =head2 join Joins are done by taking the tables provided in order, and finding a relation between them. If any given table pair has more than one relation, then this method will fail. The relations, along with the values given in the optional where clause will then be used to generate the necessary SQL. See L|Alzabo::Runtime::JoinCursor> for more information. This method takes the following parameters: =over 4 =item * join => This parameter can either be a simple array reference of tables or an array reference of array references. In the latter case, each array reference should contain two tables. These array references can also include an optional modifier specifying a type of join for the two tables, like 'left_outer_join', an optional foreign key object which will be used to join the two tables, and an optional where clause used to restrict the join. If a simple array reference is given, then the order of these tables is significant when there are more than 2 tables. Alzabo expects to find relationships between tables 1 & 2, 2 & 3, 3 & 4, etc. For example, given: join => [ $table_A, $table_B, $table_C ] Alzabo would expect that table A has a relationship to table B, which in turn has a relationship to table C. If you simply provide a simple array reference, you cannot include any outer joins, and every element of the array reference must be a table object. If you need to specify a more complicated set of relationships, this can be done with a slightly more complicated data structure, which looks like this: join => [ [ $table_A, $table_B ], [ $table_A, $table_C ], [ $table_C, $table_D ], [ $table_C, $table_E ] ] This is fairly self explanatory. Alzabo will expect to find a relationship between each pair of tables. This allows for the construction of arbitrarily complex join clauses. For even more complex needs, there are more options: join => [ [ left_outer_join => $table_A, $table_B ], [ $table_A, $table_C, $foreign_key ], [ right_outer_join => $table_C, $table_D, $foreign_key ] ] In this example, we are specifying two types of outer joins, and in two of the three cases, specifying which foreign key should be used to join the two tables. It should be noted that if you want to join two tables that have more than one foreign key between them, you B provide a foreign key object when using them as part of your query. The way an outer join is interpreted is that this: [ left_outer_join => $table_A, $table_B ] is interepreted to mean SELECT ... FROM table_A LEFT OUTER JOIN table_B ON ... Table order is relevant for right and left outer joins, obviously. However, for regular (inner) joins, table order is not important. It is also possible to apply restrictions to an outer join, for example: join => [ [ left_outer_join => $table_A, $table_B, # outer join restriction [ [ $table_B->column('size') > 2 ], 'and', [ $table_B->column('name'), '!=', 'Foo' ] ], ] ] This corresponds to this SQL; SELECT ... FROM table_A LEFT OUTER JOIN table_B ON ... AND (table_B.size > 2 AND table_B.name != 'Foo') These restrictions are only allowed when performing an outer join, since there is no point in using them for regular inner joins. An inner join restriction has the same effect when included in the "WHERE" clause. If the more multiple array reference of specifying tables is used and no "select" parameter is provided, then the order of the rows returned from calling Lnext() >>|Alzabo::Runtime::JoinCursor/next> is not guaranteed. In other words, the array that the cursor returns will contain a row from each table involved in the join, but the which row belongs to which table cannot be determined except by examining the objects. The order will be the same every time Lnext() >>|Alzabo::Runtime::JoinCursor/next> is called, however. It may be easier to use the Lnext_as_hash() >>|Alzabo::Runtime::JoinCursor/next_as_hash> method in this case. =item * select => C object or objects (optional) This parameter specifies from which tables you would like rows returned. If this parameter is not given, then the "distinct" or "join" parameter will be used instead, with the "distinct" parameter taking precedence. This can be either a single table or an array reference of table objects. =item * distinct => C object or objects (optional) If this parameter is given, it indicates that results from the join should never contain repeated rows. This can be used in place of the "select" parameter to indicate from which tables you want rows returned. The "select" parameter, if given, supercedes this parameter. For some databases (notably Postgres), if you want to do a "SELECT DISTINCT" query then all of the columns mentioned in your "ORDER BY" clause must also be in your SELECT clause. Alzabo will make sure this is the case, but it may cause more rows to be returned than you expected, though this depends on the query. B The adding of columns to the SELECT clause from the ORDER BY clause is considered experimental, because it can change the expected results in some cases. =item * where (optional) See the L. =item * order_by (optional) See the L. =item * limit (optional) See the L. =back If the "select" parameter specified that more than one table is desired, then this method will return n L object representing the results of the join. Otherwise, the method returns a L object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 one_row This method takes the exact same parameters as the L|Alzabo::Runtime::table/join> method but instead of returning a cursor, it returns a single array of row objects. These will be the rows representing the first row (a set of one or more table's primary keys) that is returned by the database. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 function and select These two methods differ only in their return values. They both take the following parameters: =over 4 =item * select => $function or [ scalars, SQL functions and/or C objects ] If you pass an array reference for this parameter, it may contain scalars, SQL functions, or column objects. For example: $schema->function( select => [ 1, $foo->column('name'), LENGTH( $foo->column('name') ) ], join => [ $foo, $bar_table ], ); This is equivalent to the following SQL: SELECT 1, foo.name, LENGTH( foo.name ) FROM foo, bar WHERE ... =item * join See the Lsee belowE>. =item * where See the L. =item * order_by See the L. =item * group_by See the L. =item * having This parameter is specified in the same way as the "where" parameter, but is used to generate a "HAVING" clause. It only allowed when you also specify a "group_by" parameter. =item * limit See the L. =back These methods are used to call arbitrary SQL functions such as 'AVG' or 'MAX', and to select data from individual columns. The function (or functions) should be the return values from the functions exported by the SQLMaker subclass that you are using. Please see L for more details. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head3 function() return values The return value of this method is highly context sensitive. If you only requested a single element in your "select" parameter, such as "DISTINCT(foo)", then it returns the first value in scalar context and all the values as an array in list context. If you requested multiple functions such as "AVG(foo), MAX(foo)", then it returns a single array reference, the first row of values, in scalar context and a list of array references in list context. =head3 select() return values This method always returns a new L|Alzabo::Driver/Alzabo::DriverStatement> object containing the results of the query. This object has an interface very similar to the Alzabo cursor interface, and has methods such as C, C, etc. =head2 row_count This method is simply a shortcut to get the result of COUNT('*') for a join. It equivalent to calling C with a "select" parameter of C. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 prefetch_all This method will set all the tables in the schema to prefetch all their columns. See the L section in L|Alzabo::Runtime::Table> for more details. =head2 prefetch_all_but_blobs This method will set all the tables in the schema to prefetch all their non-blob-type columns. This method is called as soon as a schema is loaded. =head2 prefetch_none This method turns of all prefetching. =for pod_merge name =for pod_merge tables =for pod_merge table =for pod_merge has_table =for pod_merge begin_work =for pod_merge rollback =for pod_merge commit =for pod_merge run_in_transaction ( sub { code... } ) =for pod_merge driver =for pod_merge rules =for pod_merge sqlmaker =head1 JOINING A TABLE MORE THAN ONCE It is possible to join to the same table more than once in a query. Table objects contain an L|Alzabo::Runtime::Table/alias> method that, when called, returns an object that can be used in the same query as the original table object, but which will be treated as a separate table. This faciliaties queries similar to the following SQL:: SELECT ... FROM Foo AS F1, Foo as F2, Bar AS B ... The object returned from the table functions more or less exactly like a table object. When using this table to set where clause or order by (or any other) conditions, it is important that the column objects for these conditions be retrieved from the alias object. For example: my $foo_alias = $foo->alias; my $cursor = $schema->join( select => $foo, join => [ $foo, $bar, $foo_alias ], where => [ [ $bar->column('baz'), '=', 10 ], [ $foo_alias->column('quux'), '=', 100 ] ], order_by => $foo_alias->column('briz') ); If we were to use the C<$foo> object to retrieve the 'quux' and 'briz' columns then the join would simply not work as expected. It is also possible to use multiple aliases of the same table in a join, so that this will work properly: my $foo_alias1 = $foo->alias; my $foo_alias2 = $foo->alias; =head1 USER AND PASSWORD INFORMATION This information is never saved to disk. This means that if you're operating in an environment where the schema object is reloaded from disk every time it is used, such as a CGI program spanning multiple requests, then you will have to make a new connection every time. In a persistent environment, this is not a problem. For example, in a mod_perl environment, you could load the schema and call the L|Alzabo::Runtime::Schema/set_user ($user)> and L|Alzabo::Runtime::Schema/set_password ($password)> methods in the server startup file. Then all the mod_perl children will inherit the schema with the user and password already set. Otherwise you will have to provide it for each request. You may ask why you have to go to all this trouble to deal with the user and password information. The basic reason was that I did not feel I could come up with a solution to this problem that was secure, easy to configure and use, and cross-platform compatible. Rather, I think it is best to let each user decide on a security practice with which they feel comfortable. In addition, there are a number of modules aimed at helping store and use this sort of information on CPAN, including C and C, among others. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/Row.pm0000444000175000017500000003236310721343227017230 0ustar autarchautarchpackage Alzabo::Runtime::Row; use strict; use vars qw($VERSION); use Alzabo; use Alzabo::Exceptions ( abbr => [ qw( logic_exception no_such_row_exception params_exception storable_exception ) ] ); use Alzabo::Runtime; use Alzabo::Runtime::RowState::Deleted; use Alzabo::Runtime::RowState::Live; use Alzabo::Runtime::RowState::Potential; use Alzabo::Utils; use Params::Validate qw( validate validate_with UNDEF SCALAR HASHREF BOOLEAN ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use Storable (); $VERSION = 2.0; BEGIN { no strict 'refs'; foreach my $meth ( qw( select select_hash update refresh delete id_as_string is_live is_potential is_deleted ) ) { *{ __PACKAGE__ . "::$meth" } = sub { my $s = shift; $s->{state}->$meth( $s, @_ ) }; } } use constant NEW_SPEC => { table => { isa => 'Alzabo::Runtime::Table' }, pk => { type => SCALAR | HASHREF, optional => 1, }, prefetch => { type => UNDEF | HASHREF, optional => 1, }, state => { type => SCALAR, default => 'Alzabo::Runtime::RowState::Live', }, potential_row => { isa => 'Alzabo::Runtime::Row', optional => 1, }, values => { type => HASHREF, default => {}, }, no_cache => { type => BOOLEAN, default => 0 }, }; sub new { my $proto = shift; my $class = ref $proto || $proto; my %p = validate( @_, NEW_SPEC ); my $self = $p{potential_row} ? $p{potential_row} : {}; bless $self, $class; $self->{table} = $p{table}; $self->{state} = $p{state}; $self->{state}->_init($self, @_) or return; return $self; } sub table { my $self = shift; return $self->{table}; } sub schema { my $self = shift; return $self->table->schema; } sub set_state { $_[0]->{state} = $_[1] }; use constant ROWS_BY_FOREIGN_KEY_SPEC => { foreign_key => { isa => 'Alzabo::ForeignKey' } }; sub rows_by_foreign_key { my $self = shift; my %p = validate_with( params => \@_, spec => ROWS_BY_FOREIGN_KEY_SPEC, allow_extra => 1, ); my $fk = delete $p{foreign_key}; if ($p{where}) { $p{where} = [ $p{where} ] unless Alzabo::Utils::is_arrayref( $p{where}[0] ); } push @{ $p{where} }, map { [ $_->[1], '=', $self->select( $_->[0]->name ) ] } $fk->column_pairs; # if the relationship is not 1..n, then only one row can be # returned (or referential integrity has been hosed in the # database). return $fk->is_one_to_many ? $fk->table_to->rows_where(%p) : $fk->table_to->one_row(%p); } # class method sub id_as_string_ext { my $class = shift; my %p = @_; my $id_hash = $class->_make_id_hash(%p); local $^W; # weirdly, enough there are code paths that can # lead here that'd lead to $id_hash having some # values that are undef return join ';:;_;:;', ( $p{table}->schema->name, $p{table}->name, map { $_, $id_hash->{$_} } sort keys %$id_hash ); } sub _make_id_hash { my $self = shift; my %p = @_; return $p{pk} if ref $p{pk}; return { ($p{table}->primary_key)[0]->name => $p{pk} }; } sub _update_pk_hash { my $self = shift; my @pk = keys %{ $self->{pk} }; @{ $self->{pk} }{ @pk } = @{ $self->{data} }{ @pk }; delete $self->{id_string}; } sub make_live { my $self = shift; logic_exception "Can only call make_live on potential rows" unless $self->{state}->is_potential; my %p = @_; my %values; foreach ( $self->table->columns ) { next unless exists $p{values}->{ $_->name } || exists $self->{data}->{ $_->name }; $values{ $_->name } = ( exists $p{values}->{ $_->name } ? $p{values}->{ $_->name } : $self->{data}->{ $_->name } ); } my $table = $self->table; delete @{ $self }{keys %$self}; # clear out everything $table->insert( @_, potential_row => $self, %values ? ( values => \%values ) : (), ); } sub _cached_data_is_same { my $self = shift; my ( $key, $val ) = @_; # The convolutions here are necessary to avoid avoid treating # undef as being equal to 0 or ''. Stupid NULLs. return 1 if ( exists $self->{data}{$key} && ( ( ! defined $val && ! defined $self->{data}{$key} ) || ( defined $val && defined $self->{data}{$key} && ( $val eq $self->{data}{$key} ) ) ) ); return 0; } sub _no_such_row_error { my $self = shift; my $err = 'Unable to find a row in ' . $self->table->name . ' where '; my @vals; while ( my( $k, $v ) = each %{ $self->{pk} } ) { $v = '' unless defined $v; my $val = "$k = $v"; push @vals, $val; } $err .= join ', ', @vals; no_such_row_exception $err; } sub STORABLE_freeze { my $self = shift; my $cloning = shift; my %data = %$self; my $table = delete $data{table}; $data{schema} = $table->schema->name; $data{table_name} = $table->name; my $ser = eval { Storable::nfreeze(\%data) }; storable_exception $@ if $@; return $ser; } sub STORABLE_thaw { my ( $self, $cloning, $ser ) = @_; my $data = eval { Storable::thaw($ser) }; storable_exception $@ if $@; %$self = %$data; my $s = Alzabo::Runtime::Schema->load_from_file( name => delete $self->{schema} ); $self->{table} = $s->table( delete $self->{table_name} ); return $self; } BEGIN { # dumb hack to fix bugs in Storable 2.00 - 2.03 w/ a non-threaded # Perl # # Basically, Storable somehow screws up the hooks business the # _first_ time an object from a class with hooks is stored. So # we'll just _force_ it do it once right away. if ( $Storable::VERSION >= 2 && $Storable::VERSION <= 2.03 ) { eval <<'EOF'; { package ___name; sub name { 'foo' } } { package ___table; @table::ISA = '___name'; sub schema { bless {}, '___name' } } my $row = bless { table => bless {}, '___table' }, __PACKAGE__; Storable::thaw(Storable::nfreeze($row)); EOF } } 1; __END__ =head1 NAME Alzabo::Runtime::Row - Row objects =head1 SYNOPSIS use Alzabo::Runtime::Row; my $row = $table->row_by_pk( pk => 1 ); $row->select('foo'); $row->update( bar => 5 ); $row->delete; =head1 DESCRIPTION These objects represent actual rows from the database containing actual data. In general, you will want to use the L|Alzabo::Runtime::Table> object to retrieve rows. The L|Alzabo::Runtime::Table> object can return either single rows or L. =head1 ROW STATES Row objects can have a variety of states. Most row objects are "live", which means they represent an actual row object. A row can be changed to the "deleted" state by calling its C method. This is a row that no longer exists in the database. Most method calls on rows in this state cause an exception. There is also a "potential" state, for objects which do not represent actual database rows. You can call L|make_live> on these rows in order to change their state to "live". Finally, there is an "in cache" state, which is identical to the "live" state, except that it is used for object's that are cached via the L|Alzabo::Runtime::UniqueRowCache> class. =head1 METHODS Row objects offer the following methods: =head2 select (@list_of_column_names) Returns a list of values matching the specified columns in a list context. In scalar context it returns only a single value (the first column specified). If no columns are specified, it will return the values for all of the columns in the table, in the order that are returned by Lcolumns>|Alzabo::Runtime::Table/columns>. This method throws an L|Alzabo::Exceptions> if called on a deleted row. =head2 select_hash (@list_of_column_names) Returns a hash of column names to values matching the specified columns. If no columns are specified, it will return the values for all of the columns in the table. This method throws an L|Alzabo::Exceptions> if called on a deleted row. =head2 update (%hash_of_columns_and_values) Given a hash of columns and values, attempts to update the database to and the object to represent these new values. It returns a boolean value indicating whether or not any data was actually modified. This method throws an L|Alzabo::Exceptions> if called on a deleted row. =head2 refresh Refreshes the object against the database. This can be used when you want to ensure that a row object is up to date in regards to the database state. This method throws an L|Alzabo::Exceptions> if called on a deleted row. =head2 delete Deletes the row from the RDBMS and changes the object's state to deleted. For potential rows, this method simply changes the object's state. This method throws an L|Alzabo::Exceptions> if called on a deleted row. =head2 id_as_string Returns the row's id value as a string. This can be passed to the Lrow_by_id>|Alzabo::Runtime::Table/row_by_id> method to recreate the row later. For potential rows, this method always return an empty string. This method throws an L|Alzabo::Exceptions> if called on a deleted row. =head2 is_live Indicates whether or not the given row represents an actual row in the database. =head2 is_potential Indicates whether or not the given row represents an actual row in the datatbase. =head2 is_deleted Indicates whether or not the given row has been deleted =head2 table Returns the L|Alzabo::Runtime::Table> object that this row belongs to. =head2 schema Returns the L|Alzabo::Runtime::Schema> object that this row's table belongs to. This is a shortcut for C<< $row->table->schema >>. =head2 rows_by_foreign_key This method is used to retrieve row objects from other tables by "following" a relationship between two tables. It takes the following parameters: =over 4 =item * foreign_key => C object =back Given a foreign key object, this method returns either a row object or a row cursor object the row(s) in the table to which the relationship exist. The type of object returned is based on the cardinality of the relationship. If the relationship says that there could only be one matching row, then a row object is returned, otherwise it returns a cursor. =head1 POTENTIAL ROWS The "potential" row state is used for rows which do not yet exist in the database. These are created via the Lpotential_row >>|Alzabo::Runtime::Table/potential_row> method. They are useful when you need a placeholder object which you can update and select from, but you don't actually want to commit the data to the database. These objects are not cached. Once L|/make_live> is called, the object's state becomes "live". Potential rows have looser constraints for column values than regular rows. When creating a new potential row, it is ok if none of the columns are defined. If a column has a default, and a value for that column is not given, then the default will be used. However, you cannot update a column in a potential row to undef (NULL) if the column is not nullable. No attempt is made to enforce L on these objects. You cannot set a column's value to a database function like "NOW()", because this requires interaction with the database. =head2 make_live This method inserts the row into the database and changes the object's state to "live". This means that all references to the potential row object will now be references to the real object (which is a good thing). This method can take any parameters that can be passed to the Linsert>|Alzabo::Runtime::Table/insert> method. Any columns already set will be passed to the C method, including primary key values. However, these will be overridden, on a column by column basis, by a "pk" or "values" parameters given to the C<(make_live()> method. Calling this method on a row object that is not in the "potential" state will cause an L|Alzabo::Exceptions> =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/Table.pm0000444000175000017500000007703410721343227017514 0ustar autarchautarchpackage Alzabo::Runtime::Table; use strict; use vars qw($VERSION); use Alzabo::Exceptions ( abbr => [ qw( logic_exception not_nullable_exception params_exception ) ] ); use Alzabo::Runtime; use Alzabo::Utils; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { params_exception join '', @_ } ); use Scalar::Util (); use Tie::IxHash; use base qw(Alzabo::Table); $VERSION = 2.0; sub insert { my $self = shift; logic_exception "Can't make rows for tables without a primary key" unless $self->primary_key; my %p = @_; %p = validate( @_, { ( map { $_ => { optional => 1 } } keys %p ), values => { type => HASHREF, optional => 1 }, quote_identifiers => { type => BOOLEAN, optional => 1 }, }, ); my $vals = delete $p{values} || {}; my $schema = $self->schema; my @pk = $self->primary_key; foreach my $pk (@pk) { unless ( exists $vals->{ $pk->name } ) { if ($pk->sequenced) { $vals->{ $pk->name } = $schema->driver->next_sequence_number($pk); } else { params_exception ( "No value provided for primary key (" . $pk->name . ") and no sequence is available." ); } } } foreach my $c ($self->columns) { next if $c->is_primary_key; unless ( defined $vals->{ $c->name } || $c->nullable || defined $c->default ) { not_nullable_exception ( error => $c->name . " column in " . $self->name . " table cannot be null.", column_name => $c->name, table_name => $c->table->name, schema_name => $c->table->schema->name, ); } delete $vals->{ $c->name } if ! defined $vals->{ $c->name } && defined $c->default; } my @fk; @fk = $self->all_foreign_keys if $schema->referential_integrity; my $sql = ( Alzabo::Runtime::sqlmaker( $self->schema, \%p )-> insert-> into($self, $self->columns( sort keys %$vals ) )-> values( map { $self->column($_) => $vals->{$_} } sort keys %$vals ) ); my %id; $schema->begin_work if @fk; eval { foreach my $fk (@fk) { $fk->register_insert( map { $_->name => $vals->{ $_->name } } $fk->columns_from ); } $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; $self->schema->driver->do( sql => $sql->sql, bind => $sql->bind ); foreach my $pk (@pk) { $id{ $pk->name } = ( defined $vals->{ $pk->name } ? $vals->{ $pk->name } : $schema->driver->get_last_id($self) ); } # must come after call to ->get_last_id for MySQL because the # id will no longer be available after the transaction ends. $schema->commit if @fk; }; if (my $e = $@) { eval { $schema->rollback }; rethrow_exception $e; } return unless defined wantarray || $p{potential_row}; return $self->row_by_pk( pk => \%id, %p ); } sub insert_handle { my $self = shift; logic_exception "Can't make rows for tables without a primary key" unless $self->primary_key; my %p = @_; %p = validate( @_, { ( map { $_ => { optional => 1 } } keys %p ), columns => { type => ARRAYREF, default => [] }, values => { type => HASHREF, default => {} }, quote_identifiers => { type => BOOLEAN, optional => 1 }, }, ); my %func_vals; my %static_vals; if ( $p{values} ) { my $v = delete $p{values}; while ( my ( $name, $val ) = each %$v ) { if ( Alzabo::Utils::safe_isa( $val, 'Alzabo::SQLMaker::Function' ) ) { $func_vals{$name} = $val; } else { $static_vals{$name} = $val } } } my $placeholder = $self->schema->sqlmaker->placeholder; my %cols; my %vals; # Get the unique set of columns and associated values foreach my $col ( @{ $p{columns} }, $self->primary_key ) { $vals{ $col->name } = $placeholder; $cols{ $col->name } = 1; } foreach my $name ( keys %static_vals ) { $vals{$name} = $placeholder; $cols{$name} = 1; } %vals = ( %vals, %func_vals ); # At this point, %vals has each column's name and associated # value. The value may be a placeholder or SQL function. $cols{$_} = 1 foreach keys %func_vals; foreach my $c ( $self->columns ) { next if $c->is_primary_key || $c->nullable || defined $c->default; unless ( $cols{ $c->name } ) { not_nullable_exception ( error => $c->name . " column in " . $self->name . " table cannot be null.", column_name => $c->name, table_name => $c->table->name, schema_name => $c->table->schema->name, ); } } my @columns = $self->columns( keys %vals ); my $sql = ( Alzabo::Runtime::sqlmaker( $self->schema, \%p )-> insert-> into( $self, @columns )-> values( map { $_ => $vals{ $_->name } } @columns ), ); return Alzabo::Runtime::InsertHandle->new( table => $self, sql => $sql, values => \%static_vals, columns => \@columns, %p, ); } sub row_by_pk { my $self = shift; logic_exception "Can't make rows for tables without a primary key" unless $self->primary_key; my %p = @_; my $pk_val = $p{pk}; my @pk = $self->primary_key; params_exception 'Incorrect number of pk values provided. ' . scalar @pk . ' are needed.' if ref $pk_val && @pk != scalar keys %$pk_val; if (@pk > 1) { params_exception ( 'Primary key for ' . $self->name . ' is more than one column.' . ' Please provide multiple key values as a hashref.' ) unless ref $pk_val; foreach my $pk (@pk) { params_exception 'No value provided for primary key ' . $pk->name . '.' unless defined $pk_val->{ $pk->name }; } } return $self->_make_row( %p, table => $self, ); } sub _make_row { my $self = shift; my %p = @_; my $class = $p{row_class} ? delete $p{row_class} : $self->_row_class; return $class->new(%p); } sub _row_class { 'Alzabo::Runtime::Row' } sub row_by_id { my $self = shift; my %p = @_; validate( @_, { row_id => { type => SCALAR }, ( map { $_ => { optional => 1 } } keys %p ) } ); my (undef, undef, %pk) = split ';:;_;:;', delete $p{row_id}; return $self->row_by_pk( %p, pk => \%pk ); } sub rows_where { my $self = shift; my %p = @_; my $sql = $self->_make_sql(%p); Alzabo::Runtime::process_where_clause( $sql, $p{where} ) if exists $p{where}; $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return $self->_cursor_by_sql( %p, sql => $sql ); } sub one_row { my $self = shift; my %p = @_; my $sql = $self->_make_sql(%p); Alzabo::Runtime::process_where_clause( $sql, $p{where} ) if exists $p{where}; Alzabo::Runtime::process_order_by_clause( $sql, $p{order_by} ) if exists $p{order_by}; if ( exists $p{limit} ) { $sql->limit( ref $p{limit} ? @{ $p{limit} } : $p{limit} ); } $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; my @return = $self->schema->driver->one_row( sql => $sql->sql, bind => $sql->bind ) or return; my @pk = $self->primary_key; my (%pk, %prefetch); @pk{ map { $_->name } @pk } = splice @return, 0, scalar @pk; # Must be some prefetch pieces if (@return) { @prefetch{ $self->prefetch } = @return; } return $self->row_by_pk( pk => \%pk, prefetch => \%prefetch, ); } sub all_rows { my $self = shift; my $sql = $self->_make_sql; $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return $self->_cursor_by_sql( @_, sql => $sql ); } sub _make_sql { my $self = shift; my %p = @_; logic_exception "Can't make rows for tables without a primary key" unless $self->primary_key; my $sql = ( Alzabo::Runtime::sqlmaker( $self->schema, \%p )-> select( $self->primary_key, $self->prefetch ? $self->columns( $self->prefetch ) : () )-> from( $self ) ); return $sql; } sub _cursor_by_sql { my $self = shift; my %p = @_; validate( @_, { sql => { isa => 'Alzabo::SQLMaker' }, order_by => { type => ARRAYREF | HASHREF | OBJECT, optional => 1 }, limit => { type => SCALAR | ARRAYREF, optional => 1 }, ( map { $_ => { optional => 1 } } keys %p ) } ); Alzabo::Runtime::process_order_by_clause( $p{sql}, $p{order_by} ) if exists $p{order_by}; if ( exists $p{limit} ) { $p{sql}->limit( ref $p{limit} ? @{ $p{limit} } : $p{limit} ); } my $statement = $self->schema->driver->statement( sql => $p{sql}->sql, bind => $p{sql}->bind, limit => $p{sql}->get_limit ); return Alzabo::Runtime::RowCursor->new( statement => $statement, table => $self, ); } sub potential_row { my $self = shift; my %p = @_; logic_exception "Can't make rows for tables without a primary key" unless $self->primary_key; my $class = $p{row_class} ? delete $p{row_class} : $self->_row_class; return $class->new( %p, state => 'Alzabo::Runtime::RowState::Potential', table => $self, ); } sub row_count { my $self = shift; my %p = @_; my $count = Alzabo::Runtime::sqlmaker( $self->schema, \%p )->COUNT('*'); return $self->function( select => $count, %p ); } sub function { my $self = shift; my %p = @_; my $sql = $self->_select_sql(%p); my $method = Alzabo::Utils::is_arrayref( $p{select} ) && @{ $p{select} } > 1 ? 'rows' : 'column'; $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return $self->schema->driver->$method( sql => $sql->sql, bind => $sql->bind ); } sub select { my $self = shift; my $sql = $self->_select_sql(@_); $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return $self->schema->driver->statement( sql => $sql->sql, bind => $sql->bind ); } use constant _SELECT_SQL_SPEC => { select => { type => SCALAR | ARRAYREF | OBJECT }, where => { type => ARRAYREF | OBJECT, optional => 1 }, order_by => { type => ARRAYREF | HASHREF | OBJECT, optional => 1 }, group_by => { type => ARRAYREF | HASHREF | OBJECT, optional => 1 }, having => { type => ARRAYREF, optional => 1 }, limit => { type => SCALAR | ARRAYREF, optional => 1 }, quote_identifiers => { type => BOOLEAN, optional => 1 }, }; sub _select_sql { my $self = shift; my %p = validate( @_, _SELECT_SQL_SPEC ); my @funcs = Alzabo::Utils::is_arrayref( $p{select} ) ? @{ $p{select} } : $p{select}; my $sql = Alzabo::Runtime::sqlmaker( $self->schema, \%p )->select(@funcs)->from($self); Alzabo::Runtime::process_where_clause( $sql, $p{where} ) if exists $p{where}; Alzabo::Runtime::process_group_by_clause( $sql, $p{group_by} ) if exists $p{group_by}; Alzabo::Runtime::process_having_clause( $sql, $p{having} ) if exists $p{having}; Alzabo::Runtime::process_order_by_clause( $sql, $p{order_by} ) if exists $p{order_by}; $sql->limit( ref $p{limit} ? @{ $p{limit} } : $p{limit} ) if $p{limit}; return $sql; } sub set_prefetch { my $self = shift; $self->{prefetch} = $self->_canonize_prefetch(@_); } sub _canonize_prefetch { my $self = shift; validate_pos( @_, ( { isa => 'Alzabo::Column' } ) x @_ ); foreach my $c (@_) { params_exception "Column " . $c->name . " doesn't exist in $self->{name}" unless $self->has_column( $c->name ); } return [ map { $_->name } grep { ! $_->is_primary_key } @_ ]; } sub prefetch { my $self = shift; return ref $self->{prefetch} ? @{ $self->{prefetch} } : (); } sub add_group { my $self = shift; validate_pos( @_, ( { isa => 'Alzabo::Column' } ) x @_ ); my @names = map { $_->name } @_; foreach my $col (@_) { params_exception "Column " . $col->name . " doesn't exist in $self->{name}" unless $self->has_column( $col->name ); next if $col->is_primary_key; $self->{groups}{ $col->name } = \@names; } } sub group_by_column { my $self = shift; my $col = shift; return exists $self->{groups}{$col} ? @{ $self->{groups}{$col} } : $col; } my $alias_num = '000000000'; sub alias { my $self = shift; my $clone; %$clone = %$self; bless $clone, ref $self; $clone->{alias_name} = $self->name . ++$alias_num; $clone->{real_table} = $self; $clone->{columns} = Tie::IxHash->new( map { $_->name => $_ } $self->columns ); # Force clone of primary key columns right away. $clone->column($_) foreach map { $_->name } $self->primary_key; return $clone; } # # Since its unlikely that a user will end up needing clones of more # than 1-2 columns each time an alias is used, we only make copies as # needed. # sub column { my $self = shift; # I'm an alias, make an alias column if ( $self->{alias_name} ) { my $name = shift; my $col = $self->SUPER::column($name); # not previously cloned unless ( $col->table eq $self ) { # replace our copy of this column with a clone $col = $col->alias_clone( table => $self ); my $index = $self->{columns}->Indices($name); $self->{columns}->Replace( $index, $col, $name ); Scalar::Util::weaken( $col->{table} ); delete $self->{pk_array} if $col->is_primary_key; } return $col; } else { return $self->SUPER::column(@_); } } sub alias_name { # intentionally don't call $_[0]->name for a noticeable # performance boost return $_[0]->{alias_name} || $_[0]->{name}; } sub real_table { return $_[0]->{real_table} || $_[0]; } # This gets called a _lot_ so doing this sort of 'memoization' helps sub primary_key { my $self = shift; $self->{pk_array} ||= [ $self->SUPER::primary_key ]; return ( wantarray ? @{ $self->{pk_array} } : $self->{pk_array}->[0] ); } 1; __END__ =head1 NAME Alzabo::Runtime::Table - Table objects =head1 SYNOPSIS my $table = $schema->table('foo'); my $row = $table->row_by_pk( pk => 1 ); my $row_cursor = $table->rows_where ( where => [ Alzabo::Column object, '=', 5 ] ); =head1 DESCRIPTION This object is able to create rows, either by making objects based on existing data or inserting new data to make new rows. This object also implements a method of lazy column evaluation that can be used to save memory and database wear and tear. Please see the L section for details. =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 Methods that return an C object All of these methods accept the "no_cache" parameter, which will be passed on to C<< Alzabo::Runtime::Row->new >>. =head2 insert Inserts the given values into the table. If no value is given for a primary key column and the column is L<"sequenced"|Alzabo::Column/sequenced> then the primary key will be auto-generated. It takes the following parameters: =over 4 =item * values => $hashref The hashref contains column names and values for the new row. This parameter is optional. If no values are specified, then the default values will be used. =back This methods return a new L|Alzabo::Runtime::Row> object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 row_by_pk The primary key can be either a simple scalar, as when the table has a single primary key, or a hash reference of column names to primary key values, for multi-column primary keys. It takes the following parameters: =over 4 =item * pk => $pk_val or \%pk_val =back It returns a new L|Alzabo::Runtime::Row> object. If no rows in the database match the value(s) given then an empty list or undef will be returned (for list or scalar context). Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 row_by_id This method is useful for regenerating a row that has been saved by reference to its id (returned by the Lid>|Alzabo::Runtime::Row/id> method). This may be more convenient than saving a multi-column primary key when trying to maintain state in a web app, for example. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> This method takes a single parameter, "row_id", which is the string representation of a row's id, as returned by the Lid_as_string() >>|Alzabo::Runtime::Row/id_as_string> method. It returns a new L|Alzabo::Runtime::Row> object. If no rows in the database match the value(s) given then an empty list or undef will be returned (for list or scalar context). =head2 Insert Handles If you are going to be inserting many rows at once, it is more efficient to create an insert handle and re-use that. This is similar to how DBI allows you to create statement handles and execute them multiple times. =head2 insert_handle This method takes the following parameters: =over 4 =item * columns => $arrayref This should be an array reference containing zero or more C objects. If it is empty, or not provided, then defaults will be used for all columns. =item * values => $hashref This is used to specify values that will be the same for each row. These can be actual values or SQL functions. =back The return value of this method is an C object. This object has a single method, C. See the L|Alzabo::Runtime::InsertHandle> docs for details. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 Common Parameters A number of methods in this clas take the same parameters. These are documented below. =over 4 =item * where => This parameter can take a variety of values. The most basic "where" parameter is a single array reference of this form: [ Alzabo::Column object or SQL function, $comparison, $value or Alzabo::Column object ] The C<$comparison> should be a string containing a SQL operator such as C<< > >>, C<=>, or C. The parameter can also be an array reference containing many such arrays: [ [ Alzabo::Column object or SQL function, $comparison, $value or Alzabo::Column object ], [ Alzabo::Column object or SQL function, $comparison, $value or Alzabo::Column object ], ... ] If the comparison is "BETWEEN", then it should be followed by two values. If it is "IN" or "NOT IN", then it should be followed by a list of one or more values. By default, each clause represented by an array reference is joined together with an 'AND'. However, you can put the string 'or' between two array references to cause them to be joined with an 'OR', such as: [ [ $foo_col, '=', 5 ], 'or', [ $foo_col, '>', 10 ] ] which would generate SQL something like: WHERE foo = 5 OR foo > 10 If you want to be explicit, you can also use the string 'and'. If you need to group conditionals you can use '(' and ')' strings in between array references representing a conditional. For example: [ [ $foo_col, '=', 5 ], '(', [ $foo_col, '>', 10 ] 'or', [ $bar_col, '<', 50, ')' ], ')' ] which would generate SQL something like: WHERE foo = 5 AND ( foo > 10 OR bar < 50 ) Make sure that your parentheses balance out or an exception will be thrown. You can also use the SQL functions (L) exported from the SQLMaker subclass you are using. For example: [ LENGTH($foo_col), '<', 10 ] would generate something like: WHERE LENGTH(foo) < 10 =item * order_by => see below This parameter can take one of two different values. The simplest form is to just give it a single column object or SQL function. Alternatively, you can give it an array reference to a list of column objects, SQL functions and strings like this: order_by => [ $col1, COUNT('*'), $col2, 'DESC', $col3, 'ASC' ] It is important to note that you cannot simply use any arbitrary SQL function as part of your order by clause. You need to use a function that is exactly the same as one that was given as part of the "select" parameter. =item * group_by => see below This parameter can take either a single column object or an array of column objects. =item * having => same as "where" This parameter is specified in the same way as the "where" parameter. =item * limit => $limit or [ $limit, $offset ] For databases that support LIMIT clauses, this incorporates such a clause into the SQL. For databases that don't, the limit will be implemented programatically as rows are being requested. If an offset is given, this will be the number of rows skipped in the result set before the first one is returned. =back =head2 Methods that return an C object The C and C methods both return an L|Alzabo::Runtime::RowCursor> object representing the results of the query. This is the case even for queries that end up returning one or zero rows, because Alzabo cannot know in advance how many rows these queries will return. =head2 rows_where This method provides a simple way to retrieve a row cursor based on one or more colum values. It takes the following parameters, all of which were described in the L section. =over 4 =item * where =item * order_by =item * limit =back It returns n L|Alzabo::Runtime::RowCursor> object representing the query. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 all_rows This method simply returns all the rows in the table. It takes the following parameters: =over 4 =item * order_by =item * limit =back It returns an L|Alzabo::Runtime::RowCursor> object representing the query. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 one_row This method takes the exact same parameters as the L|Alzabo::Runtime::table/rows_where> method but instead of returning a cursor, it returns a single row. This row represents the first row returned by the database. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 potential_row This method is used to create a new L|Alzabo::Runtime::Row> object, in the "potential" state. It takes the following parameters. =over 4 =item * values => \%values This should be a hash reference containing column names, just as is given to L. It is ok to omit columns that are normally not nullable, but they cannot be B set to null. Any values given will be set in the new potential row object. If a column has a default, and a value for that column is not given, then the default will be used. Unlike the L method, you cannot use SQL functions as values here. =back Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 Other Methods This method returns a count of the rows in the table. It takes the following parameters: =head2 row_count =over 4 =item * where =back Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 function and select These two methods differ only in their return values. They both take the following parameters: =over 4 =item * select => $function or [ scalars, SQL functions and/or C objects ] If you pass an array reference for this parameter, it may contain scalars, SQL functions, or column objects. For example: $table->function( select => [ 1, $foo->column('name'), LENGTH( $foo->column('name') ) ] ); This is equivalent to the following SQL: SELECT 1, foo.name, LENGTH( foo.name ) FROM foo =item * where =item * order_by =item * group_by =item * limit =back This method is used to call arbitrary SQL functions such as 'AVG' or 'MAX', or to select arbitrary column data. The function (or functions) should be the return values from the functions exported by the SQLMaker subclass that you are using. Please see L for more details. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head3 function() return values The return value of this method is highly context sensitive. If you only requested a single element in your "select" parameter, such as "DISTINCT(foo)", then it returns the first value in scalar context and all the values as an array in list context. If you requested multiple functions such as "AVG(foo), MAX(foo)", then it returns a single array reference, the first row of values, in scalar context and a list of array references in list context. =head3 select() return values This method always returns a new L|Alzabo::Driver/Alzabo::DriverStatement> object containing the results of the query. This object has an interface very similar to the Alzabo cursor interface, and has methods such as C, C, etc. =head2 alias This returns an object which can be used in joins to allow a particular table to be involved in the join under multiple aliases. This allows for self-joins as well as more complex joins involving multiple aliases to a given table. The object returned by this method is more or less identical to a table object in terms of the methods it supports. This includes methods that were generated by C. However, B because the results will be unpredictable. In addition, B. =for pod_merge schema =for pod_merge name =for pod_merge column =for pod_merge columns =for pod_merge has_column =for pod_merge primary_key =for pod_merge primary_key_size =for pod_merge column_is_primary_key =for pod_merge foreign_keys =for pod_merge foreign_keys_by_table =for pod_merge foreign_keys_by_column =for pod_merge all_foreign_keys =for pod_merge index =for pod_merge has_index =for pod_merge indexes =for pod_merge attributes =for pod_merge has_attribute =for pod_merge comment =head1 LAZY COLUMN LOADING This concept was taken directly from Michael Schwern's Class::DBI module (credit where it is due). By default, L|Alzabo::Runtime::Row> objects load all data from the database except blob type columns (columns with an unbounded length). This data is stored internally in the object after being fetched. If you want to change what data is prefetched, there are two methods you can use. The first method, L|Alzabo::Runtime::Table/set_prefetch (Alzabo::Column objects)>, allows you to specify a list of columns to be fetched immediately after object creation. These should be columns that you expect to use extremely frequently. The second method, L|Alzabo::Runtime::Table/add_group (Alzabo::Column objects)>, allows you to group columns together. If you attempt to fetch one of these columns, then all the columns in the group will be fetched. This is useful in cases where you don't often want certain data, but when you do you need several related pieces. =head2 Lazy column loading related methods =head3 set_prefetch (C objects) Given a list of column objects, this makes sure that all L|Alzabo::Runtime::Row> objects fetch this data as soon as they are created. NOTE: It is pointless (though not an error) to give primary key column here as these are always prefetched (in a sense). Throws: L|Alzabo::Exceptions> =head3 add_group (C objects) Given a list of L|Alzabo::Column> objects, this method creates a group containing these columns. This means that if any column in the group is fetched from the database, then they will all be fetched. Otherwise column are always fetched singly. Currently, a column cannot be part of more than one group. NOTE: It is pointless to include a column that was given to the L|Alzabo::Runtime::Table/set_prefetch (Alzabo::Column objects)> method in a group here, as it always fetched as soon as possible. Throws: L|Alzabo::Exceptions> =head2 prefetch This method primarily exists for use by the L|Alzabo::Runtime::Row> class. It returns a list of column names (not objects) that should be prefetched. =head2 group_by_column ($column_name) This method primarily exists for use by the L|Alzabo::Runtime::Row> class. It returns a list of column names representing the group that the given column is part of. If the column is not part of a group, only the name passed in is returned. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/Cursor.pm0000444000175000017500000000260510721343227017732 0ustar autarchautarchpackage Alzabo::Runtime::Cursor; use strict; use vars qw($VERSION); use Alzabo::Runtime; $VERSION = 2.0; 1; sub new { shift->_virtual; } sub next { shift->_virtual; } sub all_rows { shift->_virtual; } sub _virtual { my $self = shift; my $sub = (caller(1))[3]; Alzabo::Exception::VirtualMethod->throw ( error => "$sub is a virtual method and must be subclassed in " . ref $self ); } sub reset { my $self = shift; $self->{statement}->execute( $self->{statement}->bind ); $self->{count} = 0; } sub count { my $self = shift; return $self->{count}; } sub next_as_hash { my $self = shift; my @next = $self->next or return; return map { defined $_ ? ( $_->table->name => $_ ) : () } @next; } __END__ =head1 NAME Alzabo::Runtime::Cursor - Base class for Alzabo cursors =head1 SYNOPSIS use Alzabo::Runtime::Cursor; =head1 DESCRIPTION This is the base class for cursors. =head1 METHODS =head2 new Virtual method. =head2 all_rows Virtual method. =head2 reset Resets the cursor so that the next C call will return the first row of the set. =head2 count Returns the number of rows returned by the cursor so far. =head2 next_as_hash Returns the next row or rows in a hash, where the hash key is the table name and the hash value is the row object. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/UniqueRowCache.pm0000444000175000017500000000717710721343227021350 0ustar autarchautarchpackage Alzabo::Runtime::UniqueRowCache; use strict; use Alzabo::Runtime::Table; use Alzabo::Runtime::RowState::InCache; my %CACHE; BEGIN { my $real_make_row = \&Alzabo::Runtime::Table::_make_row; local $^W = 0; *Alzabo::Runtime::Table::_make_row = sub { my $self = shift; my %p = @_; if ( delete $p{no_cache} ) { return $self->$real_make_row( %p, state => 'Alzabo::Runtime::RowState::Live', ); } my $id = Alzabo::Runtime::Row->id_as_string_ext ( pk => $p{pk}, table => $p{table}, ); my $table_name = $p{table}->name; return $CACHE{$table_name}{$id} if exists $CACHE{$table_name}{$id}; my $row = $self->$real_make_row( %p, state => 'Alzabo::Runtime::RowState::InCache', ); return unless $row; Alzabo::Runtime::UniqueRowCache->write_to_cache($row); return $row; }; } sub clear { %CACHE = () }; sub clear_table { delete $CACHE{ $_[1]->name } } sub row_in_cache { return $CACHE{ $_[1] }{ $_[2] } } sub delete_from_cache { delete $CACHE{ $_[1] }{ $_[2] } } sub write_to_cache { $CACHE{ $_[1]->table->name }{ $_[1]->id_as_string } = $_[1] } 1; __END__ =head1 NAME Alzabo::Runtime::UniqueRowCache - Implements a row cache for Alzabo =head1 SYNOPSIS use Alzabo::Runtime::UniqueRowCache; Alzabo::Runtime::UniqueRowCache->clear(); =head1 DESCRIPTION This is a very simple caching mechanism for C objects that tries to ensure that for there is never more than one row object in memory for a given database row. To use it, simply load it. It can be foiled through the use of C or other "deep magic" cloning code, like in the C module. The cache is a simple hash kept in memory. If you use this module, you are responsible for clearing the cache as needed. The only time it is cleared automatically is when a table update or delete is performed, in which case all cached rows for that table are cleared. In a persistent environment like mod_perl, you should clear the cache on a regular basis in order to prevent the cache from getting out of sync with the database. A good way to do this is to clear it at the start of every request. =head1 METHODS All methods provided are class methods. =over 4 =item * clear This clears the entire cache =item * clear_table( $table_object ) Given a table object, this method clears all the cached rows from that table. =item * row_in_cache( $table_name, $row_id ) Given a table I and a row id, as returned by the C<< Alzabo::Runtime::Row->id_as_string >> method, this method returns the matching row from the cache, if it exists. Otherwise it returns undef. =item * delete_from_cache( $table_name, $row_id ) Given a table I and a row id, as returned by the C<< Alzabo::Runtime::Row->id_as_string >> method, this method returns the matching row from the cache. =item * write_to_cache( $row_object ) Given a row object, this method stores it in the cache. =back =head1 AVOIDING THE CACHE If you want to not cache a row, then you can pass the "no_cache" parameter to any table or schema method that creates a new row object or a cursor, such as C<< Alzabo::Runtime::Table->insert() >>, C<< Alzabo::Runtime::Table->rows_where() >>. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/RowCursor.pm0000444000175000017500000000715510721343227020427 0ustar autarchautarchpackage Alzabo::Runtime::RowCursor; use strict; use vars qw($VERSION); use Alzabo::Exceptions; use Alzabo::Runtime; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); use base qw( Alzabo::Runtime::Cursor ); $VERSION = 2.0; use constant NEW_SPEC => { statement => { isa => 'Alzabo::DriverStatement' }, table => { isa => 'Alzabo::Runtime::Table' }, }; sub new { my $proto = shift; my $class = ref $proto || $proto; my %p = validate( @_, NEW_SPEC ); my $self = bless { %p, count => 0, }, $class; return $self; } sub next { my $self = shift; my $row; # This loop is intended to allow the end caller to ignore rows # that can't be created because they're not in the table. # # For example, imagine that query in the statement is looking at # table 'foo' to get PK values for table 'bar'. If table 'foo' # has a record indicating that there is a row in 'bar' where PK == # 1 but no such row actually exists then we want to skip this. # # If they really want to know we do save the exception. until ( defined $row ) { my @row = $self->{statement}->next; last unless @row && grep { defined } @row; my %hash; my @pk = $self->{table}->primary_key; @hash{ map { $_->name } @pk } = @row[0..$#pk]; my %prefetch; if ( (my @pre = $self->{table}->prefetch) && @row > @pk ) { @prefetch{@pre} = @row[$#pk + 1 .. $#row]; } $row = $self->{table}->row_by_pk( @_, pk => \%hash, prefetch => \%prefetch, %{ $self->{row_params} }, ); } return unless $row; $self->{count}++; return $row; } sub all_rows { my $self = shift; my @rows; while ( my $row = $self->next ) { push @rows, $row; } $self->{count} = scalar @rows; return @rows; } 1; __END__ =head1 NAME Alzabo::Runtime::RowCursor - Cursor that returns C objects =head1 SYNOPSIS use Alzabo::Runtime::RowCursor; my $cursor = $schema->table('foo')->all_rows; while ( my $row = $cursor->next ) { print $row->select('foo'), "\n"; } =head1 DESCRIPTION Objects in this class are used to return L|Alzabo::Runtime::Row> objects for queries. The cursor does not preload objects but creates them on demand, which is much more efficient. For more details on the rational please see L. =head1 INHERITS FROM L|Alzabo::Runtime::Cursor> =head1 METHODS =head2 next Returns the next L|Alzabo::Runtime::Row> object or undef if no more are available. =head2 all_rows Returns all the rows available from the current point onwards. This means that if there are five rows that will be returned when the object is created and you call C twice, calling all_rows after it will only return three. =head2 reset Resets the cursor so that the next L|next> call will return the first row of the set. =head2 count Returns the number of rows returned by the cursor so far. =head2 next_as_hash Return the next row in a hash, where the hash key is the table name and the hash value is the row object. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/InsertHandle.pm0000444000175000017500000001260510721343227021036 0ustar autarchautarchpackage Alzabo::Runtime::InsertHandle; use strict; use Alzabo::Exceptions ( abbr => [ qw( exception params_exception ) ] ); use Alzabo::Runtime; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { params_exception join '', @_ } ); use constant NEW_SPEC => { table => { isa => 'Alzabo::Runtime::Table' }, sql => { isa => 'Alzabo::SQLMaker' }, columns => { type => ARRAYREF }, values => { type => HASHREF, default => {} }, }; sub new { my $class = shift; my %p = validate( @_, NEW_SPEC ); my $self = bless \%p, $class; $self->{handle} = $self->{table}->schema->driver->statement_no_execute( sql => $p{sql}->sql ); return $self; } sub insert { my $self = shift; my %p = @_; %p = validate( @_, { ( map { $_ => { optional => 1 } } keys %p ), values => { type => HASHREF, default => {} }, }, ); my $vals = { %{ $self->{values} }, %{ $p{values} }, }; my $schema = $self->{table}->schema; my $driver = $schema->driver; my %ph = $self->{sql}->placeholders; my @val_order; while ( my ( $name, $i ) = each %ph ) { $val_order[$i] = $name; } foreach my $name ( keys %$vals ) { params_exception "Cannot provide a value for a column that was not specified ". "when the insert handle was created ($name)." unless exists $ph{$name}; } my @pk = $self->{table}->primary_key; foreach my $pk (@pk) { unless ( exists $vals->{ $pk->name } ) { if ( $pk->sequenced ) { $vals->{ $pk->name } = $driver->next_sequence_number($pk); } else { params_exception ( "No value provided for primary key (" . $pk->name . ") and no sequence is available." ); } } } foreach my $c ( @{ $self->{columns} } ) { delete $vals->{ $c->name } if ! defined $vals->{ $c->name } && defined $c->default; } my @fk = $self->{table}->all_foreign_keys; my %id; $schema->begin_work if @fk; eval { foreach my $fk (@fk) { $fk->register_insert( map { $_->name => $vals->{ $_->name } } $fk->columns_from ); } $self->{sql}->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; $self->{handle}->execute_no_result ( map { exists $vals->{$_} ? $vals->{$_} : undef } @val_order ); foreach my $pk (@pk) { $id{ $pk->name } = ( defined $vals->{ $pk->name } ? $vals->{ $pk->name } : $driver->get_last_id($self) ); } # must come after call to ->get_last_id for MySQL because the # id will no longer be available after the transaction ends. $schema->commit if @fk; }; if (my $e = $@) { eval { $schema->rollback }; rethrow_exception $e; } return unless defined wantarray; return $self->{table}->row_by_pk( pk => \%id, no_cache => $self->{no_cache}, %p, ); } 1; __END__ =head1 NAME Alzabo::Runtime::InsertHandle - A handle representing an insert =head1 SYNOPSIS my $handle = $table->insert_handle ( columns => [ $table->columns( 'name', 'job' ) ] ); my $faye_row = $handle->insert( values => { name => 'Faye', job => 'HK Pop Chanteuse' } ); my $guesch_row = $handle->insert( values => { name => 'Guesch', job => 'French Chanteuse and Dancer' } ); =head1 DESCRIPTION This object is analogous to a DBI statement handle, and can be used to insert multiple rows into a table more efficiently than repeatedly calling C<< Alzabo::Runtime::Table->insert() >>. =head1 METHODS Objects of this class provide one public method: =head2 insert This method is used to insert a new row into a table. It accepts the following parameters: =over 4 =item * values This should be a hash reference containing the values to be inserted into the table. If no value is given for a primary key column and the column is L<"sequenced"|Alzabo::Column/sequenced> then the primary key will be auto-generated. If values are not provided for other columns which were given when C<< Alzabo::Runtime::Table->insert_handle >> was called, this method first checks to see if a value was provided for the column when C<< Alzabo::Runtime::Table->insert_handle >> was called. If none was provided, then the column's default value is used. If column values were passed to C<< Alzabo::Runtime::Table->insert_handle >>, then these can be overridden by values passed to this method. It is not possible to override column values that were given as SQL functions when C<< Alzabo::Runtime::Table->insert_handle >> was called. =back This method returns a new L|Alzabo::Runtime::Row> object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =cut Alzabo-0.92/lib/Alzabo/Runtime/RowState/0000755000175000017500000000000010721343227017666 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/Runtime/RowState/Potential.pm0000444000175000017500000000465710721343227022175 0ustar autarchautarchpackage Alzabo::Runtime::RowState::Potential; use strict; use Alzabo::Runtime; use base qw(Alzabo::Runtime::RowState::Live); sub _init { my $class = shift; my $row = shift; my %p = @_; # Can't just call ->update here cause with MethodMaker there may # be update hooks that probably shouldn't be invoked here. foreach ( keys %{ $p{values} } ) { # This will throw an exception if the column doesn't exist. my $c = $row->table->column($_); Alzabo::Exception::Params->throw( error => "Column " . $c->name . " cannot be null." ) unless defined $p{values}->{$_} || $c->nullable || defined $c->default; $row->{data}{$_} = $p{values}->{$_}; } foreach my $c ( $row->table->columns ) { if ( defined $c->default ) { my $name = $c->name; $row->{data}{$name} = $c->default unless defined $row->{data}{$name}; } } return 1; } sub _get_data { my $class = shift; my $row = shift; my %data; @data{@_} = @{ $row->{data} }{@_}; return %data; } sub update { my $class = shift; my $row = shift; my %data = @_; foreach my $k (keys %data) { # This will throw an exception if the column doesn't exist. my $c = $row->table->column($k); Alzabo::Exception::NotNullable->throw ( error => $c->name . " column in " . $row->table->name . " table cannot be null.", column_name => $c->name, ) unless defined $data{$k} || $c->nullable || defined $c->default; } my $changed = 0; while ( my ( $k, $v ) = each %data ) { next if $row->_cached_data_is_same( $k, $data{$k} ); $row->{data}{$k} = $v; $changed = 1; } return $changed; } # doesn't need to do anything sub refresh { } sub delete { $_[1]->set_state( 'Alzabo::Runtime::RowState::Deleted' ); } sub id_as_string { '' } sub is_potential { 1 } sub is_live { 0 } sub is_deleted { 0 } 1; __END__ =head1 NAME Alzabo::Runtime::RowState::Potential - Row objects that are not in the database =head1 SYNOPSIS my $row = $table->potential_row; $row->make_live; # $row is now a _real_ row object! =head1 DESCRIPTION This state is used for potential rows, rows which do not yet exist in the database. =head1 METHODS See L|Alzabo::Runtime::Row>. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/RowState/Live.pm0000444000175000017500000001573710721343227021136 0ustar autarchautarchpackage Alzabo::Runtime::RowState::Live; use strict; use Alzabo::Exceptions; use Alzabo::Runtime; use Alzabo::Utils; sub _where { my $class = shift; my $row = shift; my $sql = shift; my ($pk1, @pk) = $row->table->primary_key; $sql->where( $pk1, '=', $row->{pk}{ $pk1->name } ); $sql->and( $_, '=', $row->{pk}{ $_->name } ) foreach @pk; } sub _init { my $class = shift; my $row = shift; my %p = @_; $row->{pk} = $row->_make_id_hash(%p); while ( my ($k, $v) = each %{ $row->{pk} } ) { $row->{data}{$k} = $v; } if ( $p{prefetch} ) { while ( my ($k, $v) = each %{ $p{prefetch} } ) { $row->{data}{$k} = $v; } } else { eval { $class->_get_prefetch_data($row) }; if ( my $e = $@ ) { return if isa_alzabo_exception( $e, 'Alzabo::Exception::NoSuchRow' ); rethrow_exception $e; } } unless ( keys %{ $row->{data} } > keys %{ $row->{pk} } ) { # Need to try to fetch something to confirm that this row exists! my $sql = ( $row->schema->sqlmaker-> select( ($row->table->primary_key)[0] )-> from( $row->table ) ); $class->_where($row, $sql); $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; return unless defined $row->schema->driver->one_row( sql => $sql->sql, bind => $sql->bind ); } return 1; } sub _get_prefetch_data { my $class = shift; my $row = shift; my @pre = $row->table->prefetch; return unless @pre; $class->_get_data( $row, @pre ); } sub _get_data { my $class = shift; my $row = shift; my %data; my @select; foreach my $col (@_) { if ( exists $row->{data}{$col} ) { $data{$col} = $row->{data}{$col}; } else { push @select, $col; } } return %data unless @select; my $sql = ( $row->schema->sqlmaker-> select( $row->table->columns(@select) )-> from( $row->table ) ); $class->_where($row, $sql); $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; my %d; @d{@select} = $row->schema->driver->one_row( sql => $sql->sql, bind => $sql->bind ) or $row->_no_such_row_error; while ( my( $k, $v ) = each %d ) { $row->{data}{$k} = $data{$k} = $v; } return %data; } sub id_as_string { my $class = shift; my $row = shift; my %p = @_; return $row->{id_string} if exists $row->{id_string}; $row->{id_string} = $row->id_as_string_ext( pk => $row->{pk}, table => $row->table ); return $row->{id_string}; } sub select { my $class = shift; my $row = shift; my @cols = @_ ? @_ : map { $_->name } $row->table->columns; my %data = $class->_get_data( $row, @cols ); return wantarray ? @data{@cols} : $data{ $cols[0] }; } sub select_hash { my $class = shift; my $row = shift; my @cols = @_ ? @_ : map { $_->name } $row->table->columns; return $class->_get_data( $row, @cols ); } sub update { my $class = shift; my $row = shift; my %data = @_; my $schema = $row->schema; my @fk; # this never gets populated unless referential integrity # checking is on my @set; my $includes_pk = 0; foreach my $k ( sort keys %data ) { # This will throw an exception if the column doesn't exist. my $c = $row->table->column($k); if ( $row->_cached_data_is_same( $k, $data{$k} ) ) { delete $data{$k}; next; } $includes_pk = 1 if $c->is_primary_key; Alzabo::Exception::NotNullable->throw ( error => $c->name . " column in " . $row->table->name . " table cannot be null.", column_name => $c->name, table_name => $c->table->name, schema_name => $schema->name, ) unless defined $data{$k} || $c->nullable || defined $c->default; push @fk, $row->table->foreign_keys_by_column($c) if $schema->referential_integrity; push @set, $c => $data{$k}; } return 0 unless keys %data; my $sql = ( $schema->sqlmaker->update( $row->table ) ); $sql->set(@set); $class->_where( $row, $sql ); # If we have foreign keys we'd like all the fiddling to be atomic. $schema->begin_work if @fk; eval { foreach my $fk (@fk) { $fk->register_update( map { $_->name => $data{ $_->name } } $fk->columns_from ); } $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; $schema->driver->do( sql => $sql->sql, bind => $sql->bind ); $schema->commit if @fk; }; if (my $e = $@) { eval { $schema->rollback }; rethrow_exception $e; } while ( my( $k, $v ) = each %data ) { # These can't be stored until they're fetched from the database again if ( Alzabo::Utils::safe_isa( $v, 'Alzabo::SQLMaker::Function' ) ) { delete $row->{data}{$k}; next; } $row->{data}{$k} = $v; } $row->_update_pk_hash if $includes_pk; return 1; } sub refresh { my $class = shift; my $row = shift; delete $row->{data}; $class->_get_prefetch_data($row); } sub delete { my $class = shift; my $row = shift; my $schema = $row->schema; my @fk; if ($schema->referential_integrity) { @fk = $row->table->all_foreign_keys; } my $sql = ( $schema->sqlmaker-> delete->from( $row->table ) ); $class->_where($row, $sql); $schema->begin_work if @fk; eval { foreach my $fk (@fk) { $fk->register_delete($row); } $sql->debug(\*STDERR) if Alzabo::Debug::SQL; print STDERR Devel::StackTrace->new if Alzabo::Debug::TRACE; $schema->driver->do( sql => $sql->sql, bind => $sql->bind ); $schema->commit if @fk; }; if (my $e = $@) { eval { $schema->rollback }; rethrow_exception $e; } $row->set_state( 'Alzabo::Runtime::RowState::Deleted' ); } sub is_potential { 0 } sub is_live { 1 } sub is_deleted { 0 } 1; __END__ =head1 NAME Alzabo::Runtime::RowState::Live - Row objects representing rows in the database =head1 SYNOPSIS my $row = $table->row_by_pk( pk => 1 ); =head1 DESCRIPTION This state is used for live rows, rows which represent actual rows in the database. =head1 METHODS See L|Alzabo::Runtime::Row>. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/RowState/InCache.pm0000444000175000017500000000353610721343227021523 0ustar autarchautarchpackage Alzabo::Runtime::RowState::InCache; use strict; use base qw(Alzabo::Runtime::RowState::Live); BEGIN { no strict 'refs'; foreach my $meth ( qw( select select_hash ) ) { my $super = "SUPER::$meth"; *{__PACKAGE__ . "::$meth"} = sub { my $s = shift; $s->refresh(@_) unless $s->_in_cache(@_); $s->$super(@_); }; } } sub update { my $class = shift; my $row = shift; my $old_id = $row->id_as_string; $class->refresh($row) unless $class->_in_cache($row); my $changed = $class->SUPER::update( $row, @_ ); return $changed if exists $row->{id_string}; Alzabo::Runtime::UniqueRowCache->delete_from_cache( $row->table->name, $old_id ); Alzabo::Runtime::UniqueRowCache->write_to_cache($row); return $changed; } sub delete { my $class = shift; my $row = shift; my $old_id = $row->id_as_string; $class->SUPER::delete( $row, @_ ); Alzabo::Runtime::UniqueRowCache->delete_from_cache( $row->table->name, $old_id ); } sub refresh { my $class = shift; $class->SUPER::refresh(@_); # return if $class->_in_cache($row); #???? } sub _in_cache { return Alzabo::Runtime::UniqueRowCache->row_in_cache ( $_[1]->table->name, $_[1]->id_as_string ); } sub _write_to_cache { Alzabo::Runtime::UniqueRowCache->write_to_cache( $_[1] ); } 1; __END__ =head1 NAME Alzabo::Runtime::RowState::InCache - Cached row objects that represent actual database rows =head1 SYNOPSIS use Alzabo::Runtime::UniqueRowCache; my $row = $table->row_by_pk( pk => 1 ); =head1 DESCRIPTION This state is used for live rows that are cached via the C class. =head1 METHODS See L|Alzabo::Runtime::Row>. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/RowState/Deleted.pm0000444000175000017500000000133510721343227021572 0ustar autarchautarchpackage Alzabo::Runtime::RowState::Deleted; use strict; use Alzabo::Runtime; BEGIN { no strict 'refs'; foreach my $meth ( qw( select select_hash refresh update delete id_as_string ) ) { *{__PACKAGE__ . "::$meth"} = sub { $_[1]->_no_such_row_error }; } } sub is_potential { 0 } sub is_live { 0 } sub is_deleted { 1 } 1; __END__ =head1 NAME Alzabo::Runtime::RowState::Deleted - Row objects that have been deleted =head1 SYNOPSIS $row->delete; =head1 DESCRIPTION This state is used for deleted rows, any row upon which the C method has been called. =head1 METHODS See L|Alzabo::Runtime::Row>. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/Index.pm0000444000175000017500000000064310721343227017524 0ustar autarchautarchpackage Alzabo::Runtime::Index; use strict; use vars qw($VERSION); use Alzabo::Runtime; use base qw(Alzabo::Index); $VERSION = 2.0; 1; __END__ =head1 NAME Alzabo::Runtime::Index - Index objects =head1 SYNOPSIS use Alzabo::Runtime::Index; =for pod_merge DESCRIPTION =head1 INHERITS FROM C =for pod_merge merged =for pod_merge METHODS =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/ForeignKey.pm0000444000175000017500000001356010721343227020521 0ustar autarchautarchpackage Alzabo::Runtime::ForeignKey; use strict; use vars qw( $VERSION %DELETED ); use Alzabo::Runtime; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Params::Validate qw( validate ARRAYREF OBJECT ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use base qw(Alzabo::ForeignKey); $VERSION = 2.0; 1; # FIXME - needs docs sub new { my $proto = shift; my $class = ref $proto || $proto; validate( @_, { columns_from => { type => ARRAYREF | OBJECT }, columns_to => { type => ARRAYREF | OBJECT }, } ); my %p = @_; my $self = bless {}, $class; # XXX - needs a little more validation, like that both "sides" # have the same number of columns $self->{columns_from} = $p{columns_from}; $self->{columns_to} = $p{columns_to}; return $self; } sub register_insert { shift->_insert_or_update( 'insert', @_ ); } sub register_update { shift->_insert_or_update( 'update', @_ ); } sub _insert_or_update { my $self = shift; my $type = shift; my %vals = @_; my $driver = $self->table_from->schema->driver; my @one_to_one_where; my @one_to_one_vals; my $has_nulls = grep { ! defined } values %vals; foreach my $pair ( $self->column_pairs ) { # if we're inserting into a table we don't check if its primary # key exists elsewhere, no matter what the cardinality of the # relation. Otherwise, we end up in cycles where it is impossible # to insert things into the table. next if $type eq 'insert' && $pair->[0]->is_primary_key; # A table is always allowed to make updates to its own primary # key columns ... if ( ( $type eq 'update' || $pair->[1]->is_primary_key ) && ! $pair->[0]->is_primary_key ) { $self->_check_existence( $pair->[1] => $vals{ $pair->[0]->name } ) if defined $vals{ $pair->[0]->name }; } # Except when the PK has a one-to-one relationship to some # other table, and the update would cause a duplication in the # other table. if ( $self->is_one_to_one && ! $has_nulls ) { push @one_to_one_where, [ $pair->[0], '=', $vals{ $pair->[0]->name } ]; push @one_to_one_vals, $pair->[0]->name . ' = ' . $vals{ $pair->[0]->name }; } } if ( $self->is_one_to_one && ! $has_nulls ) { if ( @one_to_one_where && $self->table_from->row_count( where => \@one_to_one_where ) ) { my $err = '(' . (join ', ', @one_to_one_vals) . ') already exists in the ' . $self->table_from->name . ' table'; Alzabo::Exception::ReferentialIntegrity->throw( error => $err ); } } } sub _check_existence { my $self = shift; my ($col, $val) = @_; unless ( $self->table_to->row_count( where => [ $col, '=', $val ] ) ) { Alzabo::Exception::ReferentialIntegrity->throw( error => 'Foreign key must exist in foreign table. No rows in ' . $self->table_to->name . ' where ' . $col->name . " = $val" ); } } sub register_delete { my $self = shift; my $row = shift; my @update = grep { $_->nullable } $self->columns_to; return unless $self->to_is_dependent || @update; # Find the rows in the other table that are related to the row # being deleted. my @where = map { [ $_->[1], '=', $row->select( $_->[0]->name ) ] } $self->column_pairs; my $cursor = $self->table_to->rows_where( where => \@where ); while ( my $related_row = $cursor->next ) { # This is a class variable so that multiple foreign key # objects don't try to delete the same rows next if $DELETED{ $related_row->id_as_string }; if ($self->to_is_dependent) { local %DELETED = %DELETED; $DELETED{ $related_row->id_as_string } = 1; # dependent relationship so delete other row (may begin a # chain reaction!) $related_row->delete; } elsif (@update) { # not dependent so set the column(s) to null $related_row->update( map { $_->name => undef } @update ); } } } __END__ =head1 NAME Alzabo::Runtime::ForeignKey - Foreign key objects =head1 SYNOPSIS $fk->register_insert( $value_for_column ); $fk->register_update( $new_value_for_column ); $fk->register_delete( $row_being_deleted ); =head1 DESCRIPTION Objects in this class maintain referential integrity. This is really only useful when your RDBMS can't do this itself (like MySQL without InnoDB). =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =for pod_merge table_from =for pod_merge table_to =for pod_merge columns_from =for pod_merge columns_to =for pod_merge cardinality =for pod_merge from_is_dependent =for pod_merge to_is_dependent =for pod_merge is_one_to_one =for pod_merge is_one_to_many =for pod_merge is_many_to_one =for pod_merge is_same_relationship_as ($fk) =head2 register_insert ($new_value) This method takes the proposed column value for a new row and makes sure that it is valid based on relationship that this object represents. Throws: L|Alzabo::Exceptions> =head2 register_update ($new_value) This method takes the proposed new value for a column and makes sure that it is valid based on relationship that this object represents. Throws: L|Alzabo::Exceptions> =head2 register_delete (C object) Allows the foreign key to delete rows dependent on the row being deleted. Note, this can lead to a chain reaction of cascading deletions. You have been warned. Throws: L|Alzabo::Exceptions> =for pod_merge id =for pod_merge comment =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/Column.pm0000444000175000017500000000302710721343227017711 0ustar autarchautarchpackage Alzabo::Runtime::Column; use strict; use vars qw($VERSION); use Alzabo::Runtime; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); use base qw(Alzabo::Column); $VERSION = 2.0; sub alias_clone { my $self = shift; my %p = validate( @_, { table => { isa => 'Alzabo::Runtime::Table' }, } ); my $clone; %$clone = %$self; $clone->{table} = $p{table}; bless $clone, ref $self; return $clone; } sub alias { my $self = shift; my %p = validate( @_, { as => { type => SCALAR } } ); my $clone; %$clone = %$self; bless $clone, ref $self; $clone->{alias_name} = $p{as}; $clone->{real_column} = $self; return $clone; } sub alias_name { return $_[0]->{alias_name} || $_[0]->{name}; } 1; __END__ =head1 NAME Alzabo::Runtime::Column - Column objects =head1 SYNOPSIS use Alzabo::Runtime::Column; =for pod_merge DESCRIPTION =head1 INHERITS FROM C =for pod_merge merged =for pod_merge METHODS =head2 alias Takes the following parameters: =over 4 =item * as => $name =back This method returns an object that can be used in calls to the table and schema C methods in order to change the name given to the column if C is called on the L|Alzabo::Driver/Alzabo::DriverStatment> returned by the aforementioned C method. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime/JoinCursor.pm0000444000175000017500000001006110721343227020545 0ustar autarchautarchpackage Alzabo::Runtime::JoinCursor; use strict; use vars qw($VERSION); use Alzabo::Exceptions; use Alzabo::Runtime; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); use base qw( Alzabo::Runtime::Cursor ); $VERSION = 2.0; use constant NEW_SPEC => { statement => { isa => 'Alzabo::DriverStatement' }, tables => { type => ARRAYREF }, }; sub new { my $proto = shift; my $class = ref $proto || $proto; my %p = validate( @_, NEW_SPEC ); my $self = bless { %p, count => 0, }, $class; return $self; } sub next { my $self = shift; my @rows; my @data = $self->{statement}->next; return unless @data; my $i = 0; foreach my $t ( @{ $self->{tables} } ) { my %pk; my $def = 0; foreach my $c ( $t->primary_key ) { $pk{ $c->name } = $data[$i]; $def = 1 if defined $data[$i]; $i++; } unless ($def) { push @rows, undef; my @pre; if ( @pre = $t->prefetch ) { $i += @pre; } next; } my %prefetch; { my @pre; if ( @pre = $t->prefetch ) { @prefetch{@pre} = @data[ $i .. ($i + $#pre) ]; $i += @pre; } } my $row = $t->row_by_pk( pk => \%pk, prefetch => \%prefetch, @_, ); push @rows, $row; } $self->{count}++; return @rows; } sub all_rows { my $self = shift; my @all; while ( my @rows = $self->next ) { push @all, [@rows]; } $self->{count} = scalar @all; return @all; } 1; __END__ =head1 NAME Alzabo::Runtime::JoinCursor - Cursor that returns arrays of C objects =head1 SYNOPSIS use Alzabo::Runtime::JoinCursor; my $cursor = $schema->join( tables => [ $foo, $bar ], where => [ $foo->column('foo_id'), '=', 1 ] ); while ( my @rows = $cursor->next ) { print $rows[0]->select('foo'), "\n"; print $rows[1]->select('bar'), "\n"; } =head1 DESCRIPTION Objects in this class are used to return arrays of Alzabo::Runtime::Row objects when requested. The cursor does not preload objects but rather creates them on demand, which is much more efficient. For more details on the rational please see L. =head1 INHERITS FROM L|Alzabo::Runtime::Cursor> =head1 METHODS =head2 next Returns the next array of L|Alzabo::Runtime::Row> objects or an empty list if no more are available. If an individual row could not be fetched, then the array may contain some C values. For outer joins, this is normal behavior, but for regular joins, this probably indicates a data error. =head2 all_rows This method fetches all the rows available from the current point onwards. This means that if there are five set of rows that will be returned when the object is created and you call C twice, calling C after it will only return three sets. The return value is an array of array references. Each of these references represents a single set of rows as they would be returned from the C method. =head2 reset Resets the cursor so that the next L|next> call will return the first row of the set. =head2 count Returns the number of rowsets returned by the cursor so far. =head2 next_as_hash Returns the next rows in a hash, where the hash keys are the table names and the hash values are the row object. If a table has been included in the join via an outer join, then it is only included in the hash if there is a row for that table. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Index.pm0000444000175000017500000000647710721343227016114 0ustar autarchautarchpackage Alzabo::Index; use strict; use vars qw($VERSION); use Alzabo; use Tie::IxHash; $VERSION = 2.0; 1; sub columns { my $self = shift; my @c; foreach my $c ($self->{columns}->Keys) { push @c, ($self->{columns}->FETCH($c))->{column}; } return @c; } sub prefix { my $self = shift; my $c = shift; Alzabo::Exception::Params->throw( error => "Column " . $c->name . " is not part of index." ) unless $self->{columns}->EXISTS( $c->name ); return ($self->{columns}->FETCH( $c->name ))->{prefix}; } sub unique { $_[0]->{unique} } sub fulltext { $_[0]->{fulltext} } sub function { $_[0]->{function} } sub id { my $self = shift; my $function; if ( defined $self->function ) { ($function) = $self->function =~ /^(\w+)/; } return join '___', ( $self->{table}->name, # making this change would break schemas when the user tries to # delete/drop the index. save for later, maybe? # ( $self->unique ? 'U' : () ), # ( $self->fulltext ? 'F' : () ), ( $function ? $function : () ), ( map { $_->name, $self->prefix($_) || () } $self->columns ), ); } sub table { my $self = shift; return $self->{table}; } __END__ =head1 NAME Alzabo::Index - Index objects =head1 SYNOPSIS foreach my $i ($table->indexes) { foreach my $c ($i->columns) { print $c->name; print '(' . $i->prefix($c) . ')' if $i->prefix($c); } } =head1 DESCRIPTION This object represents an index on a table. Indexes consist of columns and optional prefixes for each column. The prefix specifies how many characters of the columns should be indexes (the first X chars). Some RDBMS's do not have a concept of index prefixes. Not all column types are likely to allow prefixes though this depends on the RDBMS. The order of the columns is significant. =head1 METHODS =head2 columns Returns an ordered list of the L|Alzabo::Column> objects that are being indexed. =head2 prefix (C object) A column prefix is, to the best of my knowledge, a MySQL specific concept, and as such cannot be set when using an RDBMSRules module for a different RDBMS. However, it is important enough for MySQL to have the functionality be present. It allows you to specify that the index should only look at a certain portion of a field (the first N characters). This prefix is required to index any sort of BLOB column in MySQL. This method returns the prefix for the column in the index. If there is no prefix for this column in the index, then it returns undef. =head2 unique Returns a boolean value indicating whether the index is a unique index. =head2 fulltext Returns a boolean value indicating whether the index is a fulltext index. =head2 function For function indexes, this returns the function being indexed. =head2 id The id is generated from the table, column and prefix information for the index. This is useful as a canonical name for a hash key, for example. Returns a string that is the id which uniquely identifies the index in this schema. =head2 table Returns the L|Alzabo::Table> object to which the index belongs. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/SQLMaker/0000755000175000017500000000000010721343227016112 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/SQLMaker/MySQL.pm0000444000175000017500000003311610721343227017417 0ustar autarchautarchpackage Alzabo::SQLMaker::MySQL; use strict; use vars qw($VERSION $AUTOLOAD @EXPORT_OK %EXPORT_TAGS); use Alzabo::Exceptions; use Alzabo::Utils; use Alzabo::SQLMaker; use base qw(Alzabo::SQLMaker); $VERSION = 2.0; my $MADE_FUNCTIONS; sub import { _make_functions() unless $MADE_FUNCTIONS; # used to export function functions require Exporter; *_import = \&Exporter::import; goto &_import; } sub _make_functions { local *make_function = \&Alzabo::SQLMaker::make_function; foreach ( [ PI => [ 'math' ] ], [ CURDATE => [ 'datetime' ] ], [ CURRENT_DATE => [ 'datetime' ] ], [ CURTIME => [ 'datetime' ] ], [ CURRENT_TIME => [ 'datetime' ] ], [ NOW => [ 'datetime', 'common' ] ], [ SYSDATE => [ 'datetime' ] ], [ CURRENT_TIMESTAMP => [ 'datetime' ] ], [ DATABASE => [ 'system' ] ], [ USER => [ 'system' ] ], [ SYSTEM_USER => [ 'system' ] ], [ SESSION_USER => [ 'system' ] ], [ VERSION => [ 'system' ] ], [ CONNECTION_ID => [ 'system' ] ], ) { make_function( function => $_->[0], min => 0, max => 0, groups => $_->[1] ); } foreach ( [ RAND => [ 'math' ] ], [ UNIX_TIMESTAMP => [ 'datetime' ] ], [ LAST_INSERT_ID => [ 'system' ] ], ) { make_function( function => $_->[0], min => 0, max => 1, quote => [0], groups => $_->[1] ); } make_function( function => 'CHAR', min => 1, max => undef, quote => [0], groups => [ 'string' ], ); foreach ( [ ENCRYPT => [1,1], [ 'misc' ] ] ) { make_function( function => $_->[0], min => 0, max => 1, quote => $_->[1], groups => $_->[2], ); } foreach ( [ MOD => [0,0], [ 'math' ] ], [ ROUND => [0,0], [ 'math' ] ], [ POW => [0,0], [ 'math' ] ], [ POWER => [0,0], [ 'math' ] ], [ ATAN2 => [0,0], [ 'math' ] ], [ POSITION => [1,1], [ 'string' ] ], [ INSTR => [1,1], [ 'string' ] ], [ LEFT => [1,1], [ 'string' ] ], [ RIGHT => [1,1], [ 'string' ] ], [ FIND_IN_SET => [1,1], [ 'string' ] ], [ REPEAT => [1,0], [ 'string' ] ], [ ENCODE => [1,1], [ 'misc' ] ], [ DECODE => [1,1], [ 'misc' ] ], [ FORMAT => [0,0], [ 'misc' ] ], [ PERIOD_ADD => [0,0], [ 'datetime' ] ], [ PERIOD_DIFF => [0,0], [ 'datetime' ] ], [ DATE_ADD => [1,0], [ 'datetime' ] ], [ DATE_SUB => [1,0] , [ 'datetime' ]], [ ADDDATE => [1,0], [ 'datetime' ] ], [ SUBDATE => [1,0], [ 'datetime' ] ], [ DATE_FORMAT => [1,1], [ 'datetime' ] ], [ TIME_FORMAT => [1,1], [ 'datetime' ] ], [ FROM_UNIXTIME => [0,1], [ 'datetime' ] ], [ GET_LOCK => [1,0], [ 'system' ] ], [ BENCHMARK => [0,1], [ 'system' ] ], [ MASTER_POS_WAIT => [1,0], [ 'system' ] ], [ IFNULL => [0,1], [ 'control' ] ], [ NULLIF => [0,0], [ 'control' ] ], ) { make_function( function => $_->[0], min => 2, max => 2, quote => $_->[1], groups => $_->[2], ); } foreach ( [ LEAST => [1,1,1], [ 'string' ] ], [ GREATEST => [1,1,1], [ 'string' ] ], [ CONCAT => [1,1,1], [ 'string' ] ], [ ELT => [0,1.1], [ 'string' ] ], [ FIELD => [1,1,1], [ 'string' ] ], [ MAKE_SET => [0,1,1], [ 'string' ] ], ) { make_function( function => $_->[0], min => 2, max => undef, quote => $_->[1], groups => $_->[2], ); } foreach ( [ LOCATE => [1,1,0], [ 'string' ] ], [ SUBSTRING => [1,0,0], [ 'string' ] ], [ CONV => [1,0,0], [ 'string' ] ], [ LPAD => [1,0,1], [ 'string' ] ], [ RPAD => [1,0,1], [ 'string' ] ], [ MID => [1,0,0], [ 'string' ] ], [ SUBSTRING_INDEX => [1,1,0], [ 'string' ] ], [ REPLACE => [1,1,1], [ 'string' ] ], [ IF => [0,1,1], [ 'control' ] ], ) { make_function( function => $_->[0], min => 3, max => 3, quote => $_->[1], groups => $_->[2], ); } foreach ( [ WEEK => [1,0], [ 'datetime' ] ], [ YEARWEEK => [1,0], [ 'datetime' ] ], ) { make_function( function => $_->[0], min => 1, max => 2, quote => $_->[1], groups => $_->[2], ); } make_function( function => 'CONCAT_WS', min => 3, max => undef, quote => [1,1,1,1], groups => [ 'string' ], ); make_function( function => 'EXPORT_SET', min => 3, max => 5, quote => [0,1,1,1,0], groups => [ 'string' ], ); make_function( function => 'INSERT', min => 3, max => 5, quote => [1,0,0,1], groups => [ 'string' ], ); foreach ( [ ABS => [0], [ 'math' ] ], [ SIGN => [0], [ 'math' ] ], [ FLOOR => [0], [ 'math' ] ], [ CEILING => [0], [ 'math' ] ], [ EXP => [0], [ 'math' ] ], [ LOG => [0], [ 'math' ] ], [ LOG10 => [0], [ 'math' ] ], [ SQRT => [0], [ 'math' ] ], [ COS => [0], [ 'math' ] ], [ SIN => [0], [ 'math' ] ], [ TAN => [0], [ 'math' ] ], [ ACOS => [0], [ 'math' ] ], [ ASIN => [0], [ 'math' ] ], [ ATAN => [0], [ 'math' ] ], [ COT => [0], [ 'math' ] ], [ DEGREES => [0], [ 'math' ] ], [ RADIANS => [0], [ 'math' ] ], [ TRUNCATE => [0], [ 'math' ] ], [ ASCII => [1], [ 'string' ] ], [ ORD => [1], [ 'string' ] ], [ BIN => [0], [ 'string' ] ], [ OCT => [0], [ 'string' ] ], [ HEX => [0], [ 'string' ] ], [ LENGTH => [1], [ 'string' ] ], [ OCTET_LENGTH => [1], [ 'string' ] ], [ CHAR_LENGTH => [1], [ 'string' ] ], [ CHARACTER_LENGTH => [1], [ 'string' ] ], [ TRIM => [1], [ 'string' ] ], [ LTRIM => [1], [ 'string' ] ], [ RTRIM => [1], [ 'string' ] ], [ SOUNDEX => [1], [ 'string' ] ], [ SPACE => [0], [ 'string' ] ], [ REVERSE => [1], [ 'string' ] ], [ LCASE => [1], [ 'string' ] ], [ LOWER => [1], [ 'string' ] ], [ UCASE => [1], [ 'string' ] ], [ UPPER => [1], [ 'string' ] ], [ RELEASE_LOCK => [1], [ 'system' ] ], [ DAYOFWEEK => [1], [ 'datetime' ] ], [ WEEKDAY => [1], [ 'datetime' ] ], [ DAYOFYEAR => [1], [ 'datetime' ] ], [ MONTH => [1], [ 'datetime' ] ], [ DAYNAME => [1], [ 'datetime' ] ], [ MONTHNAME => [1], [ 'datetime' ] ], [ QUARTER => [1], [ 'datetime' ] ], [ YEAR => [1], [ 'datetime' ] ], [ HOUR => [1], [ 'datetime' ] ], [ MINUTE => [1], [ 'datetime' ] ], [ SECOND => [1], [ 'datetime' ] ], [ TO_DAYS => [1], [ 'datetime' ] ], [ FROM_DAYS => [0], [ 'datetime' ] ], [ SEC_TO_TIME => [0], [ 'datetime' ] ], [ TIME_TO_SEC => [1], [ 'datetime' ] ], [ INET_NTOA => [0], [ 'misc' ] ], [ INET_ATON => [1], [ 'misc' ] ], [ COUNT => [0], [ 'aggregate', 'common' ] ], [ AVG => [0], [ 'aggregate', 'common' ] ], [ MIN => [0], [ 'aggregate', 'common' ] ], [ MAX => [0], [ 'aggregate', 'common' ] ], [ SUM => [0], [ 'aggregate', 'common' ] ], [ STD => [0], [ 'aggregate' ] ], [ STDDEV => [0], [ 'aggregate' ] ], [ BIT_OR => [0], [ 'misc' ] ], [ PASSWORD => [1], [ 'misc' ] ], [ MD5 => [1], [ 'misc' ] ], [ BIT_AND => [0], [ 'misc' ] ], [ LOAD_FILE => [1], [ 'misc' ] ], [ AGAINST => [1], [ 'fulltext' ] ], ) { make_function( function => $_->[0], min => 1, max => 1, quote => $_->[1], groups => $_->[2], ); } foreach ( [ MATCH => [0], [ 'fulltext' ] ], ) { make_function( function => $_->[0], min => 1, max => undef, quote => $_->[1], groups => $_->[2], ); } make_function( function => 'DISTINCT', min => 1, max => undef, quote => [0], groups => [ 'common' ], allows_alias => 0, ); make_function( function => 'IN_BOOLEAN_MODE', is_modifier => 1, groups => [ 'fulltext' ], ); $MADE_FUNCTIONS = 1; } sub init { 1; } sub select { my $self = shift; # # Special check for [ MATCH( $foo_col, $bar_col ), AGAINST('foo bar') ] # IN_BOOLEAN_MODE is optional # for ( my $i = 0; $i <= $#_; $i++ ) { if ( Alzabo::Utils::safe_isa( $_[$i], 'Alzabo::SQLMaker::Function' ) && $_[$i]->as_string( $self->{driver}, $self->{quote_identifiers} ) =~ /^\s*MATCH/i ) { $_[$i] = $_[$i]->as_string( $self->{driver}, $self->{quote_identifiers} ); $_[$i] .= ' ' . $_[$i + 1]->as_string( $self->{driver}, $self->{quote_identifiers} ); splice @_, $i + 1, 1; if ( defined $_[ $i + 1 ] && Alzabo::Utils::safe_isa( $_[ $i + 1 ], 'Alzabo::SQLMaker::Function' ) && $_[ $i + 1 ]->as_string( $self->{driver}, $self->{quote_identifiers} ) =~ /^\s*IN BOOLEAN MODE/i ) { $_[$i] .= ' ' . $_[$i + 1]->as_string( $self->{driver}, $self->{quote_identifiers} ); splice @_, $i + 1, 1; } } } $self->SUPER::select(@_); } sub condition { my $self = shift; # # Special check for [ MATCH( $foo_col, $bar_col ), AGAINST('foo bar') ] # IN_BOOLEAN_MODE is optional # if ( Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' ) && $_[0]->as_string( $self->{driver}, $self->{quote_identifiers} ) =~ /^\s*MATCH/i ) { $self->{last_op} = 'condition'; $self->{sql} .= join ' ', map { $_->as_string( $self->{driver}, $self->{quote_identifiers} ) } @_; } else { $self->SUPER::condition(@_); } } sub limit { my $self = shift; my ($max, $offset) = @_; $self->_assert_last_op( qw( from function where and or condition order_by group_by ) ); if ($offset) { $self->{sql} .= " LIMIT $offset, $max"; } else { $self->{sql} .= " LIMIT $max"; } $self->{last_op} = 'limit'; return $self; } sub get_limit { return undef; } sub sqlmaker_id { return 'MySQL'; } 1; __END__ =head1 NAME Alzabo::SQLMaker::MySQL - Alzabo SQL making class for MySQL =head1 SYNOPSIS use Alzabo::SQLMaker; my $sql = Alzabo::SQLMaker->new( sql => 'MySQL' ); =head1 DESCRIPTION This class implementes MySQL-specific SQL creation. MySQL does not allow subselects. Any attempt to use a subselect (by passing an C object in as parameter to a method) will result in an L|Alzabo::Exceptions> error. =head1 METHODS Almost all of the functionality inherited from Alzabo::SQLMaker is used as is. The only overridden methods are C and C, as MySQL does allow for a C clause in its SQL. =head1 EXPORTED SQL FUNCTIONS SQL may be imported by name or by tags. They take arguments as documented in the MySQL documentation (version 3.23.39). The functions (organized by tag) are: =head2 :math PI RAND MOD ROUND POW POWER ATAN2 ABS SIGN FLOOR CEILING EXP LOG LOG10 SQRT COS SIN TAN ACOS ASIN ATAN COT DEGREES RADIANS TRUNCATE =head2 :string CHAR POSITION INSTR LEFT RIGHT FIND_IN_SET REPEAT LEAST GREATEST CONCAT ELT FIELD MAKE_SET LOCATE SUBSTRING CONV LPAD RPAD MID SUBSTRING_INDEX REPLACE CONCAT_WS EXPORT_SET INSERT ASCII ORD BIN OCT HEX LENGTH OCTET_LENGTH CHAR_LENGTH CHARACTER_LENGTH TRIM LTRIM RTRIM SOUNDEX SPACE REVERSE LCASE LOWER UCASE UPPER =head2 :datetime CURDATE CURRENT_DATE CURTIME CURRENT_TIME NOW SYSDATE CURRENT_TIMESTAMP UNIX_TIMESTAMP WEEK PERIOD_ADD PERIOD_DIFF DATE_ADD DATE_SUB ADDDATE SUBDATE DATE_FORMAT TIME_FORMAT FROM_UNIXTIME DAYOFWEEK WEEKDAY DAYOFYEAR MONTH DAYNAME MONTHNAME QUARTER YEAR YEARWEEK HOUR MINUTE SECOND TO_DAYS FROM_DAYS SEC_TO_TIME TIME_TO_SEC =head2 :aggregate These are functions which operate on an aggregate set of values all at once. COUNT AVG MIN MAX SUM STD STDDEV =head2 :system These are functions which return information about the MySQL server. DATABASE USER SYSTEM_USER SESSION_USER VERSION CONNECTION_ID LAST_INSERT_ID GET_LOCK RELEASE_LOCK BENCHMARK MASTER_POS_WAIT =head2 :control These are flow control functions: IFNULL NULLIF IF =head2 :misc These are functions which don't fit into any other categories. ENCRYPT ENCODE DECODE FORMAT INET_NTOA INET_ATON BIT_OR BIT_AND PASSWORD MD5 LOAD_FILE =head2 :fulltext These are functions related to MySQL's fulltext searching capabilities. MATCH AGAINST IN_BOOLEAN_MODE NOTE: In MySQL 4.0 and greater, it is possible to say that a search is in boolean mode in order to change how MySQL handles the argument given to AGAINST. This will not work with earlier versions. =head2 :common These are functions from other groups that are most commonly used. NOW COUNT AVG MIN MAX SUM DISTINCT =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/SQLMaker/PostgreSQL.pm0000444000175000017500000001655610721343227020466 0ustar autarchautarchpackage Alzabo::SQLMaker::PostgreSQL; use strict; use vars qw($VERSION $AUTOLOAD @EXPORT_OK %EXPORT_TAGS); use Alzabo::Exceptions; use Alzabo::SQLMaker; use base qw(Alzabo::SQLMaker); $VERSION = 2.0; my $MADE_FUNCTIONS; sub import { _make_functions() unless $MADE_FUNCTIONS; # used to export function functions require Exporter; *_import = \&Exporter::import; goto &_import; } sub _make_functions { local *make_function = \&Alzabo::SQLMaker::make_function; foreach ( [ NOW => [ 'datetime', 'common' ] ], [ CURRENT_DATE => [ 'datetime' ], { no_parens => 1 } ], [ CURRENT_TIME => [ 'datetime' ], { no_parens => 1 } ], [ CURRENT_TIMESTAMP => [ 'datetime' ], { no_parens => 1 } ], [ TIMEOFDAY => [ 'datetime' ] ], [ PI => [ 'math' ] ], [ RANDOM => [ 'math' ] ], [ CURRENT_USER => [ 'system' ] ], [ SYSTEM_USER => [ 'system' ] ], [ USER => [ 'system' ] ], ) { make_function( function => $_->[0], min => 0, max => 0, groups => $_->[1], $_->[2] ? %{ $_->[2] } : (), ); } foreach ( [ LENGTH => [1], [ 'string' ] ], [ CHAR_LENGTH => [1], [ 'string' ] ], [ CHARACTER_LENGTH => [1], [ 'string' ] ], [ OCTET_LENGTH => [1], [ 'string' ] ], [ TRIM => [1], [ 'string' ] ], [ UPPER => [1], [ 'string' ] ], [ LOWER => [1], [ 'string' ] ], [ INITCAP => [1], [ 'string' ] ], [ ASCII => [1], [ 'string' ] ], [ ABS => [0], [ 'math' ] ], [ CEIL => [0], [ 'math' ] ], [ DEGREES => [0], [ 'math' ] ], [ FLOOR => [0], [ 'math' ] ], [ FACTORIAL => [0], [ 'math' ] ], [ SQRT => [0], [ 'math' ] ], [ CBRT => [0], [ 'math' ] ], [ EXP => [0], [ 'math' ] ], [ LN => [0], [ 'math' ] ], [ RADIANS => [0], [ 'math' ] ], [ ACOS => [0], [ 'math' ] ], [ ASIN => [0], [ 'math' ] ], [ ATAN => [0], [ 'math' ] ], [ COS => [0], [ 'math' ] ], [ COT => [0], [ 'math' ] ], [ SIN => [0], [ 'math' ] ], [ TAN => [0], [ 'math' ] ], [ ISFINITE => [1], [ 'datetime' ] ], [ BROADCAST => [1], [ 'network' ] ], [ HOST => [1], [ 'network' ] ], [ NETMASK => [1], [ 'network' ] ], [ MASKLEN => [1], [ 'network' ] ], [ NETWORK => [1], [ 'network' ] ], [ TEXT => [1], [ 'network' ] ], [ ABBREV => [1], [ 'network' ] ], ) { make_function( function => $_->[0], min => 1, max => 1, quote => $_->[1], groups => $_->[2], ); } foreach ( [ TO_ASCII => [1,0], [ 'string' ] ], [ ROUND => [0,0], [ 'math' ] ], [ TRUNC => [0,0], [ 'math' ] ], [ LOG => [0,0], [ 'math' ] ], [ POW => [0,0], [ 'math' ] ], [ TIMESTAMP => [1,1], [ 'datetime' ] ], ) { make_function( function => $_->[0], min => 1, max => 2, quote => $_->[1], groups => $_->[2], ); } foreach ( [ STRPOS => [1,1], [ 'string' ] ], [ POSITION => [1,1], [ 'string' ], '%s IN %s' ], [ TO_NUMBER => [1,1], [ 'string' ] ], [ TO_DATE => [1,1], [ 'string' ] ], [ TO_TIMESTAMP => [1,1], [ 'string' ] ], [ REPEAT => [1,0], [ 'string' ] ], [ MOD => [0,0], [ 'math' ] ], [ ATAN2 => [0,0], [ 'math' ] ], [ TO_CHAR => [0,1], [ 'math', 'datetime' ] ], [ DATE_PART => [1,1], [ 'datetime' ] ], [ EXTRACT => [0,1], [ 'datetime' ], '%s FROM %s' ], [ DATE_TRUNC => [1,1], [ 'datetime' ] ], [ NULLIF => [0,0], [ 'control' ] ], ) { make_function( function => $_->[0], min => 2, max => 2, quote => $_->[1], groups => $_->[2], $_->[3] ? ( format => $_->[3] ) : (), ); } foreach ( [ RPAD => [0,0,1], [ 'string' ] ], [ LPAD => [0,0,1], [ 'string' ] ], [ SUBSTR => [0,0,0], [ 'string' ] ], ) { make_function( function => $_->[0], min => 2, max => 3, quote => $_->[1], groups => $_->[2], ); } make_function( function => 'COALESCE', min => 2, max => undef, quote => [0,0,0], groups => [ 'control' ], ); make_function( function => 'OVERLAPS', min => 4, max => 4, quote => [1,1,1,1], groups => [ 'datetime' ], ); foreach ( [ COUNT => [0], [ 'aggregate', 'common' ] ], [ AVG => [0], [ 'aggregate', 'common' ] ], [ MIN => [0], [ 'aggregate', 'common' ] ], [ MAX => [0], [ 'aggregate', 'common' ] ], [ SUM => [0], [ 'aggregate', 'common' ] ], [ STDDEV => [0], [ 'aggregate' ] ], [ VARIANCE => [0], [ 'aggregate' ] ], [ DISTINCT => [0], [ 'common' ] ], ) { make_function( function => $_->[0], min => 1, max => 1, quote => $_->[1], groups => $_->[2], ); } $MADE_FUNCTIONS = 1; } sub init { 1; } sub new { my $self = shift->SUPER::new(@_); $self->{alias_in_having} = 0; return $self; } sub limit { my $self = shift; my ($max, $offset) = @_; $self->_assert_last_op( qw( from function where and or condition order_by group_by ) ); $self->{sql} .= " LIMIT $max"; $self->{sql} .= " OFFSET $offset" if $offset; $self->{last_op} = 'limit'; return $self; } sub get_limit { return undef; } sub distinct_requires_order_by_in_select { 1 } sub sqlmaker_id { return 'PostgreSQL'; } 1; __END__ =head1 NAME Alzabo::SQLMaker::PostgreSQL - Alzabo SQL making class for PostgreSQL =head1 SYNOPSIS use Alzabo::SQLMaker; my $sql = Alzabo::SQLMaker->new( sql => 'PostgreSQL' ); =head1 DESCRIPTION PostgreSQL-specific SQL creation. =head1 METHODS Almost all of the functionality inherited from C as is. The only overridden methods are C and C, as PostgreSQL does allow for a C clause in its SQL. =head1 EXPORTED SQL FUNCTIONS SQL may be imported by name or by tags. They take arguments as documented in the PostgreSQL documentation (version 3.23.39). The functions (organized by tag) are: =head2 :math PI RANDOM ABD CEIL DEGREES FLOOR FACTORIAL SQRT CBRT EXP LN RADIANS ACOS ASIN ATAN ATAN2 COS COT SIN TAN ROUND TRUNC LOG POW MOD TO_CHAR =head2 :string LENGTH CHAR_LENGTH CHARACTER_LENGTh OCTET_LENGTH TIRM UPPER LOWER INITCAP ASCII TO_ASCII STRPOS POSITION TO_NUMBER TO_DATE TO_TIMESTAMP REPEAT RPAD LPAD SUBSTR =head2 :datetime NOW CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP TIMEOFDAY ISFINIT TIMESTAMP TO_CHAR DATE_PART DATE_TRUNC EXTRACT OVERLAPS =head2 :network BROADCAST HOST NETMASK MASKLEN NETWORK TEXT ABBREV =head2 :aggregate These are functions which operate on an aggregate set of values all at once. COUNT AVG MIN MAX SUM STDDEV VARIANCE =head2 :system These are functions which return information about the Postgres server. CURRENT_USER SYSTEM_USER USER =head2 :control These are flow control functions: NULLIF COALESCE =head2 :misc These are functions which don't fit into any other categories. ENCRYPT ENCODE DECODE FORMAT INET_NTOA INET_ATON BIT_OR BIT_AND PASSWORD MD5 LOAD_FILE =head2 :common These are functions from other groups that are most commonly used. NOW COUNT AVG MIN MAX SUM DISTINCT =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/ForeignKey.pm0000444000175000017500000001102310721343227017066 0ustar autarchautarchpackage Alzabo::ForeignKey; use strict; use vars qw($VERSION); use Alzabo; $VERSION = 2.0; 1; sub table_from { my $self = shift; return ($self->columns_from)[0]->table; } sub table_to { my $self = shift; return ($self->columns_to)[0]->table; } sub columns_from { my $self = shift; return wantarray ? @{ $self->{columns_from} } : $self->{columns_from}[0]; } sub columns_to { my $self = shift; return wantarray ? @{ $self->{columns_to} } : $self->{columns_to}[0]; } sub column_pairs { my $self = shift; return ( map { [ $self->{columns_from}[$_] => $self->{columns_to}[$_] ] } 0..$#{ $self->{columns_from} } ); } sub column_pair_names { my $self = shift; return ( map { [ $self->{columns_from}[$_]->name => $self->{columns_to}[$_]->name ] } 0..$#{ $self->{columns_from} } ); } sub cardinality { my $self = shift; return @{ $self->{cardinality} }; } sub is_one_to_one { my $self = shift; my @c = $self->cardinality; return $c[0] eq '1' && $c[1] eq '1'; } sub is_one_to_many { my $self = shift; my @c = $self->cardinality; return $c[0] eq '1' && $c[1] eq 'n'; } sub is_many_to_one { my $self = shift; my @c = $self->cardinality; return $c[0] eq 'n' && $c[1] eq '1'; } sub from_is_dependent { return shift->{from_is_dependent}; } sub to_is_dependent { return shift->{to_is_dependent}; } sub is_same_relationship_as { my ($self, $other) = @_; return ( $self->id eq $other->id or $self->id eq $other->reverse->id ); } sub reverse { my $self = shift; return bless { table_from => $self->table_to, table_to => $self->table_from, columns_from => [ $self->columns_to ], columns_to => [ $self->columns_from ], from_is_dependent => $self->to_is_dependent, to_is_dependent => $self->from_is_dependent, cardinality => [ reverse @{ $self->{cardinality} } ], }, ref $self; } sub id { my $self = shift; return join '___', ( ( map { $_->name } $self->table_from, $self->table_to, $self->columns_from, $self->columns_to, ), $self->cardinality, $self->from_is_dependent, $self->to_is_dependent, ); } sub comment { $_[0]->{comment} } __END__ =head1 NAME Alzabo::ForeignKey - Foreign key (relation) objects =head1 SYNOPSIS use Alzabo::ForeignKey; foreach my $fk ($table->foreign_keys) { print $fk->cardinality; } =head1 DESCRIPTION A foreign key is an object defined by several properties. It represents a relationship from a column or columns in one table to a column or columns in another table. This relationship is defined by its cardinality (one to one, one to many, or many to one) and its dependencies (whether or not table X is dependent on table Y, and vice versa). Many to many relationships are not allowed. However, you may indicate such a relationship when using the Ladd_relation method|Alzabo::Create::Schema/add_relation> method, and it will create the necessary intermediate linking table for you. =head1 METHODS =head2 table_from =head2 table_to Returns the relevant L|Alzabo::Table> object. =head2 columns_from =head2 columns_to Returns the relevant L|Alzabo::Column> object(s) for the property as an array. =head2 column_pairs Returns an array of array references. The references are to two column array of L|Alzabo::Column> objects. These two columns correspond in the tables being linked together. =head2 cardinality Returns a two element array containing the two portions of the cardinality of the relationship. Each portion will be either '1' or 'n'. =head2 from_is_dependent =head2 to_is_dependent Returns a boolean value indicating whether there is a dependency from one table to the other. =head2 is_one_to_one =head2 is_one_to_many =head2 is_many_to_one Returns a boolean value indicating what kind of relationship the object represents. =head2 is_same_relationship_as ($fk) Given a foreign key object, this returns true if the two objects represent the same relationship. However, the two objects may represent the same relationship from different table's points of view. =head2 id Returns a string uniquely identifying the foreign key. =head2 comment Returns the comment associated with the foreign key object, if any. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Column.pm0000444000175000017500000001434510721343227016273 0ustar autarchautarchpackage Alzabo::Column; use strict; use vars qw($VERSION); use Alzabo; use Tie::IxHash; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; 1; sub table { $_[0]->{table}; } sub name { $_[0]->{name}; } sub nullable { $_[0]->{nullable}; } sub attributes { return keys %{ $_[0]->{attributes} }; } sub has_attribute { my $self = shift; my %p = validate( @_, { attribute => { type => SCALAR }, case_sensitive => { type => SCALAR, default => 0 } } ); if ( $p{case_sensitive} ) { return exists $self->{attributes}{ $p{attribute} }; } else { return 1 if grep { lc $p{attribute} eq lc $_ } keys %{ $self->{attributes} }; } } sub type { $_[0]->definition->type; } sub sequenced { $_[0]->{sequenced}; } sub default { $_[0]->{default}; } sub default_is_raw { $_[0]->{default_is_raw}; } sub length { $_[0]->definition->length; } sub precision { $_[0]->definition->precision; } sub definition { $_[0]->{definition}; } sub is_primary_key { $_[0]->table->column_is_primary_key($_[0]); } sub is_numeric { $_[0]->table->schema->rules->type_is_numeric($_[0]); } sub is_integer { $_[0]->table->schema->rules->type_is_integer($_[0]); } sub is_floating_point { $_[0]->table->schema->rules->type_is_floating_point($_[0]); } sub is_character { $_[0]->table->schema->rules->type_is_char($_[0]); } sub is_date { $_[0]->table->schema->rules->type_is_date($_[0]); } sub is_datetime { $_[0]->table->schema->rules->type_is_datetime($_[0]); } sub is_time { $_[0]->table->schema->rules->type_is_time($_[0]); } sub is_time_interval { $_[0]->table->schema->rules->type_is_time_interval($_[0]); } sub is_blob { $_[0]->table->schema->rules->type_is_blob($_[0]); } sub generic_type { my $self = shift; foreach my $type ( qw( integer floating_point character date datetime time blob ) ) { my $method = "is_$type"; return $type if $self->$method(); } return 'unknown'; } sub comment { $_[0]->{comment} } __END__ =head1 NAME Alzabo::Column - Column objects =head1 SYNOPSIS use Alzabo::Column; foreach my $c ($table->columns) { print $c->name; } =head1 DESCRIPTION This object represents a column. It holds data specific to a column. =head1 METHODS =head2 table Returns the table object to which this column belongs. =head2 name Returns the column's name as a string. =head2 nullable Returns a boolean value indicating whether or not NULLs are allowed in this column. =head2 attributes A column's attributes are strings describing the column (for example, valid attributes in MySQL are 'UNSIGNED' or 'ZEROFILL'. This method returns a list of strings of such strings. =head2 has_attribute This method can be used to test whether or not a column has a particular attribute. By default, the check is case-insensitive. It takes the following parameters: =over 4 =item * attribute => $attribute =item * case_sensitive => 0 or 1 (defaults to 0) =back It returns a boolean value indicating whether or not the column has this particular attribute. =head2 type Returns the column's type as a string. =head2 sequenced The meaning of a sequenced column varies from one RDBMS to another. In those with sequences, it means that a sequence is created and that values for this column will be drawn from it for inserts into this table. In databases without sequences, the nearest analog for a sequence is used (in MySQL the column is given the AUTO_INCREMENT attribute, in Sybase the identity attribute). In general, this only has meaning for the primary key column of a table with a single column primary key. Setting the column as sequenced means its value never has to be provided to when calling Cinsert>. Returns a boolean value indicating whether or not this column is sequenced. =head2 default Returns the default value of the column as a string, or undef if there is no default. =head2 default_is_raw Returns true if the default is intended to be provided to the DBMS as-is, without quoting, fore example C or C. =head2 length Returns the length attribute of the column, or undef if there is none. =head2 precision Returns the precision attribute of the column, or undef if there is none. =head2 is_primary_key Returns a boolean value indicating whether or not this column is part of its table's primary key. =head2 is_numeric Returns a boolean value indicating whether the column is a numeric type column. =head2 is_integer Returns a boolean value indicating whether the column is a numeric type column. =head2 is_floating_point Returns a boolean value indicating whether the column is a numeric type column. =head2 is_character Returns a boolean value indicating whether the column is a character type column. This is true only for any columns which are defined to hold I data, regardless of size. =head2 is_date Returns a boolean value indicating whether the column is a date type column. =head2 is_datetime Returns a boolean value indicating whether the column is a datetime type column. =head2 is_time Returns a boolean value indicating whether the column is a time type column. =head2 is_time_interval Returns a boolean value indicating whether the column is a time interval type column. =head2 is_blob Returns a boolean value indicating whether the column is a blob column. This is true for any columns defined to hold binary data, regardless of size. =head2 generic_type This methods returns one of the following strings: =over 4 =item integer =item floating_point =item character =item date =item datetime =item time =item blob =item unknown =back =head2 definition The definition object is very rarely of interest. Use the L|type> method if you are only interested in the column's type. This methods returns the L|Alzabo::ColumnDefinition> object which holds this column's type information. =head2 comment Returns the comment associated with the column object, if any. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Runtime.pm0000444000175000017500000001155010721343227016454 0ustar autarchautarchpackage Alzabo::Runtime; use strict; use Alzabo; use Alzabo::Runtime::Column; use Alzabo::Runtime::ColumnDefinition; use Alzabo::Runtime::ForeignKey; use Alzabo::Runtime::Index; use Alzabo::Runtime::InsertHandle; use Alzabo::Runtime::JoinCursor; use Alzabo::Runtime::Row; use Alzabo::Runtime::RowCursor; use Alzabo::Runtime::Schema; use Alzabo::Runtime::Table; use Alzabo::Utils; use vars qw($VERSION); $VERSION = 2.0; 1; sub import { shift; # ignore errors and let them be handled later in the app when it # tries to access the schema. eval { Alzabo::Runtime::Schema->load_from_file( name => $_ ); } foreach @_; } sub sqlmaker { my ($schema, $p) = @_; my %sqlmaker_p = ( exists $p->{quote_identifiers} ? ( quote_identifiers => $p->{quote_identifiers} ) : () ); return $schema->sqlmaker(%sqlmaker_p); } sub process_where_clause { my ($sql, $where) = @_; $where = [ $where ] unless Alzabo::Utils::is_arrayref( $where->[0] ) || $where->[0] eq '('; my $has_where = ( $sql->last_op eq 'where' || $sql->last_op eq 'condition' ) ? 1 : 0; _process_conditions( $sql, $has_where, $where, 'where' ); } sub process_having_clause { my ($sql, $having) = @_; $having = [ $having ] unless Alzabo::Utils::is_arrayref( $having->[0] ) || $having->[0] eq '('; my $has_having = ( $sql->last_op eq 'having' || $sql->last_op eq 'condition' ) ? 1 : 0; _process_conditions( $sql, $has_having, $having, 'having' ); } sub _process_conditions { my ($sql, $has_start, $conditions, $needed_op) = @_; my $needs_op = $sql->last_op eq 'where' || $sql->last_op eq 'having' ? 0 : 1; if ($has_start) { # wrap this in parens in order to protect from interactions with # join clauses $sql->and if $needs_op; $sql->subgroup_start; $needs_op = 0; } my $x = 0; foreach my $clause (@$conditions) { if (ref $clause) { Alzabo::Exception::Params->throw ( error => "Individual where clause components must be array references" ) unless Alzabo::Utils::is_arrayref($clause); Alzabo::Exception::Params->throw ( error => "Individual where clause components cannot be empty" ) unless @$clause; if ($needs_op) { my $op = $x || $has_start ? 'and' : $needed_op; $sql->$op(); } $sql->condition(@$clause); $needs_op = 1; } elsif (lc $clause eq 'and' || lc $clause eq 'or') { $sql->$clause(); $needs_op = 0; next; } elsif ($clause eq '(') { if ($needs_op) { my $op = $x || $has_start ? 'and' : $needed_op; $sql->$op(); } $sql->subgroup_start; $needs_op = 0; } elsif ($clause eq ')') { $sql->subgroup_end; $needs_op = 1; } else { Alzabo::Exception::Params->throw( error => "Invalid where clause specification: $clause" ); } $x++; } $sql->subgroup_end if $has_start; } sub process_order_by_clause { _process_by_clause(@_, 'order'); } sub process_group_by_clause { _process_by_clause(@_, 'group'); } sub _process_by_clause { my ($sql, $by, $type) = @_; my @items; if ( Alzabo::Utils::safe_isa( $by, 'Alzabo::Column' ) || Alzabo::Utils::safe_isa( $by, 'Alzabo::SQLMaker::Function' ) ) { @items = $by; } elsif ( Alzabo::Utils::is_arrayref($by) ) { @items = @$by; } my $method = "${type}_by"; $sql->$method(@items); } __END__ =head1 NAME Alzabo::Runtime - Loads all Alzabo::Runtime::* classes =head1 SYNOPSIS use Alzabo::Runtime qw( schema_name ); =head1 DESCRIPTION Using this module loads Alzabo::Runtime::* modules. These modules are what an end user of Alzabo uses to instantiate objects representing data in a given schema. =head1 import METHOD This method is called when you C this class. You can pass an array of strings to the module via the C function. These strings are assumed to be the names of schema objects that you want to load. This can be useful if you are running under a mod_perl (or similar) environment and has the potential to save some memory by preloading the objects before a fork, hopefully increasing shared memory. This method explicitly ignores errors that may occur when trying to load a particular schema. This means that later attempts to retrieve that schema will probably also fail. This is done so that the application that wants a particular schema can explicitly handle the failure later on. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/ChangeTracker.pm0000444000175000017500000000422310721343227017531 0ustar autarchautarchpackage Alzabo::ChangeTracker; use strict; use vars qw( $VERSION $STACK @CHANGES ); $VERSION = 2.0; use Params::Validate qw( :all ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); 1; sub new { my $proto = shift; my $class = ref $proto || $proto; ++$STACK; my $self = $STACK; bless \$self, $class; } sub add { my $self = shift; validate_pos( @_, { type => CODEREF } ); push @CHANGES, shift; } sub backout { my $self = shift; $_->() foreach @CHANGES; @CHANGES = (); } sub DESTROY { --$STACK; @CHANGES = () unless $STACK; } __END__ =head1 NAME Alzabo::ChangeTracker - Saves a set of changes as callbacks that can be backed out if needed =head1 SYNOPSIS use Alzabo::ChangeTracker; my $x = 0; my $y = 1; sub foo { my $tracker = Alzabo::ChangeTracker->new; $tracker->add( sub { $x = 0; } ); $x = 1; bar(); eval { something; }; $tracker->backout if $@; } sub bar { my $tracker = Alzabo::ChangeTracker->new; $tracker->add( sub { $y = 1; } ); $y = 2; } =head1 DESCRIPTION The trick ... We only want to have one object of this type at any one time. In addition, only the stack frame that created it should be able to clear it (except through a backout). Why? Here's an example in pseudo-code to help explain it: sub foo { create a tracker; store some change info in the tracker; call sub bar; store some change info in the tracker; # point Y clear changes in tracker; } sub bar { create a tracker; # internally, we really just increment our stack count store some change info in the tracker; clear changes in tracker; # point X } If at point X we were to really clear out the changes, even the changes just from sub bar, we'd have a problem. Because if at point Y, things go to hell and we want to back out the changes, we want to back out the changes from sub foo _AND_ sub bar. However, if bar is also an entry point we want to be able to track changes in bar and clear them from bar. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Create/0000755000175000017500000000000010721343227015676 5ustar autarchautarchAlzabo-0.92/lib/Alzabo/Create/ColumnDefinition.pm0000444000175000017500000001210710721343227021501 0ustar autarchautarchpackage Alzabo::Create::ColumnDefinition; use strict; use vars qw($VERSION); use Alzabo::Create; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Params::Validate qw( :all ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use base qw(Alzabo::ColumnDefinition); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; my $self = bless {}, $class; $self->_init(@_); return $self; } sub _init { my $self = shift; validate( @_, { owner => { isa => 'Alzabo::Create::Column' }, type => { type => SCALAR }, length => { type => UNDEF | SCALAR, optional => 1 }, precision => { type => UNDEF | SCALAR, optional => 1 }, } ); my %p = @_; $p{type} = $p{owner}->table->schema->rules->validate_column_type( $p{type}, $p{owner}->table ); foreach ( qw( owner type ) ) { $self->{$_} = $p{$_} if exists $p{$_}; } } sub alter { my $self = shift; validate( @_, { type => { type => SCALAR }, length => { type => UNDEF | SCALAR, optional => 1 }, precision => { type => UNDEF | SCALAR, optional => 1 }, } ); my %p = @_; my $old_type = $self->{type}; my $old_length = $self->{length}; my $old_precision = $self->{precision}; $self->{length} = $p{length} if exists $p{length}; $self->{precision} = $p{precision} if exists $p{precision}; eval { $self->{type} = $self->owner->table->schema->rules->validate_column_type($p{type}, $self->owner->table); $self->owner->table->schema->rules->validate_primary_key($self->owner) if $self->owner->is_primary_key; $self->owner->table->schema->rules->validate_column_length($self->owner); }; if ($@) { $self->{type} = $old_type; $self->{length} = $old_length; $self->{precision} = $old_precision; rethrow_exception($@); } } sub set_type { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $type = shift; my $old_type = $self->{type}; eval { $self->{type} = $self->owner->table->schema->rules->validate_column_type($type, $self->owner->table); $self->owner->table->schema->rules->validate_primary_key($self->owner) if eval { $self->owner->is_primary_key }; # eval ^^ cause if we're creating the column its not in the table yet }; if ($@) { $self->{type} = $old_type; rethrow_exception($@); } } sub set_length { my $self = shift; validate( @_, { length => { type => UNDEF | SCALAR }, precision => { type => UNDEF | SCALAR, optional => 1 } } ); my %p = @_; my $old_length = $self->{length}; my $old_precision = $self->{precision}; $self->{length} = $p{length}; $self->{precision} = $p{precision} if exists $p{precision}; eval { $self->owner->table->schema->rules->validate_column_length($self->owner); }; if ($@) { $self->{length} = $old_length; $self->{precision} = $old_precision; rethrow_exception($@); } } 1; __END__ =head1 NAME Alzabo::Create::ColumnDefinition - Column definition object for schema creation =head1 SYNOPSIS use Alzabo::Create::ColumnDefinition; =head1 DESCRIPTION This object holds information on a column that might need to be shared with another column. The reason this class exists is that if a column is a key in two or more tables, then some of the information related to that column should change automatically in multiple places whenever it changes at all. Right now this is only type ('VARCHAR', 'NUMBER', etc) and length/precision information. This object also has an 'owner', which is the column which created it. =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 new This method takes the following parameters: =over 4 =item * owner => C object =item * type => $type =back It returns a new C object. =head2 alter See the Lalter() >>|Alzabo::Column/alter> method for details. =for pod_merge type =head2 set_type ($string) Sets the object's type. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge length =for pod_merge precision =head2 set_length This method takes the following parameters: =over 4 =item * length => $length =item * precision => $precision (optional) =back Sets the column's length and precision. The precision parameter is optional (though some column types may require it if the length is set). Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge owner =cut Alzabo-0.92/lib/Alzabo/Create/Schema.pm0000444000175000017500000012035310721343227017436 0ustar autarchautarchpackage Alzabo::Create::Schema; use strict; use vars qw($VERSION); use Alzabo::ChangeTracker; use Alzabo::Config; use Alzabo::Create; use Alzabo::Driver; use Alzabo::Exceptions ( abbr => [ qw( params_exception system_exception ) ] ); use Alzabo::RDBMSRules; use Alzabo::Runtime; use Alzabo::SQLMaker; use Alzabo::Utils; use File::Spec; use Params::Validate qw( :all ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use Storable (); use Tie::IxHash; use base qw( Alzabo::Schema ); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; validate( @_, { rdbms => { type => SCALAR }, name => { type => SCALAR }, no_cache => { type => SCALAR, default => 0 }, } ); my %p = @_; my $self = bless {}, $class; params_exception "Alzabo does not support the '$p{rdbms}' RDBMS" unless ( ( grep { $p{rdbms} eq $_ } Alzabo::Driver->available ) && ( grep { $p{rdbms} eq $_ } Alzabo::RDBMSRules->available ) ); $self->{driver} = Alzabo::Driver->new( rdbms => $p{rdbms}, schema => $self ); $self->{rules} = Alzabo::RDBMSRules->new( rdbms => $p{rdbms} ); $self->{sql} = Alzabo::SQLMaker->load( rdbms => $p{rdbms} ); params_exception "Alzabo::Create::Schema->new requires a name parameter\n" unless exists $p{name}; $self->set_name($p{name}); $self->{tables} = Tie::IxHash->new; $self->_save_to_cache unless $p{no_cache}; return $self; } sub load_from_file { return shift->_load_from_file(@_); } sub reverse_engineer { my $proto = shift; my $class = ref $proto || $proto; my %p = @_; my $self = $class->new( name => $p{name}, rdbms => $p{rdbms}, no_cache => 1, ); delete $p{rdbms}; $self->{driver}->connect(%p); $self->{rules}->reverse_engineer($self); $self->set_instantiated(1); my $driver = delete $self->{driver}; $self->{original} = Storable::dclone($self); $self->{driver} = $driver; delete $self->{original}{original}; return $self; } sub set_name { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $name = shift; return if defined $self->{name} && $name eq $self->{name}; my $old_name = $self->{name}; $self->{name} = $name; eval { $self->rules->validate_schema_name($self); }; if ($@) { $self->{name} = $old_name; rethrow_exception($@); } # Gotta clean up old files or we have a mess! $self->delete( name => $old_name ) if $old_name; $self->set_instantiated(0); undef $self->{original}; } sub set_instantiated { my $self = shift; validate_pos( @_, 1 ); $self->{instantiated} = shift; } sub make_table { my $self = shift; my %p = @_; my %p2; foreach ( qw( before after ) ) { $p2{$_} = delete $p{$_} if exists $p{$_}; } $self->add_table( table => Alzabo::Create::Table->new( schema => $self, %p ), %p2 ); return $self->table( $p{name} ); } sub add_table { my $self = shift; validate( @_, { table => { isa => 'Alzabo::Create::Table' }, before => { optional => 1 }, after => { optional => 1 } } ); my %p = @_; my $table = $p{table}; params_exception "Table " . $table->name . " already exists in schema" if $self->{tables}->EXISTS( $table->name ); $self->{tables}->STORE( $table->name, $table ); foreach ( qw( before after ) ) { if ( exists $p{$_} ) { $self->move_table( $_ => $p{$_}, table => $table ); last; } } } sub delete_table { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Table' } ); my $table = shift; params_exception "Table " . $table->name ." doesn't exist in schema" unless $self->{tables}->EXISTS( $table->name ); foreach my $fk ($table->all_foreign_keys) { foreach my $other_fk ( $fk->table_to->foreign_keys_by_table($table) ) { $fk->table_to->delete_foreign_key($other_fk); } } $self->{tables}->DELETE( $table->name ); } sub move_table { my $self = shift; validate( @_, { table => { isa => 'Alzabo::Create::Table' }, before => { isa => 'Alzabo::Create::Table', optional => 1 }, after => { isa => 'Alzabo::Create::Table', optional => 1 } } ); my %p = @_; if ( exists $p{before} && exists $p{after} ) { params_exception "move_table method cannot be called with both 'before' and 'after' parameters"; } if ( $p{before} ) { params_exception "Table " . $p{before}->name . " doesn't exist in schema" unless $self->{tables}->EXISTS( $p{before}->name ); } else { params_exception "Table " . $p{after}->name . " doesn't exist in schema" unless $self->{tables}->EXISTS( $p{after}->name ); } params_exception "Table " . $p{table}->name . " doesn't exist in schema" unless $self->{tables}->EXISTS( $p{table}->name ); $self->{tables}->DELETE( $p{table}->name ); my $index; if ( $p{before} ) { $index = $self->{tables}->Indices( $p{before}->name ); } else { $index = $self->{tables}->Indices( $p{after}->name ) + 1; } $self->{tables}->Splice( $index, 0, $p{table}->name => $p{table} ); } sub register_table_name_change { my $self = shift; validate( @_, { table => { isa => 'Alzabo::Create::Table' }, old_name => { type => SCALAR } } ); my %p = @_; params_exception "Table $p{old_name} doesn't exist in schema" unless $self->{tables}->EXISTS( $p{old_name} ); my $index = $self->{tables}->Indices( $p{old_name} ); $self->{tables}->Replace( $index, $p{table}, $p{table}->name ); } sub add_relationship { my $self = shift; my %p = @_; my $tracker = Alzabo::ChangeTracker->new; $self->_check_add_relationship_args(%p); # This requires an entirely new table. unless ( grep { $_ ne 'n' } @{ $p{cardinality} } ) { $self->_create_linking_table(%p); return; } params_exception "Must provide 'table_from' or 'columns_from' parameter" unless $p{table_from} || $p{columns_from}; params_exception "Must provide 'table_to' or 'columns_to' parameter" unless $p{table_to} || $p{columns_to}; $p{columns_from} = ( defined $p{columns_from} ? ( Alzabo::Utils::is_arrayref( $p{columns_from} ) ? $p{columns_from} : [ $p{columns_from} ] ) : undef ); $p{columns_to} = ( defined $p{columns_to} ? ( Alzabo::Utils::is_arrayref( $p{columns_to} ) ? $p{columns_to} : [ $p{columns_to} ] ) : undef ); my $f_table = $p{table_from} || $p{columns_from}->[0]->table; my $t_table = $p{table_to} || $p{columns_to}->[0]->table; if ( $p{columns_from} && $p{columns_to} ) { params_exception "Cannot create a relationship with differing numbers of columns " . "on either side of the relation" unless @{ $p{columns_from} } == @{ $p{columns_to} }; } foreach ( [ columns_from => $f_table ], [ columns_to => $t_table ] ) { my ($key, $table) = @$_; if ( defined $p{$key} ) { params_exception "All the columns in a given side of the relationship ". "must be from the same table" if grep { $_->table ne $table } @{ $p{$key} }; } } # Determined later. This is the column that the relationship is # to. As in table A/column B maps _to_ table X/column Y my ($col_from, $col_to); # cardinality from -> to my $cardinality = ( $p{cardinality}->[0] eq '1' && $p{cardinality}->[1] eq '1' ? '1_to_1' : $p{cardinality}->[0] eq '1' && $p{cardinality}->[1] eq 'n' ? '1_to_n' : 'n_to_1' ); my $method = "_create_${cardinality}_relationship"; ($col_from, $col_to) = $self->$method( %p, table_from => $f_table, table_to => $t_table, ); eval { $f_table->make_foreign_key( columns_from => $col_from, columns_to => $col_to, cardinality => $p{cardinality}, from_is_dependent => $p{from_is_dependent}, to_is_dependent => $p{to_is_dependent}, comment => $p{comment}, ); }; if ($@) { $tracker->backout; rethrow_exception($@); } my @fk; eval { foreach my $c ( @$col_from ) { push @fk, $f_table->foreign_keys( table => $t_table, column => $c ); } }; if ($@) { $tracker->backout; rethrow_exception($@); } $tracker->add( sub { $f_table->delete_foreign_key($_) foreach @fk } ); # cardinality to -> to my $inverse_cardinality = ( $p{cardinality}->[1] eq '1' && $p{cardinality}->[0] eq '1' ? '1_to_1' : $p{cardinality}->[1] eq '1' && $p{cardinality}->[0] eq 'n' ? '1_to_n' : 'n_to_1' ); my $inverse_method = "_create_${inverse_cardinality}_relationship"; ($col_from, $col_to) = $self->$method( table_from => $t_table, table_to => $f_table, columns_from => $col_to, columns_to => $col_from, cardinality => [ @{ $p{cardinality} }[1,0] ], from_is_dependent => $p{to_is_dependent}, to_is_dependent => $p{from_is_dependent}, ); if ($p{from_is_dependent}) { $_->nullable(0) foreach @{ $p{columns_from} }; } if ($p{to_is_dependent}) { $_->nullable(0) foreach @{ $p{columns_to} }; } eval { $t_table->make_foreign_key( columns_from => $col_from, columns_to => $col_to, cardinality => [ @{ $p{cardinality} }[1,0] ], from_is_dependent => $p{to_is_dependent}, to_is_dependent => $p{from_is_dependent}, comment => $p{comment}, ); }; if ($@) { $tracker->backout; rethrow_exception($@); } } # old name - deprecated *add_relation = \&add_relationship; sub _check_add_relationship_args { my $self = shift; my %p = @_; foreach my $t ( $p{table_from}, $p{table_to} ) { next unless defined $t; params_exception "Table " . $t->name . " doesn't exist in schema" unless $self->{tables}->EXISTS( $t->name ); } params_exception "Incorrect number of cardinality elements" unless scalar @{ $p{cardinality} } == 2; foreach my $c ( @{ $p{cardinality} } ) { params_exception "Invalid cardinality: $c" unless $c =~ /^[01n]$/i; } # No such thing as 1..0 or n..0 params_exception "Invalid cardinality: $p{cardinality}->[0]..$p{cardinality}->[1]" if $p{cardinality}->[1] eq '0'; } sub _create_1_to_1_relationship { my $self = shift; my %p = @_; return @p{ 'columns_from', 'columns_to' } if $p{columns_from} && $p{columns_to}; # Add these columns to the table which _must_ participate in the # relationship, if there is one. This reduces NULL values. # Otherwise, just add to the first table specified in the # relation. my @order; # If the from table is dependent or neither one is or both are ... if ( $p{from_is_dependent} || $p{from_is_dependent} == $p{to_is_dependent} ) { @order = ( 'from', 'to' ); } # The to table is dependent else { @order = ( 'to', 'from' ); } # Determine which table we are linking from. This gets a new # column or has its column adjusted) ... my $f_table = $p{"table_$order[0]"}; # And which table we are linking to. We use the primary key from # this table if no column has been provided. my $t_table = $p{"table_$order[1]"}; # Determine whether there is a column in 'to' table we can use. my $col_to; if ( $p{"columns_$order[1]"} ) { $col_to = $p{"columns_$order[1]"}; } else { my @c = $t_table->primary_key; params_exception $t_table->name . " has no primary key." unless @c; $col_to = \@c; } my ($col_from); if ($p{"columns_$order[0]"}) { $col_from = $p{"columns_$order[0]"}; } else { my @new_col; foreach my $c ( @$col_to ) { push @new_col, $self->_add_foreign_key_column( table => $f_table, column => $c ); } $col_from = \@new_col; } return ($col_from, $col_to); } # This one's simple. We always add/adjust the column in the table on # the 'to' side of the relationship. This table only relates to one # row in the 'from' table, but a row in the 'from' table can relate to # 'n' rows in the 'to' table. sub _create_1_to_n_relationship { my $self = shift; my %p = @_; my $f_table = $p{table_from}; my $t_table = $p{table_to}; my $col_from; if ( $p{columns_from} ) { $col_from = $p{columns_from}; } else { my @c = $f_table->primary_key; # Is there a way to handle this properly? params_exception $f_table->name . " has no primary key." unless @c; $col_from = \@c; } my $col_to; if ($p{columns_to}) { $col_to = $p{columns_to}; } else { # If the columns this links to in the 'to' table ares not specified # explicitly we assume that the user wants to have this coumn # created/adjusted in the 'to' table. my @new_col; foreach my $c ( @$col_from ) { push @new_col, $self->_add_foreign_key_column( table => $t_table, column => $c ); } $col_to = \@new_col; } return ($col_from, $col_to); } sub _create_n_to_1_relationship { my $self = shift; my %p = @_; # reverse everything ... ($p{table_from}, $p{table_to}) = ($p{table_to}, $p{table_from}); ($p{columns_from}, $p{columns_to}) = ($p{columns_to}, $p{columns_from}); ($p{from_is_dependent}, $p{to_is_dependent}) = ($p{to_is_dependent}, $p{from_is_dependent}); # pass it into the inverse method and then swap the return values. # Tada! return ( $self->_create_1_to_n_relationship(%p) )[1,0]; } # Given two tables and a column, it will add the column to the table # if it doesn't exist. Otherwise, it adjusts the column in the table # to match the given column. In either case, the two columns (the one # passed to the method and the one altered/created) will share a # ColumnDefinition object. # This is called when a relationship is created and the columns aren't # specified. This means that changes to the column in one table are # automatically reflected in the other table, which is generally a # good thing. sub _add_foreign_key_column { my $self = shift; validate( @_, { table => { isa => 'Alzabo::Create::Table' }, column => { isa => 'Alzabo::Create::Column' } } ); my %p = @_; my $tracker = Alzabo::ChangeTracker->new; # Note: This code _does_ explicitly want to compare the string # representation of the $p{column}->definition reference. my $new_col; if ( eval { $p{table}->column( $p{column}->name ) } && ( $p{column}->definition ne $p{table}->column( $p{column}->name )->definition ) ) { # This will make the two column share a single definition # object. my $old_def = $p{table}->column( $p{column}->name )->definition; $p{table}->column( $p{column}->name )->set_definition($p{column}->definition); $tracker->add ( sub { $p{table}->column ( $p{column}->name )->set_definition($old_def) } ); } else { # Just add the new column, but use the existing definition # object. $p{table}->make_column( name => $p{column}->name, definition => $p{column}->definition ); my $del_col = $p{table}->column( $p{column}->name ); $tracker->add( sub { $p{table}->delete_column($del_col) } ); } # Return the new column we just made. return $p{table}->column( $p{column}->name ); } sub _create_linking_table { my $self = shift; my %p = @_; my $tracker = Alzabo::ChangeTracker->new; my $t1 = $p{table_from} || $p{columns_from}->[0]->table; my $t2 = $p{table_to} || $p{columns_to}->[0]->table; my $t1_col; if ($p{columns_from}) { $t1_col = $p{columns_from}; } else { my @c = $t1->primary_key; params_exception $t1->name . " has no primary key." unless @c; $t1_col = \@c; } my $t2_col; if ($p{columns_to}) { $t2_col = $p{columns_to}; } else { my @c = $t2->primary_key; params_exception $t2->name . " has no primary key." unless @c; $t2_col = \@c; } # First we create the table. my $linking; my $name; if ( exists $p{name} ) { $name = $p{name}; } elsif ( lc $t1->name eq $t1->name ) { $name = join '_', $t1->name, $t2->name; } else { $name = join '', $t1->name, $t2->name; } $linking = $self->make_table( name => $name ); $tracker->add( sub { $self->delete_table($linking) } ); eval { foreach my $c ( @$t1_col, @$t2_col ) { $linking->make_column( name => $c->name, definition => $c->definition, primary_key => 1, ); } $self->add_relationship ( table_from => $t1, table_to => $linking, columns_from => $t1_col, columns_to => [ $linking->columns( map { $_->name } @$t1_col ) ], cardinality => [ '1', 'n' ], from_is_dependent => $p{from_is_dependent}, to_is_dependent => 1, comment => $p{comment}, ); $self->add_relationship ( table_from => $t2, table_to => $linking, columns_from => $t2_col, columns_to => [ $linking->columns( map { $_->name } @$t2_col ) ], cardinality => [ '1', 'n' ], from_is_dependent => $p{to_is_dependent}, to_is_dependent => 1, comment => $p{comment}, ); }; if ($@) { $tracker->backout; rethrow_exception($@); } } sub instantiated { my $self = shift; return $self->{instantiated}; } sub create { my $self = shift; my %p = @_; my @sql = $self->make_sql; local $self->{db_schema_name} = delete $p{schema_name} if exists $p{schema_name}; $self->{driver}->create_database(%p) unless $self->_has_been_instantiated(%p); $self->{driver}->connect(%p); foreach my $statement (@sql) { $self->{driver}->do( sql => $statement ); } $self->save_current_name; $self->set_instantiated(1); my $driver = delete $self->{driver}; $self->{original} = Storable::dclone($self); $self->{driver} = $driver; delete $self->{original}{original}; } sub _has_been_instantiated { my $self = shift; my $db_schema_name = $self->db_schema_name; return 1 if grep { $db_schema_name eq $_ } $self->{driver}->schemas(@_); } sub make_sql { my $self = shift; if ($self->{instantiated}) { return $self->rules->schema_sql_diff( old => $self->{original}, new => $self ); } else { return $self->rules->schema_sql($self); } } sub sync_backend_sql { my $self = shift; my %p = @_; local $self->{db_schema_name} = delete $p{schema_name} if exists $p{schema_name}; unless ( $self->_has_been_instantiated(%p) ) { return $self->rules->schema_sql($self); } my $existing = $self->reverse_engineer( %p, name => $self->db_schema_name, rdbms => $self->driver->driver_id, ); return $self->rules->schema_sql_diff( old => $existing, new => $self ); } sub sync_backend { my $self = shift; my %p = @_; local $self->{db_schema_name} = delete $p{schema_name} if exists $p{schema_name}; unless ( $self->_has_been_instantiated(%p) ) { $self->set_instantiated(0); return $self->create(%p); } $self->{driver}->connect(%p); foreach my $statement ( $self->sync_backend_sql(%p) ) { $self->driver->do( sql => $statement ); } $self->save_current_name; $self->set_instantiated(1); my $driver = delete $self->{driver}; $self->{original} = Storable::dclone($self); $self->{driver} = $driver; delete $self->{original}{original}; } sub drop { my $self = shift; my %p = @_; local $self->{db_schema_name} = delete $p{schema_name} if exists $p{schema_name}; $self->{driver}->drop_database(%p); $self->set_instantiated(0); } sub delete { my $self = shift; my %p = @_; my $name = $p{name} || $self->name; my $schema_dir = File::Spec->catdir( Alzabo::Config::schema_dir(), $name ); my $dh = do { local *DH; }; opendir $dh, $schema_dir or system_exception "Unable to open $schema_dir directory: $!"; foreach my $f ( grep { /\.alz|\.rdbms|\.version/ } readdir $dh ) { my $file = File::Spec->catfile( $schema_dir, $f ); next unless -f $file; # untaint ($file) = $file =~ /^(.+)$/; unlink $file or system_exception "Unable to delete $file: $!"; } closedir $dh or system_exception "Unable to close $schema_dir: $!"; rmdir $schema_dir or system_exception "Unable to delete $schema_dir: $!"; } sub is_saved { my $self = shift; my %p = @_; my $name = $p{name} || $self->name; my $schema_dir = File::Spec->catdir( Alzabo::Config::schema_dir(), $name ); return -d $schema_dir; } sub save_to_file { my $self = shift; my $schema_dir = File::Spec->catdir( Alzabo::Config::schema_dir(), $self->{name} ); unless (-e $schema_dir) { mkdir $schema_dir, 0775 or system_exception "Unable to make directory $schema_dir: $!"; } my $create_save_name = $self->_base_filename( $self->{name} ) . '.create.alz'; my $fh = do { local *FH; }; open $fh, ">$create_save_name" or system_exception "Unable to write to $create_save_name: $!\n"; my $driver = delete $self->{driver}; Storable::nstore_fd( $self, $fh ) or system_exception "Can't store to filehandle"; $self->{driver} = $driver; close $fh or system_exception "Unable to close $create_save_name: $!"; my $rdbms_save_name = $self->_base_filename( $self->{name} ) . '.rdbms'; open $fh, ">$rdbms_save_name" or system_exception "Unable to write to $rdbms_save_name: $!\n"; print $fh $self->{driver}->driver_id or system_exception "Can't write to $rdbms_save_name: $!"; close $fh or system_exception "Unable to close $rdbms_save_name: $!"; my $version_save_name = $self->_base_filename( $self->{name} ) . '.version'; open $fh, ">$version_save_name" or system_exception "Unable to write to $version_save_name: $!\n"; print $fh $Alzabo::VERSION or system_exception "Can't write to $version_save_name: $!"; close $fh or system_exception "Unable to close $version_save_name: $!"; my $rt = $self->runtime_clone; my $runtime_save_name = $self->_base_filename( $self->{name} ) . '.runtime.alz'; open $fh, ">$runtime_save_name" or system_exception "Unable to write to $runtime_save_name: $!\n"; Storable::nstore_fd( $rt, $fh ) or system_exception "Can't store to filehandle"; close $fh or system_exception "Unable to close $runtime_save_name: $!"; $self->_save_to_cache; } sub clone { my $self = shift; validate( @_, { name => { type => SCALAR } } ); my %p = @_; my $driver = delete $self->{driver}; my $clone = Storable::dclone($self); $self->{driver} = $driver; $clone->{name} = $p{name}; $clone->{driver} = Alzabo::Driver->new( rdbms => $self->{driver}->driver_id, schema => $clone ); $clone->rules->validate_schema_name($clone); $clone->{original}{name} = $p{name} if $p{name}; $clone->set_instantiated(0); return $clone; } sub runtime_clone { my $self = shift; my %s; my $driver = delete $self->{driver}; my $clone = Storable::dclone($self); $self->{driver} = $driver; foreach my $f ( qw( original instantiated rules driver ) ) { delete $clone->{$f}; } foreach my $t ($clone->tables) { foreach my $c ($t->columns) { my $def = $c->definition; bless $def, 'Alzabo::Runtime::ColumnDefinition'; bless $c, 'Alzabo::Runtime::Column'; delete $c->{last_instantiation_name}; } foreach my $fk ($t->all_foreign_keys) { bless $fk, 'Alzabo::Runtime::ForeignKey'; } foreach my $i ($t->indexes) { bless $i, 'Alzabo::Runtime::Index'; } delete $t->{last_instantiation_name}; bless $t, 'Alzabo::Runtime::Table'; } bless $clone, 'Alzabo::Runtime::Schema'; return $clone; } sub save_current_name { my $self = shift; $self->{last_instantiated_name} = $self->name; foreach my $table ( $self->tables ) { $table->save_current_name; } } sub former_name { $_[0]->{last_instantiated_name} } # Overrides method in base to load create schema instead of runtime # schema sub _schema_file_type { return 'create'; } __END__ =head1 NAME Alzabo::Create::Schema - Schema objects for schema creation =head1 SYNOPSIS use Alzabo::Create::Schema; =head1 DESCRIPTION This class represents the whole schema. It contains table objects, which in turn contain columns, indexes, etc. It contains methods that act globally on the schema, including methods to save it to disk, create itself in an RDBMS, create relationships between tables, etc. =head2 Instantiation Every schema keeps track of whether it has been instantiated or not. A schema that is instantiated is one that exists in an RDBMS backend. This can be done explicitly by calling the schema's L|Alzabo::Create::Schema/create> method. It is also implicitly set when a schema is created as the result of L. The most important effect of instantiation is that once a schema is instantiated, the way it generates SQL for itself changes. Before it is instantiated, if you ask it to generate SQL via L the method|Alzabo::Create::Schema/make_sql>, it will generate the set of SQL statements that are needed to create the schema from scratch. After it is instantiated, the schema will instead generate the SQL necessary to convert the version in the RDBMS backend to match the object's current state. This can be thought of as a SQL 'diff'. While this feature is quite useful, it can be confusing too. The most surprising aspect of this is that if you create a schema via L and then call L method|Alzabo::Create::Schema/make_sql>, you will not get any SQL. This is because the schema knows that it is instantiated and it also knows that it is the same as the version in the RDBMS, so no SQL is necessary. You can use L method|Alzabo::Create::Schema/set_instantiated ($bool)> method to change whether or not the schem thinks it is instantiated. =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 Constructors =head2 new This constructor takes the following parameters: =over 4 =item * name => $name This is the name of the schema, and will be the name of the database in the RDBMS. =item * rdbms => $rdbms This is a string identifying the RDBMS. The allowed values are returned from the Lavailable>|Alzabo::RDBMSRules/available> method. These are values such as 'MySQL', 'PostgreSQL', etc. =back It returns a new C object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 load_from_file This constructor takes the following parameters: =over 4 =item * name => $schema_name =back Returns a schema object previously saved to disk, as specified by the "name" parameters. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 reverse_engineer Attempts to connect to a database and instantiate a new schema object based on information in the specified database. The returned object will have its instantiated value set to true so that subsequent changes will lead to SQL diffs, as opposed to SQL to create the database from scratch. The schema object returned by this method will have its instantiated attribute set as true. It takes the following parameters: =over 4 =item * name => $name The name of the database with which to connect. =item * rdbms => $rdbms See the L|new> method documentation for an explanation of this parameter. =back In addition, this method takes any parameters that can be used when connecting to the RDBMS, including "user", "password", "host", and "port". Returns a new C object. =head2 Other Methods =for pod_merge name =head2 set_name ($name) Changes the schema name. Since schemas are saved on disk with filenames based on the schema name, this deletes the files for the old name. Call L|save_to_file> immediately afterwards if you want to make sure you have a copy of the schema saved. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge table =for pod_merge tables =for pod_merge has_table =head2 make_table This method makes a new table and adds it to the schema, the parameters given are passed directly to the Lnew() >>|Alzabo::Create::Table/new> method. The "schema" parameter is filled in automatically. If a "before" or "after" parameter is given then the L|move_table> method will be called to move the new table to the appropriate position. Returns a new L|Alzabo::Create::Table> object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 delete_table (C object) Removes the given table from the schema. This method will also delete all foreign keys in other tables that point at the given table. Throws: L|Alzabo::Exceptions> =head2 add_table Add a table to the schema. This methods takes the following parameters: =over 4 =item * table => C object =item * after => C object (optional) ... or ... =item * before => C object (optional) =back Returns a new L|Alzabo::Create::Table> object. Throws: L|Alzabo::Exceptions> =head2 move_table Allows you to change the order of the tables as they are stored in the schema. This method takes the following parameters: =over 4 =item * table => C object The table to move. and either ... =item * before => C object Move the table before this table ... or ... =item * after => C object Move the table after this table. =back Throws: L|Alzabo::Exceptions> =head2 add_relationship Creates a relationship between two tables. This involves creating L|Alzabo::Create::ForeignKey> objects in both tables. If the "columns_from" and "columns_to" parameters are not specified then the schema object attempts to calculate the proper values for these attributes. To do this, Alzabo attempts to determine the dependencies of the tables. If you have specified a cardinality of 1..1, or n..1, in cases where both tables are independent, or where they are both dependent then the "table_from" is treated as being the dependent table for the purposes of determining If no columns with the same names exist in the other table, then columns with those names will be created. Otherwise, C changes the dependent columns so that their L|Alzabo::Create::ColumnDefinition> objects are the same as the columns in the table upon which they are dependent, meaning that changes to the type of one column affects both at the same time. If you want to make a multi-column relationship, the assumption is that the order of the columns is significant. In other words, the first column in the "columns_from" parameter should correspond to the first column in hte "columns_to" parameter and so on. The number of columns given in "columns_from" and "columns_to" must be the same except when creating a many to many relationship. If the cardinality is many to many then a new table will be created to link the two tables together. This table will contain the primary keys of both the tables passed into this function. It will contain foreign keys to both of these tables as well, and these tables will be linked to this new table. This method takes the following parameters: =over 4 =item * table_from => C object (optional if columns_from is provided) =item * table_to => C object (optional if columns_to is provided) =item * columns_from => C object (optional if table_from is provided) =item * columns_to => C object (optional if table_to is provided) =item * cardinality => [1, 1], [1, 'n'], ['n', 1], or ['n', 'n'] =item * name => $name If provided, and if the specified cardinality requires the creation of a linking table, this string will be used to name that linking table. Otherwise, the new table's name will be synthesized from the names of those it's linking. =item * from_is_dependent => $boolean =item * to_is_dependent => $boolean =item * comment => $comment =back Throws: L|Alzabo::Exceptions> =head2 create This method causes the schema to connect to the RDBMS, create a new database if necessary, and then execute whatever SQL is necessary to make that database match the current state of the schema object. If the schema has been instantiated previously, then it will generate the SQL necessary to change the database. This may be destructive (dropping tables, columns, etc) so be careful. This will cause the schema to be marked as instantiated. Wherever possible, existing data will be preserved. This method takes any parameters that can be used when connecting to the RDBMS, including "schema_name", "user", "password", "host", and "port". If a "schema_name" parameter is given, then this will be the name given to the schema in the RDBMS. B: Every time you call C or C, the schema will consider itself to have been instantiated. This will affect how schema diffs are generated. After this, you will almost certainly need to use C to sync the RDBMS schema, since the schema's internal notion of it's state may be incorrect. =head2 instantiated Returns a boolean value indicating whether the schema has been created in an RDBMS backend, otherwise it is false. =head2 set_instantiated ($bool) Set the schema's instantiated attribute as true or false. Throws: L|Alzabo::Exceptions> =head2 make_sql Returns an array containing the SQL statements necessary to either create the database from scratch or update the database to match the schema object. See the L|Alzabo::Create::Schema/create> method for more details. =head2 drop Drops the database/schema from the RDBMS. This will cause the schema to be marked as not instantiated. This method does not delete the Alzabo files from disk. To do this, call the C method. This method takes any parameters that can be used when connecting to the RDBMS, including "schema_name", "user", "password", "host", and "port". Throws: L|Alzabo::Exceptions> =head2 sync_backend This method will look at the schema as it exists in the RDBMS backend, and make any changes that are necessary in order to make this backend schema match the Alzabo schema object. If there is no corresponding schema in the RDBMS backend, then this method is equivalent to the L|Alzabo::Create::Schema/create> method. After this method is called, the schema will be considered to be instantiated. This method will never be perfect because some RDBMS backends alter table definitions as they are created. For example, MySQL has default column "lengths" for all of its integer columns. Alzabo tries to account for these. In the end, this means that Alzabo may never think that a schema in the RDBMS exactly matches the state of the Alzabo schema object. Even immediately after running this method, running it again may still cause it to execute SQL commands. Fortunately, the SQL it generates will not cause anything to break. This method takes any parameters that can be used when connecting to the RDBMS, including "schema_name", "user", "password", "host", and "port". Throws: L|Alzabo::Exceptions> =head2 sync_backend_sql If there is no corresponding schema in the RDBMS backend, then this method returns the SQL necessary to create the schema from scratch. This method takes any parameters that can be used when connecting to the RDBMS, including "schema_name", "user", "password", "host", and "port". Throws: L|Alzabo::Exceptions> =head2 delete Removes the schema object from disk. It does not delete the database from the RDBMS. To do this you must call the L|drop> method first. Throws: L|Alzabo::Exceptions> =head2 clone This method creates a new object identical to the one that the method was called on, except that this new schema has a different name, it does not yet exist on disk, its instantiation attribute is set to false. It takes the following parameters: =over 4 =item * name => $name =back This method returns a new Alzabo::Create::Schema object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 save_to_file Saves the schema to a file on disk. Throws: L|Alzabo::Exceptions> =head2 runtime_clone Returns a new C object based on the current schema. =head2 is_saved Returns true if the schema has been saved to disk. =for pod_merge begin_work =for pod_merge rollback =for pod_merge commit =for pod_merge run_in_transaction ( sub { code... } ) =for pod_merge driver =for pod_merge rules =for pod_merge sqlmaker =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Create/Table.pm0000444000175000017500000004361010721343227017265 0ustar autarchautarchpackage Alzabo::Create::Table; use strict; use vars qw($VERSION); use Alzabo::Create; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Params::Validate qw( :all ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use Tie::IxHash; use base qw(Alzabo::Table); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; validate( @_, { schema => { isa => 'Alzabo::Create::Schema' }, name => { type => SCALAR }, attributes => { type => ARRAYREF, optional => 1 }, comment => { type => UNDEF | SCALAR, default => '' }, } ); my %p = @_; my $self = bless {}, $class; $self->{schema} = $p{schema}; $self->set_name($p{name}); $self->{columns} = Tie::IxHash->new; $self->{pk} = []; $self->{indexes} = Tie::IxHash->new; my %attr; tie %{ $self->{attributes} }, 'Tie::IxHash'; $self->set_attributes( @{ $p{attributes} } ); $self->set_comment( $p{comment} ); # Setting this prevents run time type errors. $self->{fk} = {}; return $self; } sub set_name { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $name = shift; params_exception "Table $name already exists in schema" if $self->schema->has_table($name); my @i; if ($self->{indexes}) { @i = $self->indexes; $self->delete_index($_) foreach @i; } my $old_name = $self->{name}; $self->{name} = $name; eval { $self->schema->rules->validate_table_name($self); }; $self->add_index($_) foreach @i; if ($@) { $self->{name} = $old_name; rethrow_exception($@); } if ( $old_name && eval { $self->schema->table($old_name) } ) { $self->schema->register_table_name_change( table => $self, old_name => $old_name ); foreach my $fk ($self->all_foreign_keys) { $fk->table_to->register_table_name_change( table => $self, old_name => $old_name ); } } } sub make_column { my $self = shift; my %p = @_; my $is_pk = delete $p{primary_key}; my %p2; foreach ( qw( before after ) ) { $p2{$_} = delete $p{$_} if exists $p{$_}; } $self->add_column( column => Alzabo::Create::Column->new( table => $self, %p ), %p2 ); my $col = $self->column( $p{name} ); $self->add_primary_key($col) if $is_pk; return $col; } sub add_column { my $self = shift; validate( @_, { column => { isa => 'Alzabo::Create::Column' }, before => { optional => 1 }, after => { optional => 1 } } ); my %p = @_; my $col = $p{column}; params_exception "Column " . $col->name . " already exists in " . $self->name if $self->{columns}->EXISTS( $col->name ); $col->set_table($self) unless $col->table eq $self; $self->{columns}->STORE( $col->name, $col); foreach ( qw( before after ) ) { if ( exists $p{$_} ) { $self->move_column( $_ => $p{$_}, column => $col ); last; } } } sub delete_column { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Column' } ); my $col = shift; params_exception"Column $col doesn't exist in $self->{name}" unless $self->{columns}->EXISTS( $col->name ); $self->delete_primary_key($col) if $col->is_primary_key; foreach my $fk ($self->foreign_keys_by_column($col)) { $self->delete_foreign_key($fk); foreach my $other_fk ($fk->table_to->foreign_keys( table => $self, column => $fk->columns_to ) ) { $fk->table_to->delete_foreign_key( $other_fk ); } } foreach my $i ($self->indexes) { $self->delete_index($i) if grep { $_ eq $col } $i->columns; } $self->{columns}->DELETE( $col->name ); } sub move_column { my $self = shift; validate( @_, { column => { isa => 'Alzabo::Create::Column' }, before => { isa => 'Alzabo::Create::Column', optional => 1 }, after => { isa => 'Alzabo::Create::Column', optional => 1 } } ); my %p = @_; if ( exists $p{before} && exists $p{after} ) { params_exception "move_column method cannot be called with both 'before' and 'after' parameters"; } if ( exists $p{before} ) { params_exception "Column " . $p{before}->name . " doesn't exist in schema" unless $self->{columns}->EXISTS( $p{before}->name ); } else { params_exception "Column " . $p{after}->name . " doesn't exist in schema" unless $self->{columns}->EXISTS( $p{after}->name ); } params_exception "Column " . $p{column}->name . " doesn't exist in schema" unless $self->{columns}->EXISTS( $p{column}->name ); my @pk = $self->primary_key; $self->{columns}->DELETE( $p{column}->name ); my $index; if ( $p{before} ) { $index = $self->{columns}->Indices( $p{before}->name ); } else { $index = $self->{columns}->Indices( $p{after}->name ) + 1; } $self->{columns}->Splice( $index, 0, $p{column}->name => $p{column} ); $self->{pk} = [ $self->{columns}->Indices( map { $_->name } @pk ) ]; } sub add_primary_key { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Column' } ); my $col = shift; my $name = $col->name; params_exception "Column $name doesn't exist in $self->{name}" unless $self->{columns}->EXISTS($name); params_exception "Column $name is already a primary key" if $col->is_primary_key; $self->schema->rules->validate_primary_key($col); $col->set_nullable(0); my $idx = $self->{columns}->Indices($name); push @{ $self->{pk} }, $idx; } sub delete_primary_key { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Column' } ); my $col = shift; my $name = $col->name; params_exception "Column $name doesn't exist in $self->{name}" unless $self->{columns}->EXISTS($name); params_exception "Column $name is not a primary key" unless $col->is_primary_key; my $idx = $self->{columns}->Indices($name); $self->{pk} = [ grep { $_ != $idx } @{ $self->{pk} } ]; } sub make_foreign_key { my $self = shift; $self->add_foreign_key( Alzabo::Create::ForeignKey->new( @_ ) ); } sub add_foreign_key { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::ForeignKey' } ); my $fk = shift; foreach my $c ( $fk->columns_from ) { push @{ $self->{fk}{ $fk->table_to->name }{ $c->name } }, $fk; } if ( ( $fk->is_one_to_one || $fk->is_one_to_many ) && ! ( $self->primary_key_size == grep { $_->is_primary_key } $fk->columns_from ) ) { my $i = Alzabo::Create::Index->new( table => $self, columns => [ $fk->columns_from ], unique => 1 ); # could already have a non-unique index (grr, index id() # method is somewhat broken) $self->delete_index($i) if $self->has_index( $i->id ); $self->add_index($i); } } sub delete_foreign_key { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::ForeignKey' } ); my $fk = shift; foreach my $c ( $fk->columns_from ) { params_exception "Column " . $c->name . " doesn't exist in $self->{name}" unless $self->{columns}->EXISTS( $c->name ); } params_exception "No foreign keys to " . $fk->table_to->name . " exist in $self->{name}" unless exists $self->{fk}{ $fk->table_to->name }; my @new_fk; foreach my $c ( $fk->columns_from ) { params_exception "Column " . $c->name . " is not a foreign key to " . $fk->table_to->name . " in $self->{name}" unless exists $self->{fk}{ $fk->table_to->name }{ $c->name }; foreach my $current_fk ( @{ $self->{fk}{ $fk->table_to->name }{ $c->name } } ) { push @new_fk, $current_fk unless $current_fk eq $fk; } } foreach my $c ( $fk->columns_from ) { if (@new_fk) { $self->{fk}{ $fk->table_to->name }{ $c->name } = \@new_fk; } else { delete $self->{fk}{ $fk->table_to->name }{ $c->name }; } } delete $self->{fk}{ $fk->table_to->name } unless keys %{ $self->{fk}{ $fk->table_to->name } }; } sub make_index { my Alzabo::Table $self = shift; $self->add_index( Alzabo::Create::Index->new( table => $self, @_ ) ); } sub add_index { my Alzabo::Table $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Index' } ); my $i = shift; my $id = $i->id; params_exception "Index already exists (id $id)." if $self->{indexes}->EXISTS($id); $self->{indexes}->STORE( $id, $i ); return $i; } sub delete_index { my Alzabo::Table $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Index' } ); my $i = shift; params_exception "Index does not exist." unless $self->{indexes}->EXISTS( $i->id ); $self->{indexes}->DELETE( $i->id ); } sub register_table_name_change { my $self = shift; validate( @_, { table => { isa => 'Alzabo::Create::Table' }, old_name => { type => SCALAR } } ); my %p = @_; $self->{fk}{ $p{table}->name } = delete $self->{fk}{ $p{old_name} } if exists $self->{fk}{ $p{old_name} }; } sub register_column_name_change { my $self = shift; validate( @_, { column => { isa => 'Alzabo::Create::Column' }, old_name => { type => SCALAR } } ); my %p = @_; my $new_name = $p{column}->name; my $index = $self->{columns}->Indices( $p{old_name} ); $self->{columns}->Replace( $index, $p{column}, $new_name ); foreach my $t ( keys %{ $self->{fk} } ) { $self->{fk}{$t}{$new_name} = delete $self->{fk}{$t}{ $p{old_name} } if exists $self->{fk}{$t}{ $p{old_name} }; } my @i = $self->{indexes}->Values; $self->{indexes} = Tie::IxHash->new; foreach my $i (@i) { $i->register_column_name_change(%p); $self->add_index($i); } } sub set_attributes { my $self = shift; validate_pos( @_, ( { type => SCALAR } ) x @_ ); %{ $self->{attributes} } = (); foreach ( grep { defined && length } @_ ) { $self->add_attribute($_); } } sub add_attribute { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $attr = shift; $attr =~ s/^\s+//; $attr =~ s/\s+$//; $self->schema->rules->validate_table_attribute( table => $self, attribute => $attr ); $self->{attributes}{$attr} = 1; } sub delete_attribute { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $attr = shift; params_exception "Table " . $self->name . " doesn't have attribute $attr" unless exists $self->{attributes}{$attr}; delete $self->{attributes}{$attr}; } sub set_comment { $_[0]->{comment} = defined $_[1] ? $_[1] : '' } sub save_current_name { my $self = shift; $self->{last_instantiated_name} = $self->name; foreach my $column ( $self->columns ) { $column->save_current_name; } } sub former_name { $_[0]->{last_instantiated_name} } __END__ =head1 NAME Alzabo::Create::Table - Table objects for schema creation =head1 SYNOPSIS use Alzabo::Create::Table; =head1 DESCRIPTION This class represents tables in the schema. It contains column, index, and foreign key objects. =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 new The constructor takes the following parameters: =over 4 =item * schema => C object The schema to which this table belongs. =item * name => $name =item * attributes => \@attributes =item * comment => $comment An optional comment. =back It returns a new C object. Throws: L|Alzabo::Exceptions> =for pod_merge schema =for pod_merge name =head2 set_name ($name) Changes the name of the table. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge column =for pod_merge columns =for pod_merge has_column =head2 make_column Creates a new L|Alzabo::Create::Column> object and adds it to the table. This object is the function's return value. In addition, if a "before" or "after" parameter is given, the L|move_column> method is called to move the new column. This method takes all of the same parameters as the Lnew() >>|Alzabo::Create::Column> method except the "table" parameter, which is automatically supplied. This method also accepts an additional parameter, "primary_key", indicating whether or not the column is part of the table's primary key. Returns a new L|Alzabo::Create::Column> object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 add_column Adds a column to the table. If a "before" or "after" parameter is given then the L|move_column> method will be called to move the new column to the appropriate position. It takes the following parameters: =over 4 =item * column => C object =item * after => C object (optional) ... or ... =item * before => C object (optional) =back Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 delete_column (C object) Deletes a column from the table. Throws: L|Alzabo::Exceptions> =head2 move_column This method takes the following parameters: =over 4 =item * column => C object The column to move. and either ... =item * before => C object Move the column before this column ... or ... =item * after => C object Move the column after this column. =back Throws: L|Alzabo::Exceptions> =for pod_merge primary_key =for pod_merge primary_key_size =head2 add_primary_key (C object) Make the given column part of the table's primary key. The primary key is an ordered list of columns. The given column will be added to the end of this list. Throws: L|Alzabo::Exceptions> =head2 delete_primary_key (C object) Delete the given column from the primary key. Throws: L|Alzabo::Exceptions> =for pod_merge foreign_keys =for pod_merge foreign_keys_by_table =for pod_merge foreign_keys_by_column =for pod_merge all_foreign_keys =head2 make_foreign_key (see below) Takes the same parameters as the Lnew>|Alzabo::Create::ForeignKey/new> method except for the table parameter, which is automatically added. The foreign key object that is created is then added to the table. If the foreign key being made is 1..1 or 1..n, then a unique index will be created on the columns involved in the "1" side of the foreign key, unless they are the table's primary key. Returns a new L|Alzabo::Create::ForeignKey> object. Throws: L|Alzabo::Exceptions> =head2 add_foreign_key (C object) Adds the given foreign key to the table. Throws: L|Alzabo::Exceptions> =head2 delete_foreign_key (C object) Deletes the given foreign key from the table Throws: L|Alzabo::Exceptions> =for pod_merge index =for pod_merge has_index =for pod_merge indexes =head2 make_index Takes the same parameters as the Lnew() >>|Alzabo::Create::Index/new> method except for the "table" parameter, which is automatically added. The index object that is created is then added to the table. Returns the new L|Alzabo::Create::Index> object. Throws: L|Alzabo::Exceptions> =head2 add_index (C object) Adds the given index to the table. Throws: L|Alzabo::Exceptions> =head2 delete_index (C object) Deletes the specified index from the table. Throws: L|Alzabo::Exceptions> =for pod_merge attributes =for pod_merge has_attribute =head2 set_attributes (@attributes) Sets the tables's attributes. These are strings describing the table (for example, valid attributes in MySQL are "TYPE = INNODB" or "AUTO_INCREMENT = 100"). You can also set table constraints as attributes. Alzabo will generate correct SQL for both actual attributes and constraints. =head2 add_attribute ($attribute) Add an attribute to the column's list of attributes. =head2 delete_attribute ($attribute) Delete the given attribute from the column's list of attributes. L|Alzabo::Exceptions> =head2 former_name If the table's name has been changed since the last time the schema was instantiated, this method returns the table's previous name. =for pod_merge comment =head2 set_comment ($comment) Set the comment for the table object. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Create/Index.pm0000444000175000017500000001545610721343227017314 0ustar autarchautarchpackage Alzabo::Create::Index; use strict; use vars qw($VERSION); use Alzabo::Create; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Alzabo::Utils; use Params::Validate qw( :all ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use base qw(Alzabo::Index); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; validate( @_, { table => { isa => 'Alzabo::Create::Table' }, columns => { type => ARRAYREF }, unique => { type => BOOLEAN, default => 0 }, fulltext => { type => BOOLEAN, default => 0 }, function => { type => UNDEF | SCALAR, default => undef }, } ); my %p = @_; my $self = bless {}, $class; $self->{table} = $p{table}; $self->{unique} = $p{unique} || 0; $self->{fulltext} = $p{fulltext} || 0; $self->{function} = $p{function}; $self->{columns} = Tie::IxHash->new; foreach my $c (@{ $p{columns} }) { my %p = Alzabo::Utils::safe_isa( $c, 'Alzabo::Column' ) ? ( column => $c ) : %$c; $self->add_column(%p); } $self->table->schema->rules->validate_index($self); return $self; } sub add_column { my $self = shift; validate( @_, { column => { isa => 'Alzabo::Create::Column' }, prefix => { type => SCALAR, optional => 1 } } ); my %p = @_; my $new_name = $p{column}->name; params_exception "Column $new_name already exists in index." if $self->{columns}->EXISTS($new_name); $self->{columns}->STORE( $new_name, \%p ); eval { $self->table->schema->rules->validate_index($self); }; if ($@) { $self->{columns}->DELETE($new_name); rethrow_exception($@); } } sub delete_column { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Column' } ); my $c = shift; params_exception "Column " . $c->name . " is not part of index." unless $self->{columns}->EXISTS( $c->name ); $self->{columns}->DELETE( $c->name ); } sub set_prefix { my $self = shift; validate( @_, { column => { isa => 'Alzabo::Create::Column' }, prefix => { type => SCALAR } } ); my %p = @_; params_exception "Column " . $p{column}->name . " is not part of index." unless $self->{columns}->EXISTS( $p{column}->name ); my $col = $self->{columns}->FETCH( $p{column}->name ); my $old_val = delete $col->{prefix}; $col->{prefix} = $p{prefix}; eval { $self->table->schema->rules->validate_index($self); }; if ($@) { if ($old_val) { $col->{prefix} = $old_val; } else { delete $col->{prefix}; } rethrow_exception($@); } } sub set_unique { my $self = shift; validate_pos( @_, 1 ); $self->{unique} = shift; } sub set_fulltext { my $self = shift; validate_pos( @_, 1 ); my $old_val = $self->{fulltext}; $self->{fulltext} = shift; eval { $self->table->schema->rules->validate_index($self); }; if ($@) { $self->{fulltext} = $old_val; rethrow_exception($@); } } sub register_column_name_change { my $self = shift; validate( @_, { column => { isa => 'Alzabo::Create::Column' }, old_name => { type => SCALAR } } ); my %p = @_; return unless $self->{columns}->EXISTS( $p{old_name} ); my $new_name = $p{column}->name; my $index = $self->{columns}->Indices( $p{old_name} ); my $val = $self->{columns}->Values($index); $val->{column} = $p{column}; $self->{columns}->Replace( $index, $val, $new_name ); } __END__ =head1 NAME Alzabo::Create::Index - Index objects for schema creation =head1 SYNOPSIS use Alzabo::Create::Index; =for pod_merge DESCRIPTION =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 new The constructor takes the following parameters: =over 4 =item * table => C object The table that this index is indexing. =item * columns => [ C object, .. ] =item * columns => [ { column => C object, prefix => $prefix }, repeat as needed ... ] This parameter indicates which columns that are being indexed. It can either be an array reference of column objects, or an array reference of hash references, each with a key called column and one called prefix. The prefix key is optional. =item * unique => $boolean Indicates whether or not this is a unique index. =item * fulltext => $boolean Indicates whether or not this is a fulltext index. =item * function => $string This can be used to create a function index where supported. The value of this parameter should be the full function, with column names, such as C. The "columns" parameter should include all the columns used in the function. =back Returns a new C object. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge table =for pod_merge columns =head2 add_column Adds a column to the index. This method takes the following parameters: =over 4 =item * column => C object =item * prefix => $prefix (optional) =back Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 delete_column (C object) Deletes the given column from the index. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge prefix =head2 set_prefix This method takes the following parameters: =over 4 =item * column => C object =item * prefix => $prefix =back Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge unique =head2 set_unique ($boolean) Sets whether or not the index is a unique index. =for pod_merge fulltext =head2 set_fulltext ($boolean) Set whether or not the index is a fulltext index. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 register_column_name_change This method takes the following parameters: =over 4 =item * column => C object The column (with the new name already set). =item * old_name => $old_name =back This method is called by the table object which owns the index when a column name changes. You should never need to call this yourself. Throws: L|Alzabo::Exceptions> =for pod_merge id =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Create/ForeignKey.pm0000444000175000017500000001235210721343227020277 0ustar autarchautarchpackage Alzabo::Create::ForeignKey; use strict; use vars qw($VERSION); use Alzabo::Create; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Alzabo::Utils; use Params::Validate qw( :all ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use base qw(Alzabo::ForeignKey); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; validate( @_, { columns_from => { type => ARRAYREF | OBJECT }, columns_to => { type => ARRAYREF | OBJECT }, cardinality => { type => ARRAYREF }, from_is_dependent => { type => SCALAR }, to_is_dependent => { type => SCALAR }, comment => { type => UNDEF | SCALAR, default => '' }, } ); my %p = @_; my $self = bless {}, $class; $self->set_columns_from( $p{columns_from} ); $self->set_columns_to( $p{columns_to} ); $self->set_cardinality( @{ $p{cardinality} } ); $self->set_from_is_dependent( $p{from_is_dependent} ); $self->set_to_is_dependent( $p{to_is_dependent} ); $self->set_comment( $p{comment} ); return $self; } sub set_columns_from { my $self = shift; my $c = Alzabo::Utils::is_arrayref( $_[0] ) ? shift : [ shift ]; validate_pos( @$c, ( { isa => 'Alzabo::Create::Column' } ) x @$c ); if ( exists $self->{columns_to} ) { params_exception "The number of columns in each part of the relationship must be the same" unless @{ $self->{columns_to} } == @$c; } $self->{columns_from} = $c; } sub set_columns_to { my $self = shift; my $c = Alzabo::Utils::is_arrayref( $_[0] ) ? shift : [ shift ]; validate_pos( @$c, ( { isa => 'Alzabo::Create::Column' } ) x @$c ); if ( exists $self->{columns_from} ) { params_exception "The number of columns in each part of the relationship must be the same" unless @{ $self->{columns_from} } == @$c; } $self->{columns_to} = $c; } sub set_cardinality { my $self = shift; my @card = @_; params_exception "Incorrect number of elements for cardinality" unless scalar @card == 2; foreach my $c ( @card ) { params_exception "Invalid cardinality piece: $c" unless $c =~ /^[1n]$/i; } params_exception "Invalid cardinality: $card[0]..$card[1]" if $card[0] eq 'n' && $card[1] eq 'n'; $self->{cardinality} = \@card; } sub set_from_is_dependent { my $self = shift; $self->{from_is_dependent} = shift; } sub set_to_is_dependent { my $self = shift; $self->{to_is_dependent} = shift; } sub set_comment { $_[0]->{comment} = defined $_[1] ? $_[1] : '' } __END__ =head1 NAME Alzabo::Create::ForeignKey - Foreign key objects for schema creation. =head1 SYNOPSIS use Alzabo::Create::ForeignKey; =for pod_merge DESCRIPTION =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 new The constructor takes the following parameters: =over 4 =item * columns_from => C object(s) =item * columns_to => C object(s) These two parameters may be either a single column or a reference to an array columns. The number of columns in the two parameters must match. =item * cardinality => [1, 1], [1, 'n'], or ['n', 1] =item * from_is_dependent => $boolean =item * to_is_dependent => $boolean =item * comment => $comment An optional comment. =back It returns a new L|Alzabo::Create::ForeignKey> object. Throws: L|Alzabo::Exceptions> =for pod_merge table_from =for pod_merge table_to =for pod_merge columns_from =for pod_merge columns_to =for pod_merge column_pairs =head2 set_columns_from (C object(s)) Sets the column(s) that the relation is from. This can be either a single column object or a reference to an array of column objects. Throws: L|Alzabo::Exceptions> =head2 set_columns_to (C object(s)) Sets the column(s) that the relation is to. This can be either a single column object or a reference to an array of column objects. Throws: L|Alzabo::Exceptions> =for pod_merge cardinality =for pod_merge from_is_dependent =for pod_merge to_is_dependent =for pod_merge is_one_to_one =for pod_merge is_one_to_many =for pod_merge is_many_to_one =head2 set_cardinality (\@cardinality) see above for details Sets the cardinality of the foreign key. Throws: L|Alzabo::Exceptions> =head2 set_from_is_dependent ($boolean) Indicates whether or not the first table in the foreign key is dependent on the other (i.e. whether the 'from' table is dependent on the 'to' table). =head2 set_to_is_dependent ($boolean) Indicates whether or not the second table in the foreign key is dependent on the other (i.e. whether the 'to' table is dependent on the 'from' table). =for pod_merge id =for pod_merge is_same_relationship_as ($fk) =for pod_merge comment =head2 set_comment ($comment) Sets the comment for the foreign key object. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/Create/Column.pm0000444000175000017500000002712410721343227017475 0ustar autarchautarchpackage Alzabo::Create::Column; use strict; use vars qw($VERSION); use Alzabo::Create; use Alzabo::Exceptions ( abbr => 'params_exception' ); use Params::Validate qw( :all ); Params::Validate::validation_options ( on_fail => sub { params_exception join '', @_ } ); use base qw(Alzabo::Column); $VERSION = 2.0; 1; sub new { my $proto = shift; my $class = ref $proto || $proto; my $self = bless {}, $class; $self->_init(@_); return $self; } sub _init { my $self = shift; my %p = validate( @_, { table => { isa => 'Alzabo::Table' }, name => { type => SCALAR }, null => { optional => 1 }, nullable => { optional => 1 }, type => { type => SCALAR, optional => 1 }, attributes => { type => ARRAYREF, default => [] }, default => { type => BOOLEAN, optional => 1 }, default_is_raw => { type => BOOLEAN, default => 0 }, sequenced => { optional => 1 }, length => { type => BOOLEAN, optional => 1 }, precision => { type => BOOLEAN, optional => 1 }, definition => { isa => 'Alzabo::Create::ColumnDefinition', optional => 1 }, comment => { type => BOOLEAN, default => '' }, } ); $self->set_table( $p{table} ); $self->set_name( $p{name} ); $self->{nullable} = $p{nullable} || $p{null} || 0; if ($p{definition}) { $self->set_definition( $p{definition} ); } else { $self->set_definition ( Alzabo::Create::ColumnDefinition->new ( owner => $self, type => $p{type}, ) ); } my %attr; tie %{ $self->{attributes} }, 'Tie::IxHash'; $self->set_attributes( @{ $p{attributes} } ); $self->set_sequenced( $p{sequenced} || 0 ); $self->set_default( $p{default} ) if exists $p{default}; $self->set_default_is_raw( $p{default_is_raw} ); # We always set length, since not giving a length at all may be an # error for some column types, unless we got a definition object, # in which case it should contain the length & precision. $self->set_length( length => $p{length}, precision => $p{precision} ) unless $p{definition}; $self->set_comment( $p{comment} ); } sub set_table { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::Table' } ); $self->{table} = shift; } sub set_name { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $name = shift; params_exception "Column $name already exists in table" if $self->table->has_column($name); my $old_name = $self->{name}; $self->{name} = $name; eval { $self->table->schema->rules->validate_column_name($self); }; if ($@) { $self->{name} = $old_name; rethrow_exception($@); } $self->table->register_column_name_change( column => $self, old_name => $old_name ) if $old_name; } sub set_nullable { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $n = shift; params_exception "Invalid value for nullable attribute: $n" unless $n eq '1' || $n eq '0'; params_exception "Primary key column cannot be nullable" if $n eq '1' && $self->is_primary_key; $self->{nullable} = $n; } sub set_default { my $self = shift; validate_pos( @_, { type => BOOLEAN } ); $self->{default} = shift; } sub set_default_is_raw { my $self = shift; validate_pos( @_, { type => BOOLEAN } ); $self->{default_is_raw} = shift; } sub set_length { my $self = shift; $self->{definition}->set_length(@_); } sub set_attributes { my $self = shift; validate_pos( @_, ( { type => SCALAR } ) x @_ ); %{ $self->{attributes} } = (); foreach (@_) { $self->add_attribute($_); } } sub add_attribute { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $attr = shift; $attr =~ s/^\s+//; $attr =~ s/\s+$//; $self->table->schema->rules->validate_column_attribute( column => $self, attribute => $attr ); $self->{attributes}{$attr} = 1; } sub delete_attribute { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $attr = shift; params_exception "Column " . $self->name . " doesn't have attribute $attr" unless exists $self->{attributes}{$attr}; delete $self->{attributes}{$attr}; } sub alter { my $self = shift; $self->{definition}->alter(@_); # this will force them to go through the rules code again. # Attributes that don't work with the new type are silently # discarded. foreach ( $self->attributes ) { $self->delete_attribute($_); eval { $self->add_attribute($_) }; } } sub set_type { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $t = shift; $self->{definition}->set_type($t); # this will force them to go through the rules code again. # Attributes that don't work with the new type are silently # discarded. foreach ( $self->attributes ) { $self->delete_attribute($_); eval { $self->add_attribute($_) }; } if ( $self->length ) { eval { $self->set_length( length => $self->length, precision => $self->precision ) }; if ($@) { eval { $self->set_length( length => $self->length, precision => undef ) }; if ($@) { $self->set_length( length => undef, precision => undef ); } } } } sub set_sequenced { my $self = shift; validate_pos( @_, { type => SCALAR } ); my $s = shift; params_exception "Invalid value for sequenced attribute: $s" unless $s eq '1' || $s eq '0'; $self->table->schema->rules->validate_sequenced_attribute($self) if $s eq '1'; $self->{sequenced} = $s; } sub set_definition { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Create::ColumnDefinition' } ); my $d = shift; $self->{definition} = $d; } sub set_comment { $_[0]->{comment} = defined $_[1] ? $_[1] : '' } sub save_current_name { my $self = shift; $self->{last_instantiated_name} = $self->name; } sub former_name { $_[0]->{last_instantiated_name} } __END__ =head1 NAME Alzabo::Create::Column - Column objects for use in schema creation =head1 SYNOPSIS use Alzabo::Create::Column; =head1 DESCRIPTION This object represents a column. It holds data specific to a column. Additional data is held in a L|Alzabo::Create::ColumnDefinition> object, which is used to allow two columns to share a type (which is good when two columns in different tables are related as it means that if the type of one is changed, the other is also.) =head1 INHERITS FROM C =for pod_merge merged =head1 METHODS =head2 new The constructor accepts the following parameters: =over 4 =item * table => C object =item * name => $name =item * nullable => 0 or 1 (optional) Defaults to false. =item * sequenced => 0 or 1 (optional) Defaults to false. =item * default => $default (optional) =item * default_is_raw => $boolean (optional) If "default_is_raw" is true, then it will not be quoted when passed to the DBMS in SQL statements. This should be used to allow a default which is a function, like C. =item * attributes => \@attributes (optional) =item * length => $length (optional) =item * precision => $precision (optional) One of either ... =item * type => $type ... or ... =item * definition => C object =item * comment => $comment An optional comment. =back It returns a new C object. Throws: L|Alzabo::Exceptions> =for pod_merge type =head2 alter This method allows you to change a column's type, length, and precision as a single operation. It should be instead of calling C followed by C. It takes the following parameters: =over 4 =item * type => $type =item * length => $length (optional) =item * precision => $precision (optional) =back Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 set_type ($type) Sets the column's type. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =head2 set_table (C object) Sets the L|Alzabo::Create::Table> object in which this column is located. Throws: L|Alzabo::Exceptions> =for pod_merge name =head2 set_name ($name) Sets the column's name (a string). Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge nullable =head2 set_nullable (0 or 1) Sets the nullability of the column (this determines whether nulls are allowed in the column or not). Must be 0 or 1. Throws: L|Alzabo::Exceptions> =for pod_merge attributes =for pod_merge has_attribute =head2 set_attributes (@attributes) Sets the column's attributes. These are strings describing the column (for example, valid attributes in MySQL are "PRIMARY KEY" or "AUTO_INCREMENT"). Throws: L|Alzabo::Exceptions> =head2 add_attribute ($attribute) Add an attribute to the column's list of attributes. Throws: L|Alzabo::Exceptions> =head2 delete_attribute ($attribute) Delete the given attribute from the column's list of attributes. Throws: Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge default =head2 set_default ($default) Sets the column's default value. =for pod_merge length =for pod_merge precision =head2 set_length This method takes the following parameters: =over 4 =item * length => $length =item * precision => $precision (optional) =back This method sets the column's length and precision. The precision parameter is optional (though some column types may require it if the length is set). Throws: L|Alzabo::Exceptions> =for pod_merge sequenced =head2 set_sequenced (0 or 1) Sets the value of the column's sequenced attribute. Throws: L|Alzabo::Exceptions>, L|Alzabo::Exceptions> =for pod_merge is_primary_key =for pod_merge is_numeric =for pod_merge is_character =for pod_merge is_blob =for pod_merge definition =head2 set_definition (C object) Sets the L|Alzabo::Create::ColumnDefinition> object which holds this column's type information. =head2 former_name If the column's name has been changed since the last time the schema was instantiated, this method returns the column's previous name. =for pod_merge comment =head2 set_comment ($comment) Set the comment for the column object. =cut Alzabo-0.92/lib/Alzabo/RDBMSRules.pm0000444000175000017500000006104210721343227016714 0ustar autarchautarchpackage Alzabo::RDBMSRules; use strict; use vars qw($VERSION); use Alzabo::Exceptions ( abbr => [ 'recreate_table_exception' ] ); use Class::Factory::Util; use Params::Validate qw( validate validate_pos ); Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } ); $VERSION = 2.0; 1; sub new { shift; my %p = @_; eval "use Alzabo::RDBMSRules::$p{rdbms};"; Alzabo::Exception::Eval->throw( error => $@ ) if $@; return "Alzabo::RDBMSRules::$p{rdbms}"->new(@_); } sub available { __PACKAGE__->subclasses } # validation sub validate_schema_name { shift()->_virtual; } sub validate_table_name { shift()->_virtual; } sub validate_column_name { shift()->_virtual; } sub validate_column_type { shift()->_virtual; } sub validate_column_length { shift()->_virtual; } sub validate_table_attribute { shift()->_virtual; } sub validate_column_attribute { shift()->_virtual; } sub validate_primary_key { shift()->_virtual; } sub validate_sequenced_attribute { shift()->_virtual; } sub validate_index { shift()->_virtual; } sub type_is_numeric { my $self = shift; my $col = shift; return $self->type_is_integer($col) || $self->type_is_floating_point($col); } sub type_is_integer { shift()->_virtual; } sub type_is_floating_point { shift()->_virtual; } sub type_is_character { shift()->_virtual; } sub type_is_date { shift()->_virtual; } sub type_is_datetime { shift()->_virtual; } sub type_is_time { shift()->_virtual; } sub type_is_time_interval { shift()->_virtual; } sub type_is_blob { shift()->_virtual; } sub blob_type { shift()->virtual; } # feature probing sub column_types { shift()->_virtual; } sub feature { return 0; } sub quote_identifiers { 0 } sub quote_identifiers_character { '' } sub schema_attributes { shift()->_virtual; } sub table_attributes { shift()->_virtual; } sub column_attributes { shift()->_virtual; } sub schema_sql { my $self = shift; validate_pos( @_, { isa => 'Alzabo::Schema' } ); my $schema = shift; my @sql; local $self->{state}; foreach my $t ( $schema->tables ) { push @sql, $self->table_sql($t); } return @sql, @{ $self->{state}{deferred_sql} || [] }; } sub table_sql { shift()->_virtual; } sub column_sql { shift()->_virtual; } sub index_sql { my $self = shift; my $index = shift; my $index_name = $index->id; $index_name = $self->quote_identifiers_character . $index_name . $self->quote_identifiers_character; my $sql = 'CREATE'; $sql .= ' UNIQUE' if $index->unique; $sql .= " INDEX $index_name ON "; $sql .= $self->quote_identifiers_character; $sql .= $index->table->name; $sql .= $self->quote_identifiers_character; $sql .= ' ( '; if ( defined $index->function ) { $sql .= $index->function; } else { $sql .= ( join ', ', map { $self->quote_identifiers_character . $_->name . $self->quote_identifiers_character } $index->columns ); } $sql .= ' )'; return $sql; } sub foreign_key_sql { shift()->_virtual; } sub drop_table_sql { my $self = shift; my $name = shift->name; $name = $self->quote_identifiers_character . $name . $self->quote_identifiers_character; return "DROP TABLE $name"; } sub drop_column_sql { shift()->_virtual; } sub drop_index_sql { shift()->_virtual; } sub drop_foreign_key_sql { shift()->_virtual; } sub column_sql_add { shift()->_virtual; } sub column_sql_diff { shift()->_virtual; } sub index_sql_diff { my $self = shift; validate( @_, { new => { isa => 'Alzabo::Index' }, old => { isa => 'Alzabo::Index' } } ); my %p = @_; my $new_sql = $self->index_sql($p{new}); my @sql; if ( $new_sql ne $self->index_sql($p{old}) ) { push @sql, $self->drop_index_sql( $p{old}, $p{new}->table->name ); push @sql, $new_sql; } return @sql; } sub alter_primary_key_sql { shift()->_virtual; } sub can_alter_table_name { 1; } sub can_alter_column_name { 1; } sub alter_table_name_sql { shift()->_virtual; } sub alter_column_name_sql { shift()->_virtual; } sub recreate_table_sql { shift()->_virtual; } =pod sub reverse_engineer { my $self = shift; my $schema = shift; my $dbh = $schema->driver->handle; foreach my $table ( $dbh->tables ) { my $t = $schema->make_table( name => $table ); $self->reverse_engineer_table($t); } } sub reverse_engineer_table { my $self = shift; my $table = shift; my $dbh = $table->schema->driver->handle; my $sth = $dbh->column_info( undef, $table->schema->name, $table->name, undef ); while ( my $col_info = $sth->fetchrow_hashref ) { use Data::Dumper; warn Dumper $col_info; my %attr = ( name => $col_info->{COLUMN_NAME}, type => $col_info->{TYPE_NAME}, nullable => $col_info->{NULLABLE} ? 1 : 0, ); $attr{size} = $col_info->{COLUMN_SIZE} if $col_info->{COLUMN_SIZE}; $attr{precision} = $col_info->{DECIMAL_DIGITS} if $col_info->{DECIMAL_DIGITS}; $attr{default} = $col_info->{COLUMN_DEF} if defined $col_info->{COLUMN_DEF}; $attr{comment} = $col_info->{REMARKS} if defined $col_info->{REMARKS}; $table->make_column(%attr); } $self->reverse_engineer_table_primary_key($table); } sub reverse_engineer_table_primary_key { my $self = shift; my $table = shift; my $dbh = $table->schema->driver->handle; my $sth = $dbh->column_info( undef, $table->schema->name, $table->name ); while ( my $pk_info = $sth->fetchrow_hashref ) { $table->add_primary_key( $table->column( $pk_info->{COLUMN_NAME} ) ); } } =cut sub rules_id { shift()->_virtual; } sub schema_sql_diff { my $self = shift; validate( @_, { new => { isa => 'Alzabo::Schema' }, old => { isa => 'Alzabo::Schema' } } ); my %p = @_; local $self->{state}; my @sql; my %changed_name; foreach my $new_t ( $p{new}->tables ) { # When syncing against an existing schema, the table may be # present with its new name. my $old_t; if ( defined $new_t->former_name ) { $old_t = eval { $p{old}->table( $new_t->former_name ) }; } $old_t ||= eval { $p{old}->table( $new_t->name ) }; if ($old_t) { if ( $old_t->name ne $new_t->name ) { $changed_name{ $old_t->name } = 1; if ( $self->can_alter_table_name ) { push @sql, $self->alter_table_name_sql($new_t); } else { push @sql, $self->recreate_table_sql( new => $new_t, old => $old_t, ); push @sql, $self->rename_sequences( new => $new_t, old => $old_t, ); # no need to do more because table will be # recreated from scratch next; } } push @sql, eval { $self->table_sql_diff( new => $new_t, old => $old_t ) }; if ( my $e = Exception::Class->caught('Alzabo::Exception::RDBMSRules::RecreateTable' ) ) { push @sql, $self->recreate_table_sql( new => $new_t, old => $old_t, ); } elsif ( $e = $@ ) { die $e; } } else { push @sql, $self->table_sql($new_t); foreach my $fk ( $new_t->all_foreign_keys ) { push @{ $self->{state}{deferred_sql} }, $self->foreign_key_sql($fk); } } } foreach my $old_t ( $p{old}->tables ) { unless ( $changed_name{ $old_t->name } || eval { $p{new}->table( $old_t->name ) } ) { push @sql, $self->drop_table_sql($old_t); } } return @sql, @{ $self->{state}{deferred_sql} || [] }; } sub table_sql_diff { my $self = shift; validate( @_, { new => { isa => 'Alzabo::Table' }, old => { isa => 'Alzabo::Table' } } ); my %p = @_; my @sql; foreach my $old_i ( $p{old}->indexes ) { unless ( eval { $p{new}->index( $old_i->id ) } ) { push @sql, $self->drop_index_sql($old_i, $p{new}->name) if eval { $p{new}->columns( map { $_->name } $old_i->columns ) } && ! $@; } } my %changed_name; foreach my $new_c ( $p{new}->columns ) { $changed_name{ $new_c->former_name } = 1 if defined $new_c->former_name && $new_c->former_name ne $new_c->name; } foreach my $old_c ( $p{old}->columns ) { unless ( $changed_name{ $old_c->name } || ( my $new_c = eval { $p{new}->column( $old_c->name ) } ) ) { push @sql, $self->drop_column_sql( new_table => $p{new}, old => $old_c ); } } foreach my $new_c ( $p{new}->columns ) { # When syncing against an existing schema, the column may be # present with its new name. my $old_c; if ( defined $new_c->former_name ) { $old_c = eval { $p{old}->column( $new_c->former_name ) }; } $old_c ||= eval { $p{old}->column( $new_c->name ) }; if ($old_c) { if ( $old_c->name ne $new_c->name ) { if ( $self->can_alter_column_name ) { push @sql, $self->alter_column_name_sql($new_c); } else { # no need to do more because table will be # recreated from scratch recreate_table_exception(); } } push @sql, $self->column_sql_diff( new => $new_c, old => $old_c, ); } else { push @sql, $self->column_sql_add($new_c); } } foreach my $new_i ( $p{new}->indexes ) { if ( my $old_i = eval { $p{old}->index( $new_i->id ) } ) { push @sql, $self->index_sql_diff( new => $new_i, old => $old_i ); } else { push @sql, $self->index_sql($new_i) } } foreach my $new_fk ( $p{new}->all_foreign_keys ) { unless ( grep { $new_fk->id eq $_->id } $p{old}->all_foreign_keys ) { push @{ $self->{state}{deferred_sql} }, $self->foreign_key_sql($new_fk) } } foreach my $old_fk ( $p{old}->all_foreign_keys ) { unless ( grep { $old_fk->id eq $_->id } $p{new}->all_foreign_keys ) { push @sql, $self->drop_foreign_key_sql($old_fk); } } my $pk_changed; foreach my $old_pk ( $p{old}->primary_key ) { next if $changed_name{ $old_pk->name }; my $new_col = eval { $p{new}->column( $old_pk->name ) }; unless ( $new_col && $new_col->is_primary_key ) { push @sql, $self->alter_primary_key_sql( new => $p{new}, old => $p{old} ); $pk_changed = 1; last; } } unless ($pk_changed) { foreach my $new_pk ( $p{new}->primary_key ) { my $old_col = eval { $p{old}->column( $new_pk->name ) }; next if $new_pk->former_name && $changed_name{ $new_pk->former_name }; unless ( $old_col && $old_col->is_primary_key ) { push @sql, $self->alter_primary_key_sql( new => $p{new}, old => $p{old} ); last; } } } my $alter_attributes; foreach my $new_att ( $p{new}->attributes ) { unless ( $p{old}->has_attribute( attribute => $new_att, case_sensitive => 1 ) ) { $alter_attributes = 1; push @sql, $self->alter_table_attributes_sql( new => $p{new}, old => $p{old}, ); last; } } unless ($alter_attributes) { foreach my $old_att ( $p{old}->attributes ) { unless ( $p{new}->has_attribute( attribute => $old_att, case_sensitive => 1 ) ) { $alter_attributes = 1; push @sql, $self->alter_table_attributes_sql( new => $p{new}, old => $p{old}, ); last; } } } return @sql; } sub _virtual { my $self = shift; my $sub = (caller(1))[3]; Alzabo::Exception::VirtualMethod->throw( error => "$sub is a virtual method and must be subclassed in " . ref $self ); } __END__ =head1 NAME Alzabo::RDBMSRules - Base class for Alzabo RDBMS rulesets =head1 SYNOPSIS use Alzabo::RDBMSRules; my $rules = Alzabo::RDBMSRules( rules => 'MySQL' ); =head1 DESCRIPTION This class is the base class for all C modules. To instantiate a subclass call this class's C method. See the L section for information on how to make a ruleset for the RDBMS of your choice. =head1 METHODS =head2 available A list of names representing the available C subclasses. Any one of these names would be appropriate as the "rdbms" parameter for the Lnew() >>|Alzabo::RDBMSRules/new> method. =head2 new The constructor always accepts one parameter, "rdbms", which is the name of the RDBMS to be used. Some subclasses may accept additional values. The constructor returns a new C object of the appropriate subclass. Throws: L|Alzabo::Exceptions> =head2 schema_sql (C object) Returns a list of SQL statements which would create the given schema. =head2 index_sql (C object) Returns a list of SQL statements to create the specified index. =head2 drop_table_sql (C object) Returns a list of SQL statements to drop the specified table. =head2 drop_index_sql (C object) Returns a list of SQL statements to drop the specified index. =head2 schema_sql_diff This method takes two parameters: =over 4 =item * new => C object =item * old => C object =back This method compares the two schema objects and returns an array of SQL statements which turn the "old" schema into the "new" one. =head2 table_sql_diff This method takes two parameters: =over 4 =item * new => C object =item * old => C object =back This method compares the two table objects and returns an array of SQL statements which turn the "old" table into the "new" one. =head2 type_is_numeric (C object) Returns a boolean indicating whether or not the column is numeric (integer or floating point). =head2 quote_identifiers Returns true or false to indicate whether or not the generated DDL SQL statements should have their identifiers quoted or not. This may be overridden by subclasses. It defaults to false. =head2 can_alter_table_name If this is true, then when syncing a schema, the object will call C to change the table's name. Otherwise it will call C. =head2 can_alter_column_name If this is true, then when syncing a schema, the object will call C to change the table's name. Otherwise it will call C. =head2 Virtual Methods The following methods are not implemented in the C class itself and must be implemented in its subclasses. =head2 column_types Returns a list of valid column types. =head2 feature ($feature) Given a string defining a feature, this method indicates whether or not the given RDBMS supports that feature. By default, this method always returns false unless overridden in the subclass. Features that may be asked for: =over 4 =item * extended_column_types Column types that must be input directly from a user, as opposed to being chosen from a list. MySQL's ENUM and SET types are examples of such types. =item * index_column_prefixes MySQL supports the notion of column prefixes in indexes, allowing you to index only a portion of a large text column. =item * fulltext_indexes This should be self-explanatory. =item * functional_indexes Indexes on functions, as supported by PostgreSQL. =back =head2 validate_schema_name (C object) Throws an L|Alzabo::Exceptions> if the schema's name is not valid. =head2 validate_table_name (C object) Throws an L|Alzabo::Exceptions> if the table's name is not valid. =head2 validate_column_name (C object) Throws an L|Alzabo::Exceptions> if the column's name is not valid. =head2 validate_column_type ($type_as_string) Throws an L|Alzabo::Exceptions> if the type is not valid. This method returns a canonized version of the type. =head2 validate_column_length (C object) Throws an L|Alzabo::Exceptions> if the length or precision is not valid for the given column. =head2 validate_column_attribute This method takes two parameters: =over 4 =item * column => C object =item * attribute => $attribute =back This method is a bit different from the others in that it takes an existing column object and a B attribute. It throws an L|Alzabo::Exceptions> if the attribute is is not valid for the column. =head2 validate_primary_key (C object) Throws an L|Alzabo::Exceptions> if the column is not a valid primary key for its table. =head2 validate_sequenced_attribute (C object) Throws an L|Alzabo::Exceptions> if the column cannot be sequenced. =head2 validate_index (C object) Throws an L|Alzabo::Exceptions> if the index is not valid. =head2 table_sql (C object) Returns an array of SQL statements to create the specified table. =head2 column_sql (C object) Returns an array of SQL statements to create the specified column. =head2 foreign_key_sql (C object) Returns an array of SQL statements to create the specified foreign key. =head2 drop_column_sql (C object) Returns an array of SQL statements to drop the specified column. =head2 drop_foreign_key_sql (C object) Returns an array of SQL statements to drop the specified foreign key. =head2 column_sql_add (C object) Returns an array of SQL statements to add the specified column. =head2 column_sql_diff This method takes two parameters: =over 4 =item * new => C object =item * old => C object =back This method compares the two table objects and returns an array of SQL statements which turn the "old" table into the "new" one. =head2 index_sql_diff This method takes two parameters: =over 4 =item * new => C object =item * old => C object =back This method compares the two index objects and returns an array of SQL statements which turn the "old" index into the "new" one. =head2 alter_primary_key_sql This method takes two parameters: =over 4 =item * new => C object =item * old => C object =back This method compares the two table objects and returns an array of SQL statements which alter the "old" one's primary key to match the "new" one's. =head2 alter_table_name_sql (C object) Given a table, this method is expected to change the table's name from C<< $table->former_name >> to C<< $table->name >>. This will only be called if the rules object returns true for C. =head2 alter_column_name_sql (C object) Given a column, this method is expected to change the table's name from C<< $column->former_name >> to C<< $column->name >>. This will only be called if the rules object returns true for C. =head2 recreate_table_sql This method takes two parameters: =over 4 =item * new => C object =item * old => C object =back This method is expected to drop the old table and create the new one. However, it B preserve all the data stored in the old table, excluding data in columns that are being dropped. Additionally, if there are sequences associated with columns in the old table, they should not be dropped. This method will only be called if either C or C return false. =head2 reverse_engineer (C object) Given a schema object (which presumably has no tables), this method uses the schema's L|Alzabo::Driver> object to connect to an existing database and reverse engineer it into the appropriate Alzabo objects. =head2 type_is_integer (C object) Returns a boolean indicating whether or not the column is an integer type. =head2 type_is_floating_point (C object) Returns a boolean indicating whether or not the column is a floating point type. =head2 type_is_character (C object) Returns a boolean indicating whether or not the column is a character type. This is defined as any type which is defined to store text, regardless of length. =head2 type_is_date (C object) Returns a boolean indicating whether or not the column is a date type. This is B true for datetime types. =head2 type_is_datetime (C object) Returns a boolean indicating whether or not the column is a datetime type. This is B true for date types. =head2 type_is_time (C object) Returns a boolean indicating whether or not the column is a time type. This is B true for datetime types. =head2 type_is_time_interval (C object) Returns a boolean indicating whether or not the column is a time interval type. =head1 SUBCLASSING Alzabo::RDBMSRules To create a subclass of C for your particular RDBMS is fairly simple. Here's a sample header to the module using a fictional RDBMS called FooDB: package Alzabo::RDBMSRules::FooDB; use strict; use vars qw($VERSION); use Alzabo::RDBMSRules; use base qw(Alzabo::RDBMSRules); The next step is to implement a C method and the methods listed under the section L. The new method should look a bit like this: 1: sub new 2: { 3: my $proto = shift; 4: my $class = ref $proto || $proto; 5: my %p = @_; 6: 7: my $self = bless {}, $self; 8: 9: return $self; 10: } The hash %p contains any values passed to the Lnew>|Alzabo::RDBMSRules/new> method by its caller. Lines 1-7 should probably be copied verbatim into your own C method. Line 5 can be deleted if you don't need to look at the parameters. The rest of your module should simply implement the methods listed under the L section of this documentation. Look at the included C subclasses for examples. Feel free to contact me for further help if you get stuck. Please tell me what database you're attempting to implement, and include the code you've written so far. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/PostgreSQL.pod0000444000175000017500000000310610721343227017200 0ustar autarchautarch=pod =head1 NAME Alzabo::PostgreSQL - Alzabo and PostgreSQL =head1 DESCRIPTION This documentation is about what special support Alzabo has for PostgreSQL, as well as what is lacking. Postgres support is based on the 7.3.x version of Postgres. Alzabo should work with the 7.1 and 7.2 series, and may even work with the 7.0 series. =head2 Mixed-case Table or Column Names By default, Postgres treats table and column names case-insensitively. Because of this, Alzabo always quotes these names when generating DDL SQL. If you are using tables or columns that contain upper-case characters, you should always call C<< $schema->set_quote_identifiers(1) >> as soon as you load your schema object. Otherwise, any method which generates DML SQL will fail. =head2 Reverse Engineering =over 4 =item * Alzabo cannot determine from the existence of a sequence that the sequence is meant to be used for a particular column unless the sequence was created as a result of making a column's type SERIAL. This is because there is no link between the two in the Postgres' data dictionary tables and will probably never change. =back =head2 Transactions =over 4 =item * Transactions are fully supported with Postgres. =back =head2 Outer joins =over 4 =item * Left and right outer joins are supported. =item * Full outer joins are not supported. =back =head2 Constraints Column constraints can be specified as column attributes. Table constraints can be specified as table attributes. Foreign key constraints are generated automatically based on the relationships defined by your schema. =cut Alzabo-0.92/lib/Alzabo/Design.pod0000444000175000017500000001442410721343227016413 0ustar autarchautarch=pod =head1 NAME Alzabo::Design - Documentation on Alzabo's design =head1 DESCRIPTION This document describes some of the Alzabo's design. =head1 ARCHITECTURE There are objects representing the schema, which contains table objects. Table objects contain column, foreign key, and index objects. Column objects contain column definition objects. A single column definition may be shared by multiple columns, but has only one owner. This is a diagram of these inheritance relationships: Alzabo::* (::Schema, ::Table, ::Column, ::ColumnDefinition, ::ForeignKey, ::Index) / \ is parent to / \ Alzabo::Create::* Alzabo::Runtime::* This a diagram of how objects contain other objects: Schema - makes--Alzabo::SQLMaker subclass object (many) / \ contains contains--Alzabo::Driver subclass object (1) | \ Table (0 or more) Alzabo::RDBMSRules subclass object (1) / \ (* Alzabo::Create::Schema only) / \ contains-------------------- / \ \ / \ \ ForeignKey Column (0 or more) Index (0 or more) (0 or more) | contains | ColumnDefinition (1) Note that more than one column I share a single definition object (this is explained in the L|Alzabo::Create::ColumnDefinition> documentation). This is only relevant if you are writing a schema creation interface. =head2 Other classes =over 4 =item * C These objects handle all the actual communication with the database, using a thin wrapper over DBI. The subclasses are used to implement functionality that must be handled uniquely for a given RDBMS, such as creating new values for sequenced columns. =item * C These objects handle the generation of all SQL for runtime operations. The subclasses are used to implement functionality that varies between RDBMS's, such as outer joins. =item * C These objects perform several funtions. First, they validate things such as schema or table names, column type and length, etc. Second they are used to generate SQL for creating and updating the database and its tables. And finally, they also handle the reverse engineering of an existing database. =item * C and C The C class represents a single row. These objects are created by L|Alzabo::Runtime::Table>, L|Alzabo::Runtime::RowCursor>, and L|Alzabo::Runtime::JoinCursor> objects. It is the sole interface by which actual data is retrieved, updated, or deleted in a table. The various C classes are used in order to change a row's behavior depending on whether it is live, live and cached, potential, or deleted. =item * C and C These objects are cursor that returns row objects. Using a cursor saves a lot of memory for big selects. =item * C Loading this class turns on Alzabo's simple row caching mechanism. =item * C This class is generated by Makefile.PL during installation and contains information such as what directory contains saved schemas and other configuration information. =item * C This object provides a method for an object to register a series to backout from multiple changes. This is done by providing the ChangeTracker object with a callback after a change is succesfully made to an object or objects. If a future change in a set of operations fail, the tracker can be told to back the changes out. This is used primarily in L|Alzabo::Create::Schema>. =item * C This module can auto-generate useful methods for you schema, table, and row objects based on the structure of your schema. =item * C This object creates the exception subclasses used by Alzabo. =back =head1 WHY THE SUBDIVISION BETWEEN Alzabo::*, Alzabo::Create::*, and Alzabo::Runtime::*? There are several reasons for doing this: =over 4 =item * In some environments (mod_perl) we would like to optimize for memory. For an application that uses an existing schema, all we need is to be able read object information, rather than needing to change the schema's definition. This means there is no reason to have the overhead of compiling all the methods used when creating and modifying objects. =item * In other environments (for example, when running as a separately spawned CGI process) compile time is important. =item * Many people using Alzabo will use the schema creation GUI and then write an application using that schema. At the simplest level, they would only need to learn how to instantiate C objects and how that class's methods work. For more sophisticated users, they can still avoid having to ever look at documentation on methods that alter the schema and its contained objects. =back =head1 RATIONALE FOR CURSORS Using cursors is definitely more complicated. However, there are two excellent reasons for using them: speed and memory savings. As an example, I did a test with the old code (which returned all its objects at once) against a table with about 8,000 rows using the Lall_rows> method|Alzabo::Runtime::Table/all_rows>. Under the old implementation, it took significantly longer to return the first row. Even more importantly than that, the old implementation used up about 10MB of memory versus about 4MB! Now imagine that with a 1,000,000 row table. Thus Alzabo uses cursors so it can scale better. This is a particularly big win in the case where you are working through a long list of rows and may stop before the end is reached. With cursors, Alzabo creates only as many rows as you need. Plus the start up time on your loop is much, much quicker. In the end, your program is quicker and less of a memory hog. This is good. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/lib/Alzabo/MySQL.pod0000444000175000017500000000544310721343227016150 0ustar autarchautarch=pod =head1 NAME Alzabo::MySQL - Alzabo and MySQL =head1 DESCRIPTION This documentation is about what special support Alzabo has for MySQL, as well as what is lacking. MySQL support is based on the 3.23.* release series, with some support for features that are starting to appear in the 4.0.* releases. Earlier versions of MySQL will probably work with Alzabo, though Alzabo cannot magically make these releases support new features like fulltext indexes. =head2 Indexes =over 4 =item * Alzabo supports the ability to specify prefixes when adding an index. Prefixes are required when attempting to index any sort of text or blob column. =item * Alzabo supports the creation of fulltext indexes and their use in SELECT and WHERE clauses. This includes the ability to get back the score given for a match as part of a select, using the C or C, C, C, and C commands. Because you can manipulate construct queries through object-oriented Perl, creating complex queries on the fly is much easier than it would be if you had to dynamically construct strings of SQL. A higher level interface can be created through the use of the L|Alzabo::MethodMaker> module. This module takes a schema object and auto-generates useful methods based on the tables, columns, and relationships it finds in the module. The code is generates can be integrated with your own code quite easily. To take it a step further, you could then aggregate a set of rows from different tables into a larger container object which could understand the logical relationship between these tables. =head2 What to Read? Alzabo has a lot of documentation. If you are primarily interested in using Alzabo as an RDBMS-OO wrapper, much of the documentation can be skipped. This assumes that you will create your schema via a schema creation GUI or via L. Here is the suggested reading order: L The RDBMS-specific documentation: =over 4 L L =back L - The most important parts here are those related to loading a schema and connecting to a database. Also be sure to read about the L|Alzabo::Runtime::Schema/join> method. L - This contains most of the methods used to fetch rows from the database, as well as the L|Alzabo::Runtime::Table/insert> method. L - The row objects contain the methods used to update, delete, and retrieve data from the database. L - A cursor object that returns only a single row. L - A cursor object that returns multiple rows at once. L - One of the most useful parts of Alzabo. This module can be used to auto-generate methods based on the structure of your schema. L - This describes the simple caching system included with Alzabo. L - How to turn on various kinds of debugging output. L - Describes the nature of all the exceptions used in Alzabo. L. L - A quick reference for the various methods of the Alzabo objects. =head1 SCRIPTS Alzabo comes with a few handy scripts in the F directory of the distribution. These are: =over 4 =item * alzabo_grep Given a regex and a schema name, this script will print out the table and column name for all columns which match the regex. =item * alzabo_to_ascii Given a schema name, this script will generate a set of simple ASCII tables for the schema. =back =head1 SUPPORT The Alzabo docs are conveniently located online at http://www.alzabo.org/docs/. There is also a mailing list. You can sign up at http://lists.sourceforge.net/lists/listinfo/alzabo-general. Please don't email me directly. Use the list instead so others can see your questions. =head1 COPYRIGHT Copyright (c) 2000-2003 David Rolsky. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 AUTHOR Dave Rolsky, =cut Alzabo-0.92/SIGNATURE0000644000175000017500000001637310721343231014006 0ustar autarchautarchThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 82d2517918aa5c0a76b60436b537444e510f9e10 Build.PL SHA1 0ea843853d1bb4c13bbec4b8f5412b778a38362e Changes SHA1 cc8ea2b12208ba4dca1f165863a82b3c190476b9 INSTALL SHA1 f235ba4160673bcb7c9d58c2f09dbc7fc0efadea LICENSE SHA1 c56fdaa9c9cb57611a2cdf7f45022329e4fb6435 MANIFEST SHA1 4523e3c9df2bd7043a488d89a7209c14e06068d6 META.yml SHA1 56ceda7e28ea08752c9d886c628ca835e65be4d8 Makefile.PL SHA1 c193306cf990c84647bc4cd8595ae84d835576fa README SHA1 d3ba36564c439b05ace0dfaabe5b49d0ce60d87b TODO SHA1 af17c513829bb8690e6c28e8a335743f80154cf6 eg/alzabo_grep SHA1 dc51feb8216ad58dc1c6e8061ba0cf332d55b81c eg/alzabo_to_ascii SHA1 15838f254e172ce95ecfad5f8b7a56e374f916a8 eg/convert.pl SHA1 9e5e154a1d09f026f1d028757a97a1337dc66ba6 eg/reverse_cardinality.pl SHA1 6a937c99c32748a7db2cf5ac499daf53d4e9f1aa inc/Alzabo/Build.pm SHA1 3459fe25d228838b37db8a1c241399c1d8d1654b inc/Alzabo/Config.pm.tmpl SHA1 81ba2c727ec2a89772bb2002c9c6d873bccac371 install_helpers/pod_merge.pl SHA1 58ccc6f2ab47a6c05e5ad2d5123582e32715c496 lib/Alzabo.pm SHA1 80c60e8a274a47ba41ba5fa218b4a9efe00de144 lib/Alzabo/BackCompat.pm SHA1 dab452ce5022760a30d6f8f93b21fb3bef61ddaf lib/Alzabo/ChangeTracker.pm SHA1 128ff3c6b0daf5ac74160a86da860b9ebf09333a lib/Alzabo/Column.pm SHA1 62e93912b1f34ee677edabddb85a860d9631aea3 lib/Alzabo/ColumnDefinition.pm SHA1 2c7e19f68dbde46a4c2d51639d56bef730b4a534 lib/Alzabo/Create.pm SHA1 8174ba37d5641374522a4814815c57d4c4b62511 lib/Alzabo/Create/Column.pm SHA1 b6ae0e3633dbbbaf12b1345bab01f73fd6f06d9f lib/Alzabo/Create/ColumnDefinition.pm SHA1 f78861613ac63366affb64d50d82d1564a915a60 lib/Alzabo/Create/ForeignKey.pm SHA1 4987a8d189ac631793c4b7d2974bab8135921849 lib/Alzabo/Create/Index.pm SHA1 c8704cf6f112cd331db0f28e3b184b3068850939 lib/Alzabo/Create/Schema.pm SHA1 d63e2353c873a6e3251aebb131f1f9e5b6fb0d70 lib/Alzabo/Create/Table.pm SHA1 8d8ac3c260d935fe6379f6ef37e01f2e20a6aed6 lib/Alzabo/Debug.pm SHA1 25e9d9957e284dc2832dc6140278f81f97f0870e lib/Alzabo/Design.pod SHA1 974bc57feceacf606d2e6da58a8b42cfa697ee86 lib/Alzabo/Driver.pm SHA1 d9d8a5f109347a48996db69391cf8bd82d544a7e lib/Alzabo/Driver/MySQL.pm SHA1 68d047274854bd80dddda65e3a0c8803b160b68f lib/Alzabo/Driver/PostgreSQL.pm SHA1 93bc6e361b6b4222b9e736f076dc091fd0233d8c lib/Alzabo/Exceptions.pm SHA1 dd78999b96072f0a8eea953c0ba53f2c9bb67de5 lib/Alzabo/FAQ.pod SHA1 3d167acc3b62a320c740906d6096d4065f24a6fd lib/Alzabo/ForeignKey.pm SHA1 f98818e898e7d3cfb46ae5c552e6cd24f33881f0 lib/Alzabo/Index.pm SHA1 182929553690ee897ec7484d5ed274ef1e5a4ff8 lib/Alzabo/Intro.pod SHA1 cc2c33521e5a9d346c88438e8e5da72100056314 lib/Alzabo/MethodMaker.pm SHA1 d3ce1698c85a053fcc1b16bc71f00283138ca721 lib/Alzabo/MySQL.pod SHA1 cfc1fba93154c2084893081dc420740a60619f3d lib/Alzabo/PostgreSQL.pod SHA1 a8552e16d23b616537dc85dde29d30fb894694a4 lib/Alzabo/QuickRef.pod SHA1 0a8d7218fa629823e594b0cb5c2645a5697515aa lib/Alzabo/RDBMSRules.pm SHA1 825719025caba7bf493cae6c086c846e9329f2e7 lib/Alzabo/RDBMSRules/MySQL.pm SHA1 85b2ef2a493a6f07ea11afd426225b83b5c764e5 lib/Alzabo/RDBMSRules/PostgreSQL.pm SHA1 09810b7cec2b9640d713f53ed39153cc97601270 lib/Alzabo/Runtime.pm SHA1 60736b58aeead140e2cd1c57311e982d817a6e15 lib/Alzabo/Runtime/Column.pm SHA1 da0f73db23475e3c6c04bf2dd0a4e98d3e04dd5c lib/Alzabo/Runtime/ColumnDefinition.pm SHA1 7765c4067cdc3d479927a9d39271c2eaebb47efb lib/Alzabo/Runtime/Cursor.pm SHA1 b935b85cb5104020571f9bc92c768ed2c2622c28 lib/Alzabo/Runtime/ForeignKey.pm SHA1 98cdbbcf494436195b6b1066a255e3fd49eae082 lib/Alzabo/Runtime/Index.pm SHA1 d6020951072aa9d3c31c2331b135b7c97624401e lib/Alzabo/Runtime/InsertHandle.pm SHA1 e9f9384bb2b33a7b37a2a5edd558fd564449a58c lib/Alzabo/Runtime/JoinCursor.pm SHA1 e099c87c9eb801d070d94046b7545acf19008d30 lib/Alzabo/Runtime/Row.pm SHA1 5d533602334bb04a30f9802b1171c7a4fd2ab315 lib/Alzabo/Runtime/RowCursor.pm SHA1 3fa4206befef7da4bc1a1d6b0bfc8a87045fc232 lib/Alzabo/Runtime/RowState/Deleted.pm SHA1 47b9e4dc8d77af6443baa0c92393311cd4923d3d lib/Alzabo/Runtime/RowState/InCache.pm SHA1 ac9916a03a0b574826b73d36161802d0e2607481 lib/Alzabo/Runtime/RowState/Live.pm SHA1 df04b6491aa096118da455e432cc8d08cd167073 lib/Alzabo/Runtime/RowState/Potential.pm SHA1 841736c73615982bf5a1cbd0ba5838b9df55a19f lib/Alzabo/Runtime/Schema.pm SHA1 b6ee46102a3b367772b48431e1def689283e3902 lib/Alzabo/Runtime/Table.pm SHA1 9286403266901d80a226476bb43cf0c1f10826b1 lib/Alzabo/Runtime/UniqueRowCache.pm SHA1 ce71db21e316956a7a2cd98824c0a7d18dc1ab83 lib/Alzabo/SQLMaker.pm SHA1 2bc532caa834986aa22ab277454f9231d2066731 lib/Alzabo/SQLMaker/MySQL.pm SHA1 7ada47ae40a0606442200d4cfd9640f846f44c23 lib/Alzabo/SQLMaker/PostgreSQL.pm SHA1 ac979e736d929e412e119e8271eeb3693046acfa lib/Alzabo/Schema.pm SHA1 9f63a5bdc1342935eb5a78e2eec25b76ae05b923 lib/Alzabo/Table.pm SHA1 8b97a915e10af7ac222b88107286a5d577f43e81 lib/Alzabo/Utils.pm SHA1 f847fb97ccb893a2d49081016b4d26837d7e118a mason/widgets/edit_field_checkbox SHA1 1ec65e465abc63eef84dbd78b6b26b53de69c230 mason/widgets/edit_field_text_input SHA1 2a39cb0dacfa7c5bd3f4b0192e2034125283d9fb mason/widgets/edit_field_textarea SHA1 a7a0e78c774733204a23ac2ba71e7faf6433ce7e mason/widgets/fk_to_one_select SHA1 6c5c2cbe53d95d8a38d7164f0351bcb808ea677c mason/widgets/insert SHA1 316becaea6da6008a0aa54350344e22f47ddb1c5 mason/widgets/insert_or_update SHA1 ef79ea559a1a6cb262d5245cfa596fbf28a18986 mason/widgets/update SHA1 eff25867aade830f62008e9c5ab0479ed30b8d69 t/01-compile.t SHA1 94036f06e5f7a955326e8da71488f01c53b1f215 t/01-driver.t SHA1 313c1ce15ce1b3720d5704ffbd823a43e0f5e833 t/02-create.t SHA1 7eec7b4cd0bdccecf807ae241def67a1970f2a20 t/03-runtime.t SHA1 0a68944ae8d4231f82b9873bc34436e41f7ec909 t/04-rev-engineer.t SHA1 d22a8f365a9cc9853d7f690a62660c0892940b6e t/05a-rules-mysql.t SHA1 cf1c5704e531920b7235a403e1c079c177b40803 t/05b-rules-pg.t SHA1 da1bcec912461842b2b72ae8bfe312dcb32f6bd2 t/07-methodmaker.t SHA1 2ba2912b5d3c857990d78cb44ef3ff1ece770beb t/09-storable.t SHA1 faaa357dfd9c03a46f92142c6f26071558d0205c t/12-rev-engineer-pg-fk.t SHA1 cc2b350f26a568a9e9d3832000430663b5906df2 t/14-unique-row-cache.t SHA1 f1f7c23556f4a628ef91271d028aa42dc309f743 t/15-alias-ref.t SHA1 c7398df9824312b432e5fc6da8f254291c893089 t/17-insert-handle.t SHA1 cbf87932e76567c47447fa46536968d4e99de1ac t/18-debug-null-bug.t SHA1 252b07115c2aecd2002f06bec0a1805c35495d43 t/19-schema-name.t SHA1 b0783a16eecc2b30cb8f7171bb2db1e66301d7a0 t/20-rev-engineer-pg-now.t SHA1 a2777dfc7a5375769a115bcd501bc5e3f22c6f5b t/21-row_by_pk-exception.t SHA1 3e795c888d385b0ab405a8e89558eed680f8f66e t/98-schema-diff.t SHA1 5926b115ebdc4830bcb8f8485c8f4186e2a90cec t/99-cleanup.t SHA1 77232b92127c5f3069f8b6d349aa5ef49ca1b9d4 t/99-pod.t SHA1 efd947c4a054b2b32473dac7ca7c66a580e6245f t/lib/Alzabo/Test/Utils.pm -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.6 (GNU/Linux) iD8DBQFHRcaZ3Or3ZzQuifMRAqShAKC3QNZRW/Hci5vQUNRMwQ9gIPe/OwCgqTLe +MScYoSDNNWt/YWi7OHYZW0= =xqLQ -----END PGP SIGNATURE----- Alzabo-0.92/LICENSE0000444000175000017500000005010110721343227013515 0ustar autarchautarchTerms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS --------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Alzabo-0.92/Build.PL0000444000175000017500000002245610721343227014020 0ustar autarchautarchuse strict; use 5.005; use Data::Dumper; use File::Spec; use lib 'inc'; use Alzabo::Build; use Getopt::Long qw( :config pass_through ); my %opts; GetOptions( 'dist' => \$opts{dist}, 'root:s' => \$opts{root}, 'pg!' => \$opts{pg}, 'mysql!' => \$opts{mysql}, 'automated' => \$opts{automated}, 'help' => \$opts{help}, ); if ( $opts{help} ) { print <<'EOF'; perl Build.PL [--automated] [--pg] [--mysql] This script accepts several options: --automated Run without prompts --pg Include prereqs for PostgreSQL support --mysql Include prereqs for MySQL support --root Root dir for storing Alzabos schemas --help What you are reading EOF exit; } { my ( $config, $prereqs, $tests ); unless ( $opts{dist} ) { ( $config, $prereqs, $tests ) = config(); write_config_module($config); } else { $prereqs = dist_prereqs(); $config = {}; } my $build = Alzabo::Build->new( module_name => 'Alzabo', license => 'perl', %$prereqs, sign => 1, ); $build->create_build_script; $build->notes( test_config => $tests ); $build->add_to_cleanup( File::Spec->catdir( 't', 'schemas' ), File::Spec->catfile( 'lib', 'Alzabo', 'Config.pm' ), ); } sub config { # try to see if there is an existing Alzabo installation eval { require Alzabo; }; eval { require Alzabo::Config; }; if ( ! $@ && %Alzabo::Config::CONFIG && defined Alzabo::Config::root_dir() && length Alzabo::Config::root_dir() && -d Alzabo::Config::root_dir() && Alzabo::Config::available_schemas() && $Alzabo::VERSION < 0.55 ) { print <<'EOF'; You appear to have schemas created with an older version of Alzabo. If you want to continue to use these, you may need to run the convert.pl script in the eg/ directory _before_ installing this version of Alzabo. For newer versions, starting with the transition from 0.64 to 0.65, Alzabo automatically converts schemas as needed. EOF exit unless Module::Build->y_n( ' Continue?', 'no' ); } my %config; $config{root_dir} = root_dir(); my ( $prereqs, $tests ) = features(); my $test_config = test_config($tests); return \%config, $prereqs, $test_config; } sub root_dir { my $root_dir = ( $opts{root} ? $opts{root} : %Alzabo::Config::CONFIG ? Alzabo::Config::root_dir() : find_possible_root() ); return $root_dir if $opts{automated}; print <<'EOF'; Please select a root directory for Alzabo (schema files will be stored under this root. EOF return Module::Build->prompt( ' Alzabo root?', $root_dir ); } sub find_possible_root { my @dirs; if ( $^O =~ /win/i ) { # A bit too thorough? foreach ('C'..'Z') { unshift @dirs, "$_:\\Program Files"; } } else { @dirs = qw( /var/lib /usr/local ); } unshift @dirs, '/opt' if $^O =~ /solaris/i; foreach (@dirs) { $_ .= '/alzabo'; return $_ if -e $_; } return ''; } sub features { # These are always needed my %prereqs = default_prereqs(); my ( %tests ); # extra prereqs for certain features my %features = ( mysql => { phrase => 'to use the MySQL driver', requires => { 'DBD::mysql' => 2.1017 }, test => 'mysql', }, pg => { phrase => 'to use the PostgreSQL driver', requires => { 'DBD::Pg' => 1.13, 'Text::Balanced' => 0, 'Digest::MD5' => 0, }, test => 'pg', }, ); if ( $opts{automated} ) { for my $k ( grep { $opts{$_} } keys %features ) { _add_to_prereqs( \%prereqs, $features{$k} ); $tests{$k} = 1; } return \%prereqs, \%tests; } print <<'EOF'; The following questions pertain to optional features of Alzabo. These questions help the installer determine what additional system checks to perform. EOF foreach my $feature ( map { $features{$_} } sort keys %features ) { print "\n"; my $has = 1; my $mods = ''; foreach my $type ( qw( requires recommends ) ) { if ( $feature->{$type} ) { my $text = "$type"; while ( my ( $mod, $ver ) = each %{ $feature->{$type} } ) { $text .= " $mod"; $text .= " ($ver)" if $ver; $has = 0 unless Module::Build->check_installed_version( $mod, $ver ); } $mods .= ' and ' if $mods; $mods .= $text; } } print "\u$feature->{phrase} $mods.\n"; my $wanted = Module::Build->y_n( " Do you want $feature->{phrase}?", $has ? 'yes' : 'no' ); if ($wanted) { _add_to_prereqs( \%prereqs, $feature ); $tests{ $feature->{test} } = 1 if exists $feature->{test}; } } return \%prereqs, \%tests; } sub _add_to_prereqs { my $prereqs = shift; my $feature = shift; foreach my $type ( grep { $feature->{$_} } qw( requires recommends ) ) { $prereqs->{$type} = { %{ $prereqs->{$type} }, %{ $feature->{$type} }, }; } } sub default_prereqs { return ( requires => { 'Class::Factory::Util' => 1.3, 'DBI' => minimum_dbi_version(), 'Digest::MD5' => 0, 'Exception::Class' => 0.97, 'Params::Validate' => 0.58, 'Scalar::Util' => 1.01, 'Storable' => 0.7, 'Test::Simple' => 0.47, 'Test::Harness' => 1.26, 'Tie::IxHash' => 0, 'Time::HiRes' => 0, perl => 5.006, }, recommends => {}, build_requires => { 'Pod::Man' => 1.14 }, ); } sub dist_prereqs { my %prereqs = default_prereqs(); $prereqs{requires}{DBI} = 1.21; $prereqs{recommends}{'DBD::mysql'} = 2.1017; $prereqs{recommends}{'DBD::Pg'} = 1.13; return \%prereqs; } sub minimum_dbi_version { if ( eval { require DBI } && $DBI::VERSION == 1.24 ) { warn <<'EOF'; You appear to have DBI version 1.24 installed. This version has a bug which causes major problems with Alzabo. Please upgrade or downgrade. EOF return 1.25; } return 1.21; } sub write_config_module { my $config = shift; # config items that the config module cares about my @keys = qw( root_dir ); my $file = File::Spec->catfile( 'inc', 'Alzabo', 'Config.pm.tmpl' ); local *MOD; open MOD, "<$file" or die "can't open $file: $!\n"; my $mod = join '', ; close MOD or die "can't close $file: $!\n"; my $c = "(\n"; foreach my $k (@keys) { my $val; if ( length $config->{$k} ) { $val = "'$config->{$k}'"; } else { $val = "undef"; } $c .= "'$k' => $val,\n"; } $c .= ")"; $mod =~ s/"'CONFIG'"/$c/; my $config_pm = File::Spec->catfile( 'lib', 'Alzabo', 'Config.pm' ); open MOD, '>', $config_pm or die "can't write to $config_pm: $!\n"; print MOD $mod or die "can't write to $config_pm: $!\n"; close MOD or die "can't close $config_pm: $!\n"; } sub test_config { my $tests = shift; return if $opts{automated}; my @config; my %names = ( mysql => 'Mysql', pg => 'Postgres', oracle => 'Oracle' ); foreach my $t ( sort keys %$tests ) { my $name = $names{$t}; print <<'EOF'; The information from the following questions are used solely for testing the pieces of Alzabo that require a real database for proper testing. EOF my $do = Module::Build->prompt( " Do tests with $name RDBMS?", 'yes' ); next unless $do =~ /^y/i; print <<"EOF"; Please provide a username that can be used to connect to the $name RDBMS? This user must have the ability to create a new database/schema. EOF my $user = Module::Build->prompt( ' Username?' ); my $password; if ($user) { $password = Module::Build->prompt( " Password for $user?" ); } print <<"EOF"; What host is the $name RDBMS located on. Press enter to skip this if the database server is located on the localhost or can be determined in another way (for example, Oracle can use TNS to find the database). EOF my $host = Module::Build->prompt( ' Host?' ); print <<"EOF"; What port is the $name RDBMS located on. Press enter to skip this. EOF my $port = Module::Build->prompt( ' Port?' ); print <<'EOF'; Please provide a database name that can be used for testing. A database/schema with this name will be created and dropped during the testing process. EOF my $db_name = Module::Build->prompt( ' Database name?', "test_alzabo_$t" ); push @config, { rdbms => $t, user => $user, password => $password, host => $host, port => $port, schema_name => $db_name, }; } return \@config; } Alzabo-0.92/eg/0000755000175000017500000000000010721343227013110 5ustar autarchautarchAlzabo-0.92/eg/alzabo_grep0000555000175000017500000000071310721343227015322 0ustar autarchautarch#!/usr/bin/perl -w use strict; use Alzabo::Create; my ($re, $schema) = @ARGV; unless ( defined $re && defined $schema ) { print "Usage: alzabo_grep regex schema\n"; exit; } my $s = Alzabo::Create::Schema->load_from_file( name => $schema ); print "\n"; $re = qr/$re/; foreach my $t ( $s->tables ) { foreach my $c ( $t->columns ) { print $t->name . ' . ' . $c->name . "\n" if $c->name =~ /$re/; } } print "\n"; Alzabo-0.92/eg/reverse_cardinality.pl0000555000175000017500000000112410721343227017502 0ustar autarchautarch#!/usr/bin/perl -w use strict; use Alzabo::Create::Schema; unless (@ARGV) { print <<'EOF'; This script requires at least one argument, a schema name. If it is given multiple arguments it will treat them all as script names EOF exit 0; } foreach (@ARGV) { my $s = Alzabo::Create::Schema->load_from_file( name => $_ ); reverse_cardinality($s); } sub reverse_cardinality { my $s = shift; foreach my $t ($s->tables) { foreach my $fk ($t->all_foreign_keys) { my @c = $fk->cardinality; $fk->set_cardinality(@c[1,0]); } } $s->save_to_file; } Alzabo-0.92/eg/alzabo_to_ascii0000555000175000017500000001067410721343227016166 0ustar autarchautarch#!/usr/bin/perl use warnings; use strict; use Alzabo::Create; use Text::Autoformat qw(autoformat form); my $name; unless ( $name = $ARGV[0] ) { print "Usage: alzabo_to_ascii schema\n"; exit; } my $schema = Alzabo::Create::Schema->load_from_file( name => $name ); my @out; # 60 chars wide ############################################################################### my $schema_title = <<'EOF'; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ------------------------------------------------------------------------------- EOF ############################################################################### my $table_title = <<'EOF'; [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ ----------------------------------------------------------------------------- \| Name \| Type \| Null? \| Default \| \| ----------------------------------------------------------------------------- EOF my $column = <<'EOF'; \| [[[[[[[[[[[[[[[[[[[[[[[[ \| [[[[[[[[[[[[[[[[[[[[[[ \| [[[[[ \| [[[[[[[[ \| [[ \| EOF my $column_comment = <<'EOF'; \| - [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \| EOF my $fk_comment = <<'EOF'; \| - [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \| EOF my $lj_table_line = <<'EOF'; \| [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \| EOF render_schema($schema); print join '', @out; sub render_schema { my $schema = shift; push @out, form $schema_title, 'Schema: ' . $schema->name . ' (' . $schema->rules->rules_id . ')'; foreach my $t ($schema->tables) { render_table($t); } } sub render_table { my $t = shift; # indent 2 spaces push @out, form $table_title, $t->name; foreach my $c ($t->columns) { render_column($c); } push @out, ' ' . '-' x 77; push @out, "\n"; if ( $t->all_foreign_keys ) { push @out, form $lj_table_line, 'Foreign keys'; push @out, ' ' . '-' x 77; push @out, "\n"; foreach my $fk ($t->all_foreign_keys) { render_foreign_key($fk); push @out, ' ' . '-' x 77; push @out, "\n"; } } if ( $t->indexes ) { push @out, form $lj_table_line, 'Indexes'; push @out, ' ' . '-' x 77; push @out, "\n"; foreach my $i ($t->indexes) { render_index($i); push @out, ' ' . '-' x 77; push @out, "\n"; } } push @out, "\n"; my $comment = $t->comment; if ( defined $comment && length $comment ) { $comment =~ s/\r\n?/\n/g; $comment =~ s/\n$//; push @out, autoformat( $comment, { all => 1 } ); push @out, "\n\n"; } } sub render_column { my $c = shift; my $type = $c->type; if ( $c->length ) { $type .= '('; $type .= $c->length; $type .= ', ' . $c->precision if $c->precision; $type .= ')'; } if ($c->attributes) { $type .= ' '; $type .= join ' ', sort $c->attributes; } push @out, form $column, ( $c->name, $type, ( $c->nullable ? 'Y' : '' ), ( defined $c->default ? $c->default : ''), ( $c->is_primary_key ? 'PK' : '' ) ); my $comment = $c->comment; if ( defined $comment && length $comment ) { push @out, form $column_comment, $comment; } } sub render_foreign_key { my $fk = shift; foreach my $p ( $fk->column_pairs ) { push @out, form $lj_table_line, $p->[0]->name . ' => ' . $p->[1]->table->name . '.' . $p->[1]->name; } my $to = $fk->table_to->name; my ($amount, $verb); my $plural = ''; if ( $fk->from_is_dependent ) { $verb = 'must be'; if ( $fk->is_one_to_many ) { $amount = 'one or more'; $plural = 's'; } else { $amount = 'one and only one'; } } else { $verb = 'can be'; if ( $fk->is_one_to_many ) { $amount = 'zero or more'; $plural = 's'; } else { $amount = 'zero or one'; } } push @out, form $lj_table_line, "There $verb $amount corresponding row$plural in the foreign table"; my $comment = $fk->comment; if ( length $comment ) { push @out, form $fk_comment, $comment; } } sub render_index { my $i = shift; my @i; foreach my $c ( $i->columns ) { my $spec = $c->name; $spec .= '(' . $i->prefix($c) . ')' if $i->prefix($c); push @i, $spec; } my $out = join ', ', @i; $out .= ' -- unique' if $i->unique; $out .= ' -- fulltext' if $i->fulltext; push @out, form $lj_table_line, $out; } Alzabo-0.92/eg/convert.pl0000555000175000017500000001576510721343227015144 0ustar autarchautarch#!/usr/bin/perl -w use strict; use Alzabo::Create; use ExtUtils::MakeMaker qw(prompt); use Getopt::Long; my $V = $Alzabo::VERSION; use vars qw($name); unless (@ARGV) { @ARGV = Alzabo::Config::available_schemas(); print "No arguments given. Converting all schemas\n\n"; } my @eval; foreach my $s_name (@ARGV) { @eval = (); my $s = Alzabo::Create::Schema->load_from_file( name => $s_name ); push @eval, "use strict;\n\nuse Alzabo::Create::Schema;\n\n"; push @eval, "my (\$t, \$d);\n"; dump_schema($s, 'schema'); push @eval, "\$schema->save_to_file;\n"; print <<"EOF"; The code necessary to recreate the $s_name schema has been created. EOF save_schema($s_name); } sub dump_schema { my $s = shift; local $name = shift; my $recursed = shift; push @eval, "my \$$name = Alzabo::Create::Schema->new("; my $n = $s->name; $n =~ s/'/\\'/g; push @eval, "\tname => '$n',"; my $rdbms; if ($V > 0.20) { $rdbms = $s->rules->rules_id; } else { ($rdbms) = (split /::/, ref $s->rules)[2]; } push @eval, "\trdbms => '$rdbms',"; push @eval, ");\n"; dump_table($_) foreach $s->tables; dump_foreign_key($_) foreach map { $_->all_foreign_keys } $s->tables; dump_column_ownership($_) foreach map { $_->columns } $s->tables; if ($s->instantiated) { push @eval, "\$$name\->set_instantiated(1);\n"; } if ($s->{original} && not $recursed) { push @eval, "# Previous generation of schema\n"; dump_schema($s->{original}, 'original', 1); push @eval, "\$$name\->{original} = \$original;\n"; } } sub dump_table { my $t = shift; push @eval, "\$t = \$$name\->make_table("; my $n = $t->name; $n =~ s/'/\\'/g; push @eval, "\tname => '$n',"; push @eval, ");\n"; dump_column($_) foreach $t->columns; foreach ($t->primary_key) { push @eval, "\$t->add_primary_key( \$t->column('" . $_->name . "') );"; } dump_index($_) foreach $t->indexes; push @eval, "\n"; } sub dump_column { my $c = shift; push @eval, "\$t->make_column("; my $n = $c->name; $n =~ s/'/\\'/g; push @eval, "\tname => '$n',"; push @eval, "\tsequenced => " . ($c->sequenced ? 1 : 0) . ","; my $method = $V < 0.20 ? 'null' : 'nullable'; push @eval, "\tnullable => " . ($c->$method() ? 1 : 0) . ","; if ($c->attributes) { my @a; foreach ( $c->attributes ) { if ( /default\s*(.*)/ ) { my $d = $1; $d =~ s/'/\\'/g; push @eval, "\tdefault => '$d',"; } else { push @a, $_; } } if (@a) { push @eval, "\tattributes => [" . (join ', ', map { s/'/\\'/g; "'$_'" } @a) . '],'; } } if ($V >= 0.20 && defined $c->default) { my $d = $c->default; $d =~ s/'/\\'/g; push @eval, "\tdefault => '$d',"; } my %p; $p{type} = $c->type; if ($p{type} !~ /enum|set/i && $p{type} =~ /(.+)\((\d+)(?:\s*,\s*(\d+))?\)$/) { $p{type} = $1; $p{length} = $2; $p{precision} = $3; } if ($V >= 0.20 && defined $c->length) { $p{length} = $c->length; $p{precision} = $c->precision; } while ( my ($k, $v) = each %p ) { next unless defined $v; $v =~ s/'/\\'/g; push @eval, "\t$k => '$v',"; } push @eval, ");\n"; } sub dump_index { my $i = shift; push @eval, "\$t->make_index("; push @eval, "\tunique => " . ($i->unique ? 1 : 0) . ","; push @eval, "\tfulltext => " . ($i->fulltext ? 1 : 0) . "," if $V >= 0.45; push @eval, "\tcolumns => ["; foreach ( $i->columns ) { my %p; $p{column} = "\$t->column('" . $_->name . "')"; if ( defined $i->prefix($_) ) { $p{prefix} = $i->prefix($_); } push @eval, "\t\t{ "; while ( my ($k, $v) = each %p ) { push @eval, "\t\t\t$k => $v,"; } push @eval, "\t\t},"; } push @eval, "] );\n"; } my %fk; sub dump_foreign_key { my $fk = shift; my @from_id = ( $V < 0.25 ? qw( column_from column_to ) : qw( columns_from columns_to ) ); my $id1 = join "\0", map { $_->name } map { $fk->$_() } @from_id, qw( table_from table_to ); $id1 .= "\0"; if ($V < 0.52) { $id1 .= join "\0", $fk->min_max_from, $fk->min_max_to; } else { $id1 .= join "\0", $fk->cardinality; } my @to_id = ( $V < 0.25 ?qw( column_to column_from ) : qw( columns_to columns_from ) ); my $id2 = join "\0", map { $_->name } map { $fk->$_() } @to_id, qw( table_to table_from ); $id2 .= "\0"; if ($V < 0.52) { $id2 .= join "\0", $fk->min_max_to, $fk->min_max_from; } else { $id2 .= join "\0", reverse $fk->cardinality; } return if $fk{$id1} || $fk{$id2}; push @eval, "\$$name\->add_relation("; foreach ( qw( table_from table_to ) ) { my $table = $fk->$_()->name; push @eval, "\t$_ => \$$name\->table('$table'),"; } foreach my $key ( $V < 0.25 ? qw( column_from column_to ) : qw( columns_from columns_to ) ) { my ($table, $columns); if ( $V < 0.25 ) { $table = $fk->$key()->table->name; $columns = $fk->$key()->name; $columns = "'$columns'"; } else { $table = ($fk->$key())[0]->table->name; $columns = join ', ', map { "'$_'" } map { $_->name } $fk->$key(); } $key =~ s/_/s_/ if $V < 0.25; push @eval, "\t$key => [ \$$name\->table('$table')->columns($columns) ],"; } my ($cardinality, $from_is_dependent, $to_is_dependent); if ($V < 0.52) { # reverses cardinality for older schemas $cardinality = join ', ', map { $_ =~ /\D/ ? "'$_'" : $_ } ($fk->min_max_to)[1], ($fk->min_max_from)[1]; $from_is_dependent = ($fk->min_max_from)[0] ? 1 : 0; $to_is_dependent = ($fk->min_max_to)[0] ? 1 : 0; } else { $cardinality = join ', ', $fk->cardinality; $from_is_dependent = $fk->from_is_dependent ? 1 : 0; $to_is_dependent = $fk->to_is_dependent ? 1 : 0; } push @eval, "\tcardinality => [ $cardinality ],"; push @eval, "\tfrom_is_dependent => $from_is_dependent,"; push @eval, "\tto_is_dependent => $to_is_dependent,"; push @eval, ");\n"; $fk{$id1} = $fk{$id2} = 1; } sub dump_column_ownership { my $c = shift; return if $c eq $c->definition->owner; my $table = $c->table->name; my $column = $c->name; my $owner = $c->definition->owner->name; my $owner_table = $c->definition->owner->table->name; push @eval, "\$d = \$$name\->table('$owner_table')->column('$owner')->definition;"; push @eval, "\$$name\->table('$table')->column('$column')->set_definition( \$d );\n"; } sub save_schema { my $s_name = shift; my $file = prompt( "File to which schema should be written?", "${s_name}_schema.pl" ); local *S; open S, ">$file" or die "Cannot open file '$file': $!\n"; unless ( print S (join "\n", @eval) ) { die "Cannot write to file '$file': $!\n"; } close S or die "Cannot close file '$file': $!\n"; print <<"EOF"; The schema has been saved to $file. To use this file, you will first have to install the version of Alzabo that includes this script. Then you can simply run: $^X $file This will overwrite the existing files for the $s_name schema EOF }