[Bast-commits] r7847 - in
branches/DBIx-Class-Schema-Loader/back-compat:
lib/DBIx/Class/Schema/Loader t t/backcompat
t/backcompat/0.04006 t/backcompat/0.04006/lib
t/backcompat/0.04006/lib/DBIXCSL_Test
t/backcompat/0.04006/lib/DBIXCSL_Test/Schema
t/backcompat/0.04006/lib/DBIx t/backcompat/0.04006/lib/DBIx/Class
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Mon Nov 9 19:04:57 GMT 2009
Author: caelum
Date: 2009-11-09 19:04:52 +0000 (Mon, 09 Nov 2009)
New Revision: 7847
Added:
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/10sqlite_common.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/11mysql_common.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/12pg_common.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/13db2_common.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/14ora_common.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/20invocations.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/21misc_fatal.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/22dump.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/23dumpmore.t
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIXCSL_Test/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditional.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditionalBase.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestLeftBase.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/make_dbictest_db.pm
Modified:
branches/DBIx-Class-Schema-Loader/back-compat/lib/DBIx/Class/Schema/Loader/Base.pm
Log:
this stuff does not work yet
Modified: branches/DBIx-Class-Schema-Loader/back-compat/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/lib/DBIx/Class/Schema/Loader/Base.pm 2009-11-06 15:01:30 UTC (rev 7846)
+++ branches/DBIx-Class-Schema-Loader/back-compat/lib/DBIx/Class/Schema/Loader/Base.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -33,6 +33,7 @@
moniker_map
inflect_singular
inflect_plural
+ naming
debug
dump_directory
dump_overwrite
@@ -73,6 +74,55 @@
Skip setting up relationships. The default is to attempt the loading
of relationships.
+=head2 naming
+
+Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX
+relationship names and singularized Results, unless you're overwriting an
+existing dump made by a 0.04XXX version of L<DBIx::Class::Schema::Loader>, in
+which case the backward compatible RelBuilder will be activated, and
+singularization will be turned off.
+
+Specifying
+
+ naming => 'v5'
+
+will disable the backward-compatible RelBuilder and use
+the new-style relationship names along with singularized Results, even when
+overwriting a dump made with an earlier version.
+
+The option also takes a hashref:
+
+ naming => { relationships => 'v5', results => 'v4' }
+
+The values can be:
+
+=over 4
+
+=item current
+
+Latest default style, whatever that happens to be.
+
+=item v5
+
+Version 0.05XXX style.
+
+=item v4
+
+Version 0.04XXX style.
+
+=back
+
+Dynamic schemas will always default to the 0.04XXX relationship names and won't
+singularize Results for backward compatibility, to activate the new RelBuilder
+and singularization put this in your C<Schema.pm> file:
+
+ __PACKAGE__->naming('current');
+
+Or if you prefer to use 0.05XXX features but insure that nothing breaks in the
+next major version upgrade:
+
+ __PACKAGE__->naming('v5');
+
=head2 debug
If set to true, each constructive L<DBIx::Class> statement the loader
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/10sqlite_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/10sqlite_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/10sqlite_common.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,22 @@
+use strict;
+use lib qw(t/lib);
+use dbixcsl_common_tests;
+
+eval { require DBD::SQLite };
+my $class = $@ ? 'SQLite2' : 'SQLite';
+
+{
+ my $tester = dbixcsl_common_tests->new(
+ vendor => 'SQLite',
+ auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY',
+ dsn => "dbi:$class:dbname=./t/sqlite_test",
+ user => '',
+ password => '',
+ );
+
+ $tester->run_tests();
+}
+
+END {
+ unlink './t/sqlite_test';
+}
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/11mysql_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/11mysql_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/11mysql_common.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,29 @@
+use strict;
+use lib qw(t/lib);
+use dbixcsl_common_tests;
+
+my $dsn = $ENV{DBICTEST_MYSQL_DSN} || '';
+my $user = $ENV{DBICTEST_MYSQL_USER} || '';
+my $password = $ENV{DBICTEST_MYSQL_PASS} || '';
+my $test_innodb = $ENV{DBICTEST_MYSQL_INNODB} || 0;
+
+my $skip_rels_msg = 'You need to set the DBICTEST_MYSQL_INNODB environment variable to test relationships';
+
+my $tester = dbixcsl_common_tests->new(
+ vendor => 'Mysql',
+ auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT',
+ innodb => $test_innodb ? q{Engine=InnoDB} : 0,
+ dsn => $dsn,
+ user => $user,
+ password => $password,
+ skip_rels => $test_innodb ? 0 : $skip_rels_msg,
+ no_inline_rels => 1,
+ no_implicit_rels => 1,
+);
+
+if( !$dsn || !$user ) {
+ $tester->skip_tests('You need to set the DBICTEST_MYSQL_DSN, _USER, and _PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/12pg_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/12pg_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/12pg_common.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,22 @@
+use strict;
+use lib qw(t/lib);
+use dbixcsl_common_tests;
+
+my $dsn = $ENV{DBICTEST_PG_DSN} || '';
+my $user = $ENV{DBICTEST_PG_USER} || '';
+my $password = $ENV{DBICTEST_PG_PASS} || '';
+
+my $tester = dbixcsl_common_tests->new(
+ vendor => 'Pg',
+ auto_inc_pk => 'SERIAL NOT NULL PRIMARY KEY',
+ dsn => $dsn,
+ user => $user,
+ password => $password,
+);
+
+if( !$dsn || !$user ) {
+ $tester->skip_tests('You need to set the DBICTEST_PG_DSN, _USER, and _PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/13db2_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/13db2_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/13db2_common.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,23 @@
+use strict;
+use lib qw(t/lib);
+use dbixcsl_common_tests;
+
+my $dsn = $ENV{DBICTEST_DB2_DSN} || '';
+my $user = $ENV{DBICTEST_DB2_USER} || '';
+my $password = $ENV{DBICTEST_DB2_PASS} || '';
+
+my $tester = dbixcsl_common_tests->new(
+ vendor => 'DB2',
+ auto_inc_pk => 'INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY',
+ dsn => $dsn,
+ user => $user,
+ password => $password,
+ db_schema => uc $user,
+);
+
+if( !$dsn || !$user ) {
+ $tester->skip_tests('You need to set the DBICTEST_DB2_DSN, _USER, and _PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/14ora_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/14ora_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/14ora_common.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,40 @@
+use strict;
+use lib qw(t/lib);
+use dbixcsl_common_tests;
+
+my $dsn = $ENV{DBICTEST_ORA_DSN} || '';
+my $user = $ENV{DBICTEST_ORA_USER} || '';
+my $password = $ENV{DBICTEST_ORA_PASS} || '';
+
+my $tester = dbixcsl_common_tests->new(
+ vendor => 'Oracle',
+ auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY',
+ auto_inc_cb => sub {
+ my ($table, $col) = @_;
+ return (
+ qq{ CREATE SEQUENCE ${table}_${col}_seq START WITH 1 INCREMENT BY 1},
+ qq{
+ CREATE OR REPLACE TRIGGER ${table}_${col}_trigger
+ BEFORE INSERT ON ${table}
+ FOR EACH ROW
+ BEGIN
+ SELECT ${table}_${col}_seq.nextval INTO :NEW.${col} FROM dual;
+ END;
+ }
+ );
+ },
+ auto_inc_drop_cb => sub {
+ my ($table, $col) = @_;
+ return qq{ DROP SEQUENCE ${table}_${col}_seq };
+ },
+ dsn => $dsn,
+ user => $user,
+ password => $password,
+);
+
+if( !$dsn || !$user ) {
+ $tester->skip_tests('You need to set the DBICTEST_ORA_DSN, _USER, and _PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/20invocations.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/20invocations.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/20invocations.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,102 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use make_dbictest_db;
+
+# Takes a $schema as input, runs 4 basic tests
+sub test_schema {
+ my ($testname, $schema) = @_;
+
+ $schema = $schema->clone if !ref $schema;
+ isa_ok($schema, 'DBIx::Class::Schema', $testname);
+
+ my $foo_rs = $schema->resultset('Bar')->search({ barid => 3})->search_related('fooref');
+ isa_ok($foo_rs, 'DBIx::Class::ResultSet', $testname);
+
+ my $foo_first = $foo_rs->first;
+ like(ref $foo_first, qr/DBICTest::Schema::\d+::Foo/, $testname);
+
+ my $foo_first_text = $foo_first->footext;
+ is($foo_first_text, 'Foo record associated with the Bar with barid 3');
+}
+
+my @invocations = (
+ 'hardcode' => sub {
+ package DBICTest::Schema::5;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->connection($make_dbictest_db::dsn);
+ __PACKAGE__;
+ },
+ 'normal' => sub {
+ package DBICTest::Schema::6;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->loader_options();
+ __PACKAGE__->connect($make_dbictest_db::dsn);
+ },
+ 'make_schema_at' => sub {
+ use DBIx::Class::Schema::Loader qw/ make_schema_at /;
+ make_schema_at(
+ 'DBICTest::Schema::7',
+ { really_erase_my_files => 1 },
+ [ $make_dbictest_db::dsn ],
+ );
+ DBICTest::Schema::7->clone;
+ },
+ 'embedded_options' => sub {
+ package DBICTest::Schema::8;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->connect(
+ $make_dbictest_db::dsn,
+ { loader_options => { really_erase_my_files => 1 } }
+ );
+ },
+ 'embedded_options_in_attrs' => sub {
+ package DBICTest::Schema::9;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->connect(
+ $make_dbictest_db::dsn,
+ undef,
+ undef,
+ { AutoCommit => 1, loader_options => { really_erase_my_files => 1 } }
+ );
+ },
+ 'embedded_options_make_schema_at' => sub {
+ use DBIx::Class::Schema::Loader qw/ make_schema_at /;
+ make_schema_at(
+ 'DBICTest::Schema::10',
+ { },
+ [
+ $make_dbictest_db::dsn,
+ { loader_options => { really_erase_my_files => 1 } },
+ ],
+ );
+ "DBICTest::Schema::10";
+ },
+ 'almost_embedded' => sub {
+ package DBICTest::Schema::11;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->loader_options( really_erase_my_files => 1 );
+ __PACKAGE__->connect(
+ $make_dbictest_db::dsn,
+ undef, undef, { AutoCommit => 1 }
+ );
+ },
+ 'make_schema_at_explicit' => sub {
+ use DBIx::Class::Schema::Loader;
+ DBIx::Class::Schema::Loader::make_schema_at(
+ 'DBICTest::Schema::12',
+ { really_erase_my_files => 1 },
+ [ $make_dbictest_db::dsn ],
+ );
+ DBICTest::Schema::12->clone;
+ }
+);
+
+# 4 tests per k/v pair
+plan tests => 2 * @invocations;
+
+while(@invocations >= 2) {
+ my $style = shift @invocations;
+ my $subref = shift @invocations;
+ test_schema($style, &$subref);
+}
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/21misc_fatal.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/21misc_fatal.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/21misc_fatal.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,26 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use make_dbictest_db;
+
+{
+ $INC{'DBIx/Class/Storage/xyzzy.pm'} = 1;
+ package DBIx::Class::Storage::xyzzy;
+ use base qw/ DBIx::Class::Storage /;
+ sub new { bless {}, shift }
+ sub connect_info { @_ }
+
+ package DBICTest::Schema;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->loader_options( really_erase_my_files => 1 );
+ __PACKAGE__->storage_type( '::xyzzy' );
+}
+
+plan tests => 1;
+
+eval { DBICTest::Schema->connect($make_dbictest_db::dsn) };
+like(
+ $@,
+ qr/Could not load storage_type loader "DBIx::Class::Schema::Loader::xyzzy": /,
+ 'Bad storage type dies correctly'
+);
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/22dump.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/22dump.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/22dump.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,64 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use File::Path;
+use make_dbictest_db;
+
+my $dump_path = './t/_dump';
+
+{
+ package DBICTest::Schema::1;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->loader_options(
+ dump_directory => $dump_path,
+ );
+}
+
+{
+ package DBICTest::Schema::2;
+ use base qw/ DBIx::Class::Schema::Loader /;
+ __PACKAGE__->loader_options(
+ dump_directory => $dump_path,
+ really_erase_my_files => 1,
+ );
+}
+
+plan tests => 5;
+
+rmtree($dump_path, 1, 1);
+
+eval { DBICTest::Schema::1->connect($make_dbictest_db::dsn) };
+ok(!$@, 'no death with dump_directory set') or diag "Dump failed: $@";
+
+DBICTest::Schema::1->_loader_invoked(undef);
+
+SKIP: {
+ my @warnings_regexes = (
+ qr|Dumping manual schema|,
+ qr|Schema dump completed|,
+ );
+
+ skip "ActiveState perl produces additional warnings", scalar @warnings_regexes
+ if ($^O eq 'MSWin32');
+
+ my @warn_output;
+ {
+ local $SIG{__WARN__} = sub { push(@warn_output, @_) };
+ DBICTest::Schema::1->connect($make_dbictest_db::dsn);
+ }
+
+ like(shift @warn_output, $_) foreach (@warnings_regexes);
+
+ rmtree($dump_path, 1, 1);
+}
+
+eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) };
+ok(!$@, 'no death with dump_directory set (overwrite1)')
+ or diag "Dump failed: $@";
+
+DBICTest::Schema::2->_loader_invoked(undef);
+eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) };
+ok(!$@, 'no death with dump_directory set (overwrite2)')
+ or diag "Dump failed: $@";
+
+END { rmtree($dump_path, 1, 1); }
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/23dumpmore.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/23dumpmore.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/23dumpmore.t 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,269 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use File::Path;
+use make_dbictest_db;
+require DBIx::Class::Schema::Loader;
+
+$^O eq 'MSWin32'
+ ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
+ : plan(tests => 85);
+
+my $DUMP_PATH = './t/_dump';
+
+sub do_dump_test {
+ my %tdata = @_;
+
+ my $schema_class = $tdata{classname};
+
+ no strict 'refs';
+ @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
+ $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});
+
+ my @warns;
+ eval {
+ local $SIG{__WARN__} = sub { push(@warns, @_) };
+ $schema_class->connect($make_dbictest_db::dsn);
+ };
+ my $err = $@;
+ $schema_class->storage->disconnect if !$err && $schema_class->storage;
+ undef *{$schema_class};
+
+ is($err, $tdata{error});
+
+ my $check_warns = $tdata{warnings};
+ is(@warns, @$check_warns);
+ for(my $i = 0; $i <= $#$check_warns; $i++) {
+ like($warns[$i], $check_warns->[$i]);
+ }
+
+ my $file_regexes = $tdata{regexes};
+ my $file_neg_regexes = $tdata{neg_regexes} || {};
+ my $schema_regexes = delete $file_regexes->{schema};
+
+ my $schema_path = $DUMP_PATH . '/' . $schema_class;
+ $schema_path =~ s{::}{/}g;
+ dump_file_like($schema_path . '.pm', @$schema_regexes);
+ foreach my $src (keys %$file_regexes) {
+ my $src_file = $schema_path . '/' . $src . '.pm';
+ dump_file_like($src_file, @{$file_regexes->{$src}});
+ }
+ foreach my $src (keys %$file_neg_regexes) {
+ my $src_file = $schema_path . '/' . $src . '.pm';
+ dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
+ }
+}
+
+sub dump_file_like {
+ my $path = shift;
+ open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
+ my $contents = do { local $/; <$dumpfh>; };
+ close($dumpfh);
+ like($contents, $_) for @_;
+}
+
+sub dump_file_not_like {
+ my $path = shift;
+ open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
+ my $contents = do { local $/; <$dumpfh>; };
+ close($dumpfh);
+ unlike($contents, $_) for @_;
+}
+
+sub append_to_class {
+ my ($class, $string) = @_;
+ $class =~ s{::}{/}g;
+ $class = $DUMP_PATH . '/' . $class . '.pm';
+ open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
+ print $appendfh $string;
+ close($appendfh);
+}
+
+rmtree($DUMP_PATH, 1, 1);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_classes/,
+ ],
+ Foo => [
+ qr/package DBICTest::DumpMore::1::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ Bar => [
+ qr/package DBICTest::DumpMore::1::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_classes/,
+ ],
+ Foo => [
+ qr/package DBICTest::DumpMore::1::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n# XXX This is my custom content XXX/,
+ ],
+ Bar => [
+ qr/package DBICTest::DumpMore::1::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { really_erase_my_files => 1 },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Deleting existing file /,
+ qr/Deleting existing file /,
+ qr/Deleting existing file /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_classes/,
+ ],
+ Foo => [
+ qr/package DBICTest::DumpMore::1::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ Bar => [
+ qr/package DBICTest::DumpMore::1::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+ neg_regexes => {
+ Foo => [
+ qr/# XXX This is my custom content XXX/,
+ ],
+ },
+);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { use_namespaces => 1 },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_namespaces/,
+ ],
+ 'Result/Foo' => [
+ qr/package DBICTest::DumpMore::1::Result::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ 'Result/Bar' => [
+ qr/package DBICTest::DumpMore::1::Result::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { use_namespaces => 1,
+ result_namespace => 'Res',
+ resultset_namespace => 'RSet',
+ default_resultset_class => 'RSetBase',
+ },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_namespaces/,
+ qr/result_namespace => 'Res'/,
+ qr/resultset_namespace => 'RSet'/,
+ qr/default_resultset_class => 'RSetBase'/,
+ ],
+ 'Res/Foo' => [
+ qr/package DBICTest::DumpMore::1::Res::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ 'Res/Bar' => [
+ qr/package DBICTest::DumpMore::1::Res::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { use_namespaces => 1,
+ result_namespace => '+DBICTest::DumpMore::1::Res',
+ resultset_namespace => 'RSet',
+ default_resultset_class => 'RSetBase',
+ result_base_class => 'My::ResultBaseClass',
+ schema_base_class => 'My::SchemaBaseClass',
+ },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_namespaces/,
+ qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
+ qr/resultset_namespace => 'RSet'/,
+ qr/default_resultset_class => 'RSetBase'/,
+ qr/use base 'My::SchemaBaseClass'/,
+ ],
+ 'Res/Foo' => [
+ qr/package DBICTest::DumpMore::1::Res::Foo;/,
+ qr/use base 'My::ResultBaseClass'/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ 'Res/Bar' => [
+ qr/package DBICTest::DumpMore::1::Res::Bar;/,
+ qr/use base 'My::ResultBaseClass'/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+END { rmtree($DUMP_PATH, 1, 1); }
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,7 @@
+package DBIXCSL_Test::Schema::LoaderTest1;
+
+sub loader_test1_classmeth { 'all is well' }
+
+sub loader_test1_rsmeth : ResultSet { 'all is still well' }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,5 @@
+package DBIx::Class::TestComponent;
+
+sub dbix_class_testcomponent { 'dbix_class_testcomponent works' }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,6 @@
+package DBIx::Class::TestRSComponent;
+use base qw/DBIx::Class::ResultSet/;
+
+sub dbix_class_testrscomponent { 'dbix_class_testrscomponent works' }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditional.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditional.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditional.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,5 @@
+package TestAdditional;
+
+sub test_additional { return "test_additional"; }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditionalBase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditionalBase.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestAdditionalBase.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,7 @@
+package TestAdditionalBase;
+
+sub test_additional_base { return "test_additional_base"; }
+sub test_additional_base_override { return "test_additional_base_override"; }
+sub test_additional_base_additional { return TestAdditional->test_additional; }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestLeftBase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestLeftBase.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/TestLeftBase.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,5 @@
+package TestLeftBase;
+
+sub test_additional_base_override { return "test_left_base_override"; }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,966 @@
+package dbixcsl_common_tests;
+
+use strict;
+use warnings;
+
+use Test::More;
+use DBIx::Class::Schema::Loader;
+use DBI;
+
+sub new {
+ my $class = shift;
+
+ my $self;
+
+ if( ref($_[0]) eq 'HASH') {
+ my $args = shift;
+ $self = { (%$args) };
+ }
+ else {
+ $self = { @_ };
+ }
+
+ # Only MySQL uses this
+ $self->{innodb} ||= '';
+
+ $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
+
+ return bless $self => $class;
+}
+
+sub skip_tests {
+ my ($self, $why) = @_;
+
+ plan skip_all => $why;
+}
+
+sub _monikerize {
+ my $name = shift;
+ return 'LoaderTest2X' if $name =~ /^loader_test2$/i;
+ return undef;
+}
+
+sub run_tests {
+ my $self = shift;
+
+ plan tests => 88;
+
+ $self->create();
+
+ my $schema_class = 'DBIXCSL_Test::Schema';
+
+ my $debug = ($self->{verbose} > 1) ? 1 : 0;
+
+ my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} );
+ my %loader_opts = (
+ constraint => qr/^(?:\S+\.)?loader_test[0-9]+$/i,
+ relationships => 1,
+ additional_classes => 'TestAdditional',
+ additional_base_classes => 'TestAdditionalBase',
+ left_base_classes => [ qw/TestLeftBase/ ],
+ components => [ qw/TestComponent/ ],
+ inflect_plural => { loader_test4 => 'loader_test4zes' },
+ inflect_singular => { fkid => 'fkid_singular' },
+ moniker_map => \&_monikerize,
+ debug => $debug,
+ );
+
+ $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
+ eval { require Class::Inspector };
+ if($@) {
+ $self->{_no_rs_components} = 1;
+ }
+ else {
+ $loader_opts{resultset_components} = [ qw/TestRSComponent/ ];
+ }
+
+ {
+ my @loader_warnings;
+ local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
+ eval qq{
+ package $schema_class;
+ use base qw/DBIx::Class::Schema::Loader/;
+
+ __PACKAGE__->loader_options(\%loader_opts);
+ __PACKAGE__->connection(\@connect_info);
+ };
+ ok(!$@, "Loader initialization") or diag $@;
+
+ my $warn_count = 0;
+ $warn_count++ if grep /ResultSetManager/, @loader_warnings;
+
+ if($self->{skip_rels}) {
+ is(scalar(@loader_warnings), $warn_count)
+ or diag "Did not get the expected 0 warnings. Warnings are: "
+ . join('', at loader_warnings);
+ ok(1);
+ }
+ else {
+ $warn_count++;
+ is(scalar(@loader_warnings), $warn_count)
+ or diag "Did not get the expected 1 warning. Warnings are: "
+ . join('', at loader_warnings);
+ is(grep(/loader_test9 has no primary key/, @loader_warnings), 1);
+ }
+ }
+
+ my $conn = $schema_class->clone;
+ my $monikers = {};
+ my $classes = {};
+ foreach my $source_name ($schema_class->sources) {
+ my $table_name = $schema_class->source($source_name)->from;
+ $monikers->{$table_name} = $source_name;
+ $classes->{$table_name} = $schema_class . q{::} . $source_name;
+ }
+
+ my $moniker1 = $monikers->{loader_test1};
+ my $class1 = $classes->{loader_test1};
+ my $rsobj1 = $conn->resultset($moniker1);
+
+ my $moniker2 = $monikers->{loader_test2};
+ my $class2 = $classes->{loader_test2};
+ my $rsobj2 = $conn->resultset($moniker2);
+
+ my $moniker23 = $monikers->{LOADER_TEST23};
+ my $class23 = $classes->{LOADER_TEST23};
+ my $rsobj23 = $conn->resultset($moniker1);
+
+ my $moniker24 = $monikers->{LoAdEr_test24};
+ my $class24 = $classes->{LoAdEr_test24};
+ my $rsobj24 = $conn->resultset($moniker2);
+
+ isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj23, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj24, "DBIx::Class::ResultSet" );
+
+ my @columns_lt2 = $class2->columns;
+ is($columns_lt2[0], 'id', "Column Ordering 0");
+ is($columns_lt2[1], 'dat', "Column Ordering 1");
+ is($columns_lt2[2], 'dat2', "Column Ordering 2");
+
+ my %uniq1 = $class1->unique_constraints;
+ my $uniq1_test = 0;
+ foreach my $ucname (keys %uniq1) {
+ my $cols_arrayref = $uniq1{$ucname};
+ if(@$cols_arrayref == 1 && $cols_arrayref->[0] eq 'dat') {
+ $uniq1_test = 1;
+ last;
+ }
+ }
+ ok($uniq1_test) or diag "Unique constraints not working";
+
+ my %uniq2 = $class2->unique_constraints;
+ my $uniq2_test = 0;
+ foreach my $ucname (keys %uniq2) {
+ my $cols_arrayref = $uniq2{$ucname};
+ if(@$cols_arrayref == 2
+ && $cols_arrayref->[0] eq 'dat2'
+ && $cols_arrayref->[1] eq 'dat') {
+ $uniq2_test = 2;
+ last;
+ }
+ }
+ ok($uniq2_test) or diag "Multi-col unique constraints not working";
+
+ is($moniker2, 'LoaderTest2X', "moniker_map testing");
+
+ {
+ my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth,
+ $skip_rsmeth, $skip_tcomp, $skip_trscomp);
+
+ can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1;
+ can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1;
+ can_ok( $class1, 'test_additional_base_additional' ) or $skip_taba = 1;
+ can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1;
+ can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
+
+ TODO: {
+ local $TODO = "Not yet supported by ResultSetManger code";
+ can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
+ }
+
+ SKIP: {
+ skip "Pre-requisite test failed", 1 if $skip_tab;
+ is( $class1->test_additional_base, "test_additional_base",
+ "Additional Base method" );
+ }
+
+ SKIP: {
+ skip "Pre-requisite test failed", 1 if $skip_tabo;
+ is( $class1->test_additional_base_override,
+ "test_left_base_override",
+ "Left Base overrides Additional Base method" );
+ }
+
+ SKIP: {
+ skip "Pre-requisite test failed", 1 if $skip_taba;
+ is( $class1->test_additional_base_additional, "test_additional",
+ "Additional Base can use Additional package method" );
+ }
+
+ SKIP: {
+ skip "Pre-requisite test failed", 1 if $skip_tcomp;
+ is( $class1->dbix_class_testcomponent,
+ 'dbix_class_testcomponent works' );
+ }
+
+ SKIP: {
+ skip "These two tests need Class::Inspector installed", 2
+ if $self->{_no_rs_components};
+ can_ok($rsobj1, 'dbix_class_testrscomponent') or $skip_trscomp = 1;
+ SKIP: {
+ skip "Pre-requisite test failed", 1 if $skip_trscomp;
+ is( $rsobj1->dbix_class_testrscomponent,
+ 'dbix_class_testrscomponent works' );
+ }
+ }
+
+ SKIP: {
+ skip "Pre-requisite test failed", 1 if $skip_cmeth;
+ is( $class1->loader_test1_classmeth, 'all is well' );
+ }
+
+ # XXX put this back in when the TODO above works...
+ #SKIP: {
+ # skip "Pre-requisite test failed", 1 if $skip_rsmeth;
+ # is( $rsobj1->loader_test1_rsmeth, 'all is still well' );
+ #}
+ }
+
+
+ my $obj = $rsobj1->find(1);
+ is( $obj->id, 1 );
+ is( $obj->dat, "foo" );
+ is( $rsobj2->count, 4 );
+ my $saved_id;
+ eval {
+ my $new_obj1 = $rsobj1->create({ dat => 'newthing' });
+ $saved_id = $new_obj1->id;
+ };
+ ok(!$@) or diag "Died during create new record using a PK::Auto key: $@";
+ ok($saved_id) or diag "Failed to get PK::Auto-generated id";
+
+ my $new_obj1 = $rsobj1->search({ dat => 'newthing' })->first;
+ ok($new_obj1) or diag "Cannot find newly inserted PK::Auto record";
+ is($new_obj1->id, $saved_id);
+
+ my ($obj2) = $rsobj2->search({ dat => 'bbb' })->first;
+ is( $obj2->id, 2 );
+
+ SKIP: {
+ skip $self->{skip_rels}, 50 if $self->{skip_rels};
+
+ my $moniker3 = $monikers->{loader_test3};
+ my $class3 = $classes->{loader_test3};
+ my $rsobj3 = $conn->resultset($moniker3);
+
+ my $moniker4 = $monikers->{loader_test4};
+ my $class4 = $classes->{loader_test4};
+ my $rsobj4 = $conn->resultset($moniker4);
+
+ my $moniker5 = $monikers->{loader_test5};
+ my $class5 = $classes->{loader_test5};
+ my $rsobj5 = $conn->resultset($moniker5);
+
+ my $moniker6 = $monikers->{loader_test6};
+ my $class6 = $classes->{loader_test6};
+ my $rsobj6 = $conn->resultset($moniker6);
+
+ my $moniker7 = $monikers->{loader_test7};
+ my $class7 = $classes->{loader_test7};
+ my $rsobj7 = $conn->resultset($moniker7);
+
+ my $moniker8 = $monikers->{loader_test8};
+ my $class8 = $classes->{loader_test8};
+ my $rsobj8 = $conn->resultset($moniker8);
+
+ my $moniker9 = $monikers->{loader_test9};
+ my $class9 = $classes->{loader_test9};
+ my $rsobj9 = $conn->resultset($moniker9);
+
+ my $moniker16 = $monikers->{loader_test16};
+ my $class16 = $classes->{loader_test16};
+ my $rsobj16 = $conn->resultset($moniker16);
+
+ my $moniker17 = $monikers->{loader_test17};
+ my $class17 = $classes->{loader_test17};
+ my $rsobj17 = $conn->resultset($moniker17);
+
+ my $moniker18 = $monikers->{loader_test18};
+ my $class18 = $classes->{loader_test18};
+ my $rsobj18 = $conn->resultset($moniker18);
+
+ my $moniker19 = $monikers->{loader_test19};
+ my $class19 = $classes->{loader_test19};
+ my $rsobj19 = $conn->resultset($moniker19);
+
+ my $moniker20 = $monikers->{loader_test20};
+ my $class20 = $classes->{loader_test20};
+ my $rsobj20 = $conn->resultset($moniker20);
+
+ my $moniker21 = $monikers->{loader_test21};
+ my $class21 = $classes->{loader_test21};
+ my $rsobj21 = $conn->resultset($moniker21);
+
+ my $moniker22 = $monikers->{loader_test22};
+ my $class22 = $classes->{loader_test22};
+ my $rsobj22 = $conn->resultset($moniker22);
+
+ my $moniker25 = $monikers->{loader_test25};
+ my $class25 = $classes->{loader_test25};
+ my $rsobj25 = $conn->resultset($moniker25);
+
+ my $moniker26 = $monikers->{loader_test26};
+ my $class26 = $classes->{loader_test26};
+ my $rsobj26 = $conn->resultset($moniker26);
+
+ isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj6, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj7, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj8, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj9, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj16, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj17, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj18, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj19, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj20, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj21, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj22, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj25, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj26, "DBIx::Class::ResultSet" );
+
+ # basic rel test
+ my $obj4 = $rsobj4->find(123);
+ isa_ok( $obj4->fkid_singular, $class3);
+
+ my $obj3 = $rsobj3->find(1);
+ my $rs_rel4 = $obj3->search_related('loader_test4zes');
+ isa_ok( $rs_rel4->first, $class4);
+
+ # find on multi-col pk
+ my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
+ is( $obj5->id2, 1 );
+
+ # mulit-col fk def
+ my $obj6 = $rsobj6->find(1);
+ isa_ok( $obj6->loader_test2, $class2);
+ isa_ok( $obj6->loader_test5, $class5);
+
+ # fk that references a non-pk key (UNIQUE)
+ my $obj8 = $rsobj8->find(1);
+ isa_ok( $obj8->loader_test7, $class7);
+
+ # test double-fk 17 ->-> 16
+ my $obj17 = $rsobj17->find(33);
+
+ my $rs_rel16_one = $obj17->loader16_one;
+ isa_ok($rs_rel16_one, $class16);
+ is($rs_rel16_one->dat, 'y16');
+
+ my $rs_rel16_two = $obj17->loader16_two;
+ isa_ok($rs_rel16_two, $class16);
+ is($rs_rel16_two->dat, 'z16');
+
+ my $obj16 = $rsobj16->find(2);
+ my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones');
+ isa_ok($rs_rel17->first, $class17);
+ is($rs_rel17->first->id, 3);
+
+ # XXX test m:m 18 <- 20 -> 19
+
+ # XXX test double-fk m:m 21 <- 22 -> 21
+
+ # test double multi-col fk 26 -> 25
+ my $obj26 = $rsobj26->find(33);
+
+ my $rs_rel25_one = $obj26->loader_test25_id_rel1;
+ isa_ok($rs_rel25_one, $class25);
+ is($rs_rel25_one->dat, 'x25');
+
+ my $rs_rel25_two = $obj26->loader_test25_id_rel2;
+ isa_ok($rs_rel25_two, $class25);
+ is($rs_rel25_two->dat, 'y25');
+
+ my $obj25 = $rsobj25->find(3,42);
+ my $rs_rel26 = $obj25->search_related('loader_test26_id_rel1s');
+ isa_ok($rs_rel26->first, $class26);
+ is($rs_rel26->first->id, 3);
+
+ # from Chisel's tests...
+ SKIP: {
+ if($self->{vendor} =~ /sqlite/i) {
+ skip 'SQLite cannot do the advanced tests', 8;
+ }
+
+ my $moniker10 = $monikers->{loader_test10};
+ my $class10 = $classes->{loader_test10};
+ my $rsobj10 = $conn->resultset($moniker10);
+
+ my $moniker11 = $monikers->{loader_test11};
+ my $class11 = $classes->{loader_test11};
+ my $rsobj11 = $conn->resultset($moniker11);
+
+ isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
+
+ my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
+
+ $obj10->update();
+ ok( defined $obj10, '$obj10 is defined' );
+
+ my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
+ $obj11->update();
+ ok( defined $obj11, '$obj11 is defined' );
+
+ eval {
+ my $obj10_2 = $obj11->loader_test10;
+ $obj10_2->loader_test11( $obj11->id11() );
+ $obj10_2->update();
+ };
+ is($@, '', 'No errors after eval{}');
+
+ SKIP: {
+ skip 'Previous eval block failed', 3
+ unless ($@ eq '');
+
+ my $results = $rsobj10->search({ subject => 'xyzzy' });
+ is( $results->count(), 1,
+ 'One $rsobj10 returned from search' );
+
+ my $obj10_3 = $results->first();
+ isa_ok( $obj10_3, $class10 );
+ is( $obj10_3->loader_test11()->id(), $obj11->id(),
+ 'found same $rsobj11 object we expected' );
+ }
+ }
+
+ SKIP: {
+ skip 'This vendor cannot do inline relationship definitions', 5
+ if $self->{no_inline_rels};
+
+ my $moniker12 = $monikers->{loader_test12};
+ my $class12 = $classes->{loader_test12};
+ my $rsobj12 = $conn->resultset($moniker12);
+
+ my $moniker13 = $monikers->{loader_test13};
+ my $class13 = $classes->{loader_test13};
+ my $rsobj13 = $conn->resultset($moniker13);
+
+ isa_ok( $rsobj12, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj13, "DBIx::Class::ResultSet" );
+
+ my $obj13 = $rsobj13->find(1);
+ isa_ok( $obj13->id, $class12 );
+ isa_ok( $obj13->loader_test12, $class12);
+ isa_ok( $obj13->dat, $class12);
+ }
+
+ SKIP: {
+ skip 'This vendor cannot do out-of-line implicit rel defs', 3
+ if $self->{no_implicit_rels};
+ my $moniker14 = $monikers->{loader_test14};
+ my $class14 = $classes->{loader_test14};
+ my $rsobj14 = $conn->resultset($moniker14);
+
+ my $moniker15 = $monikers->{loader_test15};
+ my $class15 = $classes->{loader_test15};
+ my $rsobj15 = $conn->resultset($moniker15);
+
+ isa_ok( $rsobj14, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj15, "DBIx::Class::ResultSet" );
+
+ my $obj15 = $rsobj15->find(1);
+ isa_ok( $obj15->loader_test14, $class14 );
+ }
+ }
+
+ # rescan test
+ SKIP: {
+ skip $self->{skip_rels}, 4 if $self->{skip_rels};
+
+ my @statements_rescan = (
+ qq{
+ CREATE TABLE loader_test30 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ loader_test2 INTEGER NOT NULL,
+ FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id)
+ ) $self->{innodb}
+ },
+ q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(123, 1) },
+ q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) },
+ );
+
+ my $dbh = $self->dbconnect(1);
+ $dbh->do($_) for @statements_rescan;
+ $dbh->disconnect;
+
+ my @new = $conn->rescan;
+ is(scalar(@new), 1);
+ is($new[0], 'LoaderTest30');
+
+ my $rsobj30 = $conn->resultset('LoaderTest30');
+ isa_ok($rsobj30, 'DBIx::Class::ResultSet');
+ my $obj30 = $rsobj30->find(123);
+ isa_ok( $obj30->loader_test2, $class2);
+ }
+}
+
+sub dbconnect {
+ my ($self, $complain) = @_;
+
+ my $dbh = DBI->connect(
+ $self->{dsn}, $self->{user},
+ $self->{password},
+ {
+ RaiseError => $complain,
+ PrintError => $complain,
+ AutoCommit => 1,
+ }
+ );
+
+ die "Failed to connect to database: $DBI::errstr" if !$dbh;
+
+ return $dbh;
+}
+
+sub create {
+ my $self = shift;
+
+ $self->{_created} = 1;
+
+ my $make_auto_inc = $self->{auto_inc_cb} || sub {};
+ my @statements = (
+ qq{
+ CREATE TABLE loader_test1 (
+ id $self->{auto_inc_pk},
+ dat VARCHAR(32) NOT NULL UNIQUE
+ ) $self->{innodb}
+ },
+ $make_auto_inc->(qw/loader_test1 id/),
+
+ q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
+ q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
+ q{ INSERT INTO loader_test1 (dat) VALUES('baz') },
+
+ qq{
+ CREATE TABLE loader_test2 (
+ id $self->{auto_inc_pk},
+ dat VARCHAR(32) NOT NULL,
+ dat2 VARCHAR(32) NOT NULL,
+ UNIQUE (dat2, dat)
+ ) $self->{innodb}
+ },
+ $make_auto_inc->(qw/loader_test2 id/),
+
+ q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') },
+ q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') },
+ q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') },
+ q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') },
+
+ qq{
+ CREATE TABLE LOADER_TEST23 (
+ ID INTEGER NOT NULL PRIMARY KEY,
+ DAT VARCHAR(32) NOT NULL UNIQUE
+ ) $self->{innodb}
+ },
+
+ qq{
+ CREATE TABLE LoAdEr_test24 (
+ iD INTEGER NOT NULL PRIMARY KEY,
+ DaT VARCHAR(32) NOT NULL UNIQUE
+ ) $self->{innodb}
+ },
+ );
+
+ my @statements_reltests = (
+ qq{
+ CREATE TABLE loader_test3 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(32)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') },
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') },
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') },
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') },
+
+ qq{
+ CREATE TABLE loader_test4 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ fkid INTEGER NOT NULL,
+ dat VARCHAR(32),
+ FOREIGN KEY( fkid ) REFERENCES loader_test3 (id)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') },
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') },
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') },
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') },
+
+ qq{
+ CREATE TABLE loader_test5 (
+ id1 INTEGER NOT NULL,
+ iD2 INTEGER NOT NULL,
+ dat VARCHAR(8),
+ PRIMARY KEY (id1,id2)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') },
+
+ qq{
+ CREATE TABLE loader_test6 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ Id2 INTEGER,
+ loader_test2 INTEGER,
+ dat VARCHAR(8),
+ FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
+ FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2)
+ ) $self->{innodb}
+ },
+
+ (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } .
+ q{ VALUES (1, 1,1,'aaa') }),
+
+ qq{
+ CREATE TABLE loader_test7 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ id2 VARCHAR(8) NOT NULL UNIQUE,
+ dat VARCHAR(8)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') },
+
+ qq{
+ CREATE TABLE loader_test8 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ loader_test7 VARCHAR(8) NOT NULL,
+ dat VARCHAR(8),
+ FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
+ ) $self->{innodb}
+ },
+
+ (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
+ q{ VALUES (1,'aaa','bbb') }),
+
+ qq{
+ CREATE TABLE loader_test9 (
+ loader_test9 VARCHAR(8) NOT NULL
+ ) $self->{innodb}
+ },
+
+ qq{
+ CREATE TABLE loader_test16 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(8)
+ ) $self->{innodb}
+ },
+
+ qq{ INSERT INTO loader_test16 (id,dat) VALUES (2,'x16') },
+ qq{ INSERT INTO loader_test16 (id,dat) VALUES (4,'y16') },
+ qq{ INSERT INTO loader_test16 (id,dat) VALUES (6,'z16') },
+
+ qq{
+ CREATE TABLE loader_test17 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ loader16_one INTEGER,
+ loader16_two INTEGER,
+ FOREIGN KEY (loader16_one) REFERENCES loader_test16 (id),
+ FOREIGN KEY (loader16_two) REFERENCES loader_test16 (id)
+ ) $self->{innodb}
+ },
+
+ qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (3, 2, 4) },
+ qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (33, 4, 6) },
+
+ qq{
+ CREATE TABLE loader_test18 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(8)
+ ) $self->{innodb}
+ },
+
+ qq{ INSERT INTO loader_test18 (id,dat) VALUES (1,'x18') },
+ qq{ INSERT INTO loader_test18 (id,dat) VALUES (2,'y18') },
+ qq{ INSERT INTO loader_test18 (id,dat) VALUES (3,'z18') },
+
+ qq{
+ CREATE TABLE loader_test19 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(8)
+ ) $self->{innodb}
+ },
+
+ qq{ INSERT INTO loader_test19 (id,dat) VALUES (4,'x19') },
+ qq{ INSERT INTO loader_test19 (id,dat) VALUES (5,'y19') },
+ qq{ INSERT INTO loader_test19 (id,dat) VALUES (6,'z19') },
+
+ qq{
+ CREATE TABLE loader_test20 (
+ parent INTEGER NOT NULL,
+ child INTEGER NOT NULL,
+ PRIMARY KEY (parent, child),
+ FOREIGN KEY (parent) REFERENCES loader_test18 (id),
+ FOREIGN KEY (child) REFERENCES loader_test19 (id)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test20 (parent, child) VALUES (1,4) },
+ q{ INSERT INTO loader_test20 (parent, child) VALUES (2,5) },
+ q{ INSERT INTO loader_test20 (parent, child) VALUES (3,6) },
+
+ qq{
+ CREATE TABLE loader_test21 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(8)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test21 (id,dat) VALUES (7,'a21')},
+ q{ INSERT INTO loader_test21 (id,dat) VALUES (11,'b21')},
+ q{ INSERT INTO loader_test21 (id,dat) VALUES (13,'c21')},
+ q{ INSERT INTO loader_test21 (id,dat) VALUES (17,'d21')},
+
+ qq{
+ CREATE TABLE loader_test22 (
+ parent INTEGER NOT NULL,
+ child INTEGER NOT NULL,
+ PRIMARY KEY (parent, child),
+ FOREIGN KEY (parent) REFERENCES loader_test21 (id),
+ FOREIGN KEY (child) REFERENCES loader_test21 (id)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test22 (parent, child) VALUES (7,11)},
+ q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)},
+ q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)},
+
+ qq{
+ CREATE TABLE loader_test25 (
+ id1 INTEGER NOT NULL,
+ id2 INTEGER NOT NULL,
+ dat VARCHAR(8),
+ PRIMARY KEY (id1,id2)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,5,'x25') },
+ q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,7,'y25') },
+ q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (3,42,'z25') },
+
+ qq{
+ CREATE TABLE loader_test26 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ rel1 INTEGER NOT NULL,
+ rel2 INTEGER NOT NULL,
+ FOREIGN KEY (id, rel1) REFERENCES loader_test25 (id1, id2),
+ FOREIGN KEY (id, rel2) REFERENCES loader_test25 (id1, id2)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) },
+ q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) },
+ );
+
+ my @statements_advanced = (
+ qq{
+ CREATE TABLE loader_test10 (
+ id10 $self->{auto_inc_pk},
+ subject VARCHAR(8),
+ loader_test11 INTEGER
+ ) $self->{innodb}
+ },
+ $make_auto_inc->(qw/loader_test10 id10/),
+
+ qq{
+ CREATE TABLE loader_test11 (
+ id11 $self->{auto_inc_pk},
+ message VARCHAR(8) DEFAULT 'foo',
+ loader_test10 INTEGER,
+ FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
+ ) $self->{innodb}
+ },
+ $make_auto_inc->(qw/loader_test11 id11/),
+
+ (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
+ q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
+ q{ REFERENCES loader_test11 (id11) }),
+ );
+
+ my @statements_inline_rels = (
+ qq{
+ CREATE TABLE loader_test12 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ id2 VARCHAR(8) NOT NULL UNIQUE,
+ dat VARCHAR(8) NOT NULL UNIQUE
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test12 (id,id2,dat) VALUES (1,'aaa','bbb') },
+
+ qq{
+ CREATE TABLE loader_test13 (
+ id INTEGER NOT NULL PRIMARY KEY REFERENCES loader_test12,
+ loader_test12 VARCHAR(8) NOT NULL REFERENCES loader_test12 (id2),
+ dat VARCHAR(8) REFERENCES loader_test12 (dat)
+ ) $self->{innodb}
+ },
+
+ (q{ INSERT INTO loader_test13 (id,loader_test12,dat) } .
+ q{ VALUES (1,'aaa','bbb') }),
+ );
+
+
+ my @statements_implicit_rels = (
+ qq{
+ CREATE TABLE loader_test14 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(8)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test14 (id,dat) VALUES (123,'aaa') },
+
+ qq{
+ CREATE TABLE loader_test15 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ loader_test14 INTEGER NOT NULL,
+ FOREIGN KEY (loader_test14) REFERENCES loader_test14
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) },
+ );
+
+ $self->drop_tables;
+
+ my $dbh = $self->dbconnect(1);
+
+ # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
+ local $SIG{__WARN__} = sub {
+ my $msg = shift;
+ print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
+ };
+
+ $dbh->do($_) for (@statements);
+ unless($self->{skip_rels}) {
+ # hack for now, since DB2 doesn't like inline comments, and we need
+ # to test one for mysql, which works on everyone else...
+ # this all needs to be refactored anyways.
+ $dbh->do($_) for (@statements_reltests);
+ unless($self->{vendor} =~ /sqlite/i) {
+ $dbh->do($_) for (@statements_advanced);
+ }
+ unless($self->{no_inline_rels}) {
+ $dbh->do($_) for (@statements_inline_rels);
+ }
+ unless($self->{no_implicit_rels}) {
+ $dbh->do($_) for (@statements_implicit_rels);
+ }
+ }
+ $dbh->disconnect();
+}
+
+sub drop_tables {
+ my $self = shift;
+
+ my @tables = qw/
+ loader_test1
+ loader_test2
+ LOADER_TEST23
+ LoAdEr_test24
+ /;
+
+ my @tables_auto_inc = (
+ [ qw/loader_test1 id/ ],
+ [ qw/loader_test2 id/ ],
+ );
+
+ my @tables_reltests = qw/
+ loader_test4
+ loader_test3
+ loader_test6
+ loader_test5
+ loader_test8
+ loader_test7
+ loader_test9
+ loader_test17
+ loader_test16
+ loader_test20
+ loader_test19
+ loader_test18
+ loader_test22
+ loader_test21
+ loader_test26
+ loader_test25
+ /;
+
+ my @tables_advanced = qw/
+ loader_test11
+ loader_test10
+ /;
+
+ my @tables_advanced_auto_inc = (
+ [ qw/loader_test10 id10/ ],
+ [ qw/loader_test11 id11/ ],
+ );
+
+ my @tables_inline_rels = qw/
+ loader_test13
+ loader_test12
+ /;
+
+ my @tables_implicit_rels = qw/
+ loader_test15
+ loader_test14
+ /;
+
+ my @tables_rescan = qw/ loader_test30 /;
+
+ my $drop_fk_mysql =
+ q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk};
+
+ my $drop_fk =
+ q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk};
+
+ my $dbh = $self->dbconnect(0);
+
+ my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {};
+
+ unless($self->{skip_rels}) {
+ $dbh->do("DROP TABLE $_") for (@tables_reltests);
+ unless($self->{vendor} =~ /sqlite/i) {
+ if($self->{vendor} =~ /mysql/i) {
+ $dbh->do($drop_fk_mysql);
+ }
+ else {
+ $dbh->do($drop_fk);
+ }
+ $dbh->do("DROP TABLE $_") for (@tables_advanced);
+ $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc;
+ }
+ unless($self->{no_inline_rels}) {
+ $dbh->do("DROP TABLE $_") for (@tables_inline_rels);
+ }
+ unless($self->{no_implicit_rels}) {
+ $dbh->do("DROP TABLE $_") for (@tables_implicit_rels);
+ }
+ $dbh->do("DROP TABLE $_") for (@tables_rescan);
+ }
+ $dbh->do("DROP TABLE $_") for (@tables);
+ $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc;
+ $dbh->disconnect;
+}
+
+sub DESTROY {
+ my $self = shift;
+ $self->drop_tables if $self->{_created};
+}
+
+1;
Added: branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/make_dbictest_db.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/make_dbictest_db.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/back-compat/t/backcompat/0.04006/lib/make_dbictest_db.pm 2009-11-09 19:04:52 UTC (rev 7847)
@@ -0,0 +1,37 @@
+package make_dbictest_db;
+
+use strict;
+use warnings;
+use DBI;
+
+eval { require DBD::SQLite };
+my $class = $@ ? 'SQLite2' : 'SQLite';
+
+my $fn = './t/dbictest.db';
+
+unlink($fn);
+our $dsn = "dbi:$class:dbname=$fn";
+my $dbh = DBI->connect($dsn);
+
+$dbh->do($_) for (
+ q|CREATE TABLE foo (
+ fooid INTEGER PRIMARY KEY,
+ footext TEXT
+ )|,
+ q|CREATE TABLE bar (
+ barid INTEGER PRIMARY KEY,
+ fooref INTEGER REFERENCES foo(fooid)
+ )|,
+ q|INSERT INTO foo VALUES (1,'Foo text for number 1')|,
+ q|INSERT INTO foo VALUES (2,'Foo record associated with the Bar with barid 3')|,
+ q|INSERT INTO foo VALUES (3,'Foo text for number 3')|,
+ q|INSERT INTO foo VALUES (4,'Foo text for number 4')|,
+ q|INSERT INTO bar VALUES (1,4)|,
+ q|INSERT INTO bar VALUES (2,3)|,
+ q|INSERT INTO bar VALUES (3,2)|,
+ q|INSERT INTO bar VALUES (4,1)|,
+);
+
+END { unlink($fn); }
+
+1;
More information about the Bast-commits
mailing list