[Bast-commits] r8173 - in
branches/DBIx-Class-Schema-Loader/current: .
lib/DBIx/Class/Schema lib/DBIx/Class/Schema/Loader
lib/DBIx/Class/Schema/Loader/DBI
lib/DBIx/Class/Schema/Loader/DBI/ODBC
lib/DBIx/Class/Schema/Loader/DBI/Sybase
lib/DBIx/Class/Schema/Loader/Manual
lib/DBIx/Class/Schema/Loader/RelBuilder
lib/DBIx/Class/Schema/Loader/RelBuilder/Compat 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
t/backcompat/0.04006/lib/My
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Thu Dec 24 15:16:46 GMT 2009
Author: caelum
Date: 2009-12-24 15:16:43 +0000 (Thu, 24 Dec 2009)
New Revision: 8173
Added:
branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Manual/
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Manual/UpgradingFromV4.pod
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder/
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/10sqlite_common.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/11mysql_common.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/12pg_common.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/13db2_common.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/14ora_common.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/20invocations.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/21misc_fatal.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/22dump.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/23dumpmore.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIXCSL_Test/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/ResultBaseClass.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/SchemaBaseClass.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditional.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditionalBase.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestLeftBase.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/make_dbictest_db.pm
Modified:
branches/DBIx-Class-Schema-Loader/current/
branches/DBIx-Class-Schema-Loader/current/Makefile.PL
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC/Microsoft_SQL_Server.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
Log:
r7400 at hlagh (orig r7399): ilmari | 2009-08-26 19:07:47 -0400
Branch for back-compat work
r7401 at hlagh (orig r7400): ilmari | 2009-08-26 19:09:44 -0400
Initial back-compat code
r21089 at hlagh (orig r7835): caelum | 2009-11-01 05:52:40 -0500
fix relbuilder initialization (left over from pull)
r21101 at hlagh (orig r7847): caelum | 2009-11-09 14:04:52 -0500
this stuff does not work yet
r21102 at hlagh (orig r7848): caelum | 2009-11-09 18:12:58 -0500
backcompat TODO
r21174 at hlagh (orig r7920): caelum | 2009-11-16 19:39:50 -0500
fix name of compat relbuilder
r21612 at hlagh (orig r7971): caelum | 2009-11-28 03:17:05 -0500
backcompat mode now runs more than once
r21614 at hlagh (orig r7973): caelum | 2009-11-28 03:46:00 -0500
make dynamic schemas 0.04006 mode by default
r21615 at hlagh (orig r7974): caelum | 2009-11-28 05:38:41 -0500
backcompat tests now run, but fail
r21682 at hlagh (orig r7977): caelum | 2009-11-28 20:56:06 -0500
minor changes
r21683 at hlagh (orig r7978): caelum | 2009-11-28 23:30:08 -0500
backcompat common tests now pass
r21684 at hlagh (orig r7979): caelum | 2009-11-29 00:03:34 -0500
fix regular common tests
r21685 at hlagh (orig r7980): caelum | 2009-11-29 00:23:32 -0500
update TODO
r21695 at hlagh (orig r7990): caelum | 2009-11-29 19:18:50 -0500
load external classes for dynamic schemas only
r21712 at hlagh (orig r7993): caelum | 2009-11-30 08:51:11 -0500
set old version only on Schema.pm in backcompat mode
r22272 at hlagh (orig r8161): caelum | 2009-12-24 01:49:54 -0500
replacing ::Base with ::Compat now, instead of just unshifting to @ISA, t/backcompat/0.04006/20invocations.t now passes
r22276 at hlagh (orig r8165): caelum | 2009-12-24 04:24:08 -0500
fix POD coverage and t/backcompat/0.04006/23dumpmore.t
r22277 at hlagh (orig r8166): caelum | 2009-12-24 06:03:15 -0500
implemented "naming" accessor, got rid of Loader/Compat/v0_040.pm
r22282 at hlagh (orig r8171): caelum | 2009-12-24 07:54:19 -0500
added Manual/UpgradingFromV4.pod
r22283 at hlagh (orig r8172): caelum | 2009-12-24 10:13:03 -0500
pod fixes for UpgradingFromV4
Property changes on: branches/DBIx-Class-Schema-Loader/current
___________________________________________________________________
Name: svk:merge
- 46bc3436-8211-0410-8564-d96f7a728040:/local/DBIx-Class-Schema-Loader/branches/common-dump:37173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/mssql_tweaks:7407
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/odbc-mssql:6439
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class-Schema-Loader:5726
+ 46bc3436-8211-0410-8564-d96f7a728040:/local/DBIx-Class-Schema-Loader/branches/common-dump:37173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/back-compat:8172
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/mssql_tweaks:7407
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/odbc-mssql:6439
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class-Schema-Loader:5726
Modified: branches/DBIx-Class-Schema-Loader/current/Makefile.PL
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Makefile.PL 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/Makefile.PL 2009-12-24 15:16:43 UTC (rev 8173)
@@ -27,6 +27,8 @@
install_script 'script/dbicdump';
+tests_recursive;
+
# This is my manual hack for better feature control
# If you want to change the default answer for a feature,
# set the appropriate environment variable, like
Added: branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,22 @@
+SL Backcompat Plan:
+
+*** 0.04006 mode
+
+* add a loud warning that says that we're running in backcompat mode, and refers
+ to the ::Manual::UpgradingFromV4 POD.
+* preserve custom content from un-singularized Results and delete them when in
+ upgrade mode
+
+*** backcompat tests
+
+Need a comprehensive backcompat.t
+
+*** Catalyst Helper
+
+* Add 'upgrade=1' option that upgrades from both old S::L and old helper,
+ whichever or both.
+* Warn when old helper output or 0.04000 S::L output is detected, that refers to
+ the upgrade option.
+
+Release dev S::L, announce to catalyst, dbic lists and #catalyst that testing of
+backcompat mode is needed, wait 2-3 weeks, then release 0.05000.
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -48,8 +48,16 @@
_tables
classes
monikers
+ dynamic
+ naming
+ _upgrading_from
/);
+__PACKAGE__->mk_accessors(qw/
+ version_to_dump
+ schema_version_to_dump
+/);
+
=head1 NAME
DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
@@ -73,6 +81,69 @@
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', monikers => 'v4' }
+
+The keys are:
+
+=over 4
+
+=item relationships
+
+How to name relationship accessors.
+
+=item monikers
+
+How to name Result classes.
+
+=back
+
+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
@@ -101,10 +172,11 @@
returns a false value, the code falls back to default behavior
for that table name.
-The default behavior is: C<join '', map ucfirst, split /[\W_]+/, lc $table>,
-which is to say: lowercase everything, split up the table name into chunks
-anywhere a non-alpha-numeric character occurs, change the case of first letter
-of each chunk to upper case, and put the chunks back together. Examples:
+The default behavior is to singularize the table name, and: C<join '', map
+ucfirst, split /[\W_]+/, lc $table>, which is to say: lowercase everything,
+split up the table name into chunks anywhere a non-alpha-numeric character
+occurs, change the case of first letter of each chunk to upper case, and put
+the chunks back together. Examples:
Table Name | Moniker Name
---------------------------
@@ -273,13 +345,62 @@
$self->{dump_directory} ||= $self->{temp_directory};
- $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
- $self->schema, $self->inflect_plural, $self->inflect_singular
- ) if !$self->{skip_relationships};
+ $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
+ $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
+ if (not ref $self->naming && defined $self->naming) {
+ my $naming_ver = $self->naming;
+ $self->{naming} = {
+ relationships => $naming_ver,
+ monikers => $naming_ver,
+ };
+ }
+
+ $self->_check_back_compat;
+
$self;
}
+sub _check_back_compat {
+ my ($self) = @_;
+
+# dynamic schemas will always be in 0.04006 mode, unless overridden
+ if ($self->dynamic) {
+# just in case, though no one is likely to dump a dynamic schema
+ $self->schema_version_to_dump('0.04006');
+
+ $self->naming->{relationships} ||= 'v4';
+ $self->naming->{monikers} ||= 'v4';
+
+ return;
+ }
+
+# otherwise check if we need backcompat mode for a static schema
+ my $filename = $self->_get_dump_filename($self->schema_class);
+ return unless -e $filename;
+
+ open(my $fh, '<', $filename)
+ or croak "Cannot open '$filename' for reading: $!";
+
+ while (<$fh>) {
+ if (/^# Created by DBIx::Class::Schema::Loader v((\d+)\.(\d+))/) {
+ my $real_ver = $1;
+
+ $self->schema_version_to_dump($real_ver);
+
+ # XXX when we go past .0 this will need fixing
+ my ($v) = $real_ver =~ /([1-9])/;
+ $v = "v$v";
+
+ $self->naming->{relationships} ||= $v;
+ $self->naming->{monikers} ||= $v;
+
+ last;
+ }
+ }
+ close $fh;
+}
+
sub _find_file_in_inc {
my ($self, $file) = @_;
@@ -293,24 +414,33 @@
return;
}
-sub _load_external {
+sub _class_path {
my ($self, $class) = @_;
my $class_path = $class;
$class_path =~ s{::}{/}g;
$class_path .= '.pm';
- my $real_inc_path = $self->_find_file_in_inc($class_path);
+ return $class_path;
+}
+sub _find_class_in_inc {
+ my ($self, $class) = @_;
+
+ return $self->_find_file_in_inc($self->_class_path($class));
+}
+
+sub _load_external {
+ my ($self, $class) = @_;
+
+ my $real_inc_path = $self->_find_class_in_inc($class);
+
return if !$real_inc_path;
# If we make it to here, we loaded an external definition
warn qq/# Loaded external class definition for '$class'\n/
if $self->debug;
- croak 'Failed to locate actual external module file for '
- . "'$class'"
- if !$real_inc_path;
open(my $fh, '<', $real_inc_path)
or croak "Failed to open '$real_inc_path' for reading: $!";
$self->_ext_stmt($class,
@@ -330,6 +460,13 @@
);
close($fh)
or croak "Failed to close $real_inc_path: $!";
+
+ if ($self->dynamic) { # load the class too
+ # turn off redefined warnings
+ local $SIG{__WARN__} = sub {};
+ do $real_inc_path;
+ die $@ if $@;
+ }
}
=head2 load
@@ -363,7 +500,7 @@
my ($self, $schema) = @_;
$self->{schema} = $schema;
- $self->{relbuilder}{schema} = $schema;
+ $self->_relbuilder->{schema} = $schema;
my @created;
my @current = $self->_tables_list;
@@ -378,6 +515,24 @@
return map { $self->monikers->{$_} } @$loaded;
}
+sub _relbuilder {
+ my ($self) = @_;
+
+ return if $self->{skip_relationships};
+
+ if ($self->naming->{relationships} eq 'v4') {
+ require DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040;
+ return $self->{relbuilder} ||=
+ DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040->new(
+ $self->schema, $self->inflect_plural, $self->inflect_singular
+ );
+ }
+
+ $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
+ $self->schema, $self->inflect_plural, $self->inflect_singular
+ );
+}
+
sub _load_tables {
my ($self, @tables) = @_;
@@ -402,7 +557,7 @@
# The relationship loader needs a working schema
$self->{quiet} = 1;
local $self->{dump_directory} = $self->{temp_directory};
- $self->_reload_classes(@tables);
+ $self->_reload_classes(\@tables);
$self->_load_relationships($_) for @tables;
$self->{quiet} = 0;
@@ -413,7 +568,9 @@
$self->_load_external($_)
for map { $self->classes->{$_} } @tables;
- $self->_reload_classes(@tables);
+ # Reload without unloading first to preserve any symbols from external
+ # packages.
+ $self->_reload_classes(\@tables, 0);
# Drop temporary cache
delete $self->{_cache};
@@ -422,8 +579,11 @@
}
sub _reload_classes {
- my ($self, @tables) = @_;
+ my ($self, $tables, $unload) = @_;
+ my @tables = @$tables;
+ $unload = 1 unless defined $unload;
+
# so that we don't repeat custom sections
@INC = grep $_ ne $self->dump_directory, @INC;
@@ -444,7 +604,7 @@
local *Class::C3::reinitialize = sub {};
use warnings;
- Class::Unload->unload($class);
+ Class::Unload->unload($class) if $unload;
my ($source, $resultset_class);
if (
($source = $have_source{$moniker})
@@ -452,10 +612,10 @@
&& ($resultset_class ne 'DBIx::Class::ResultSet')
) {
my $has_file = Class::Inspector->loaded_filename($resultset_class);
- Class::Unload->unload($resultset_class);
- $self->ensure_class_loaded($resultset_class) if $has_file;
+ Class::Unload->unload($resultset_class) if $unload;
+ $self->_reload_class($resultset_class) if $has_file;
}
- $self->ensure_class_loaded($class);
+ $self->_reload_class($class);
}
push @to_register, [$moniker, $class];
}
@@ -466,6 +626,16 @@
}
}
+# We use this instead of ensure_class_loaded when there are package symbols we
+# want to preserve.
+sub _reload_class {
+ my ($self, $class) = @_;
+
+ my $class_path = $self->_class_path($class);
+ delete $INC{ $class_path };
+ eval "require $class;";
+}
+
sub _get_dump_filename {
my ($self, $class) = (@_);
@@ -524,7 +694,10 @@
$schema_text .= qq|__PACKAGE__->load_classes;\n|;
}
- $self->_write_classfile($schema_class, $schema_text);
+ {
+ local $self->{version_to_dump} = $self->schema_version_to_dump;
+ $self->_write_classfile($schema_class, $schema_text);
+ }
my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
@@ -581,7 +754,7 @@
}
$text .= $self->_sig_comment(
- $DBIx::Class::Schema::Loader::VERSION,
+ $self->version_to_dump,
POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
);
@@ -792,6 +965,10 @@
sub _default_table2moniker {
my ($self, $table) = @_;
+ if ($self->naming->{monikers} eq 'v4') {
+ return join '', map ucfirst, split /[\W_]+/, lc $table;
+ }
+
return join '', map ucfirst, split /[\W_]+/,
Lingua::EN::Inflect::Number::to_S(lc $table);
}
@@ -824,7 +1001,7 @@
my $tbl_uniq_info = $self->_table_uniq_info($table);
my $local_moniker = $self->monikers->{$table};
- my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
+ my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
@@ -959,7 +1136,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -134,7 +134,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -160,7 +160,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC/Microsoft_SQL_Server.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC/Microsoft_SQL_Server.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -35,7 +35,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/ODBC.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -51,7 +51,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -160,7 +160,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -140,7 +140,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -202,7 +202,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -72,7 +72,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -42,7 +42,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -251,7 +251,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -65,7 +65,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -145,7 +145,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -300,7 +300,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Added: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Manual/UpgradingFromV4.pod
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Manual/UpgradingFromV4.pod (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Manual/UpgradingFromV4.pod 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,79 @@
+=pod
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 - Important Information
+Related to Upgrading from Version 0.04006
+
+=head1 What Changed
+
+=over 4
+
+=item *
+
+add_column
+
+The new Loader detects much more information about columns and sets flags like
+C<is_auto_increment> that it didn't set before.
+
+=item *
+
+RelBuilder
+
+The new RelBuilder will give you much nicer accessor names for relationships,
+so you will no longer have conflicts between a foreign key column and the
+relationship accessor itself.
+
+It will also more correctly infer the relationship type, e.g. some relationships
+that were previously detected as a C<has_many> will now be a C<might_have>
+(when it detects a unique constraint on the foreign key column.)
+
+=item *
+
+moniker_map
+
+Table names are now singularized when determining the C<Result> class names. So
+the table C<user_roles> would have become C<UserRoles> in C<0.04006> but now
+becomes C<UserRole> instead.
+
+=item *
+
+Support for more databases
+
+We now support Microsoft SQL Server and Sybase, and there are also improvements
+to the other backends.
+
+=back
+
+=head1 Backward Compatibility
+
+In backward compatibility mode, the Loader will use the old relationship names
+and types, and will not singularize monikers for tables.
+
+To control this behavior see L<DBIx::Class::Schema::Loader::Base/naming>.
+
+=head2 Static Schemas
+
+When reading a C<Schema.pm> from a static schema generated with an C<0.04>
+version of Loader, backward compatibility mode will default to on, unless
+overridden with the C<naming> attribute.
+
+=head2 Dynamic Schemas
+
+Dynamic schemas will always by default use C<0.04006> mode.
+
+To upgrade a dynamic schema, set the naming attribute (which is proxied to the
+loader) in your C<Schema.pm>:
+
+ __PACKAGE__->naming('current');
+
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
Added: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,44 @@
+package DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040;
+
+use strict;
+use warnings;
+use Class::C3;
+
+use base 'DBIx::Class::Schema::Loader::RelBuilder';
+
+sub _uniq_fk_rel {
+ my ($self, $local_moniker, $local_relname, $local_cols, $uniqs) = @_;
+
+ return ('has_many', $local_relname);
+}
+
+sub _remote_attrs { }
+
+sub _remote_relname {
+ my ($self, $remote_table, $cond) = @_;
+
+ my $remote_relname;
+ # for single-column case, set the remote relname to the column
+ # name, to make filter accessors work
+ if(scalar keys %{$cond} == 1) {
+ $remote_relname = $self->_inflect_singular(values %{$cond});
+ }
+ else {
+ $remote_relname = $self->_inflect_singular(lc $remote_table);
+ }
+
+ return $remote_relname;
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040 - RelBuilder for
+compatibility with DBIx::Class::Schema::Loader version 0.04006
+
+=head1 DESCRIPTION
+
+See L<DBIx::Class::Schema::Loader::Base/naming>.
+
+=cut
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -2,6 +2,7 @@
use strict;
use warnings;
+use Class::C3;
use Carp::Clan qw/^DBIx::Class/;
use Lingua::EN::Inflect::Number ();
@@ -261,7 +262,7 @@
=head1 AUTHOR
-See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
=head1 LICENSE
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm 2009-12-24 15:13:03 UTC (rev 8172)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -13,7 +13,9 @@
our $VERSION = '0.04999_12';
__PACKAGE__->mk_classaccessor('_loader_args' => {});
-__PACKAGE__->mk_classaccessors(qw/dump_to_dir _loader_invoked _loader loader_class/);
+__PACKAGE__->mk_classaccessors(qw/
+ dump_to_dir _loader_invoked _loader loader_class naming
+/);
=head1 NAME
@@ -150,6 +152,7 @@
$args->{schema_class} = $class;
weaken($args->{schema}) if ref $self;
$args->{dump_directory} ||= $self->dump_to_dir;
+ $args->{naming} = $self->naming;
# XXX this only works for relative storage_type, like ::DBI ...
my $impl = $self->loader_class
@@ -285,16 +288,23 @@
sub import {
my $self = shift;
+
return if !@_;
+
+ my $cpkg = (caller)[0];
+
foreach my $opt (@_) {
if($opt =~ m{^dump_to_dir:(.*)$}) {
$self->dump_to_dir($1)
}
elsif($opt eq 'make_schema_at') {
no strict 'refs';
- my $cpkg = (caller)[0];
*{"${cpkg}::make_schema_at"} = \&make_schema_at;
}
+ elsif($opt eq 'naming') {
+ no strict 'refs';
+ *{"${cpkg}::naming"} = sub { $self->naming(@_) };
+ }
}
}
@@ -370,7 +380,25 @@
sub rescan { my $self = shift; $self->_loader->rescan($self) }
+=head2 naming
+=over 4
+
+=item Arguments: \%opts | $ver
+
+=back
+
+Controls the naming options for backward compatibility, see
+L<DBIx::Class::Schema::Loader::Base/naming> for details.
+
+To upgrade a dynamic schema, use:
+
+ __PACKAGE__->naming('current');
+
+Can be imported into your dump script and called as a function as well:
+
+ naming('v4');
+
=head1 KNOWN ISSUES
=head2 Multiple Database Schemas
@@ -423,8 +451,12 @@
... and lots of other folks. If we forgot you, please write the current
maintainer or RT.
-=head1 LICENSE
+=head1 COPYRIGHT & LICENSE
+Copyright (c) 2006 - 2009 by the aforementioned
+L<DBIx::Class::Schema::Loader/AUTHOR> and
+L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/10sqlite_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/10sqlite_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/10sqlite_common.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,25 @@
+use strict;
+use lib qw(t/backcompat/0.04006/lib);
+use dbixcsl_common_tests;
+use Test::More;
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+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/current/t/backcompat/0.04006/11mysql_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/11mysql_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/11mysql_common.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,33 @@
+use strict;
+use lib qw(t/backcompat/0.04006/lib);
+use dbixcsl_common_tests;
+use Test::More;
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+
+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/current/t/backcompat/0.04006/12pg_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/12pg_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/12pg_common.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,26 @@
+use strict;
+use lib qw(t/backcompat/0.04006/lib);
+use dbixcsl_common_tests;
+use Test::More;
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+
+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/current/t/backcompat/0.04006/13db2_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/13db2_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/13db2_common.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,27 @@
+use strict;
+use lib qw(t/backcompat/0.04006/lib);
+use dbixcsl_common_tests;
+use Test::More;
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+
+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/current/t/backcompat/0.04006/14ora_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/14ora_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/14ora_common.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,44 @@
+use strict;
+use lib qw(t/backcompat/0.04006/lib);
+use dbixcsl_common_tests;
+use Test::More;
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+
+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/current/t/backcompat/0.04006/20invocations.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/20invocations.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/20invocations.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,105 @@
+use strict;
+use Test::More;
+use lib qw(t/backcompat/0.04006/lib);
+use make_dbictest_db;
+
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+# 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/current/t/backcompat/0.04006/21misc_fatal.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/21misc_fatal.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/21misc_fatal.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,29 @@
+use strict;
+use Test::More;
+use lib qw(t/backcompat/0.04006/lib);
+use make_dbictest_db;
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+
+{
+ $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/current/t/backcompat/0.04006/22dump.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/22dump.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/22dump.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,67 @@
+use strict;
+use Test::More;
+use lib qw(t/backcompat/0.04006/lib);
+use File::Path;
+use make_dbictest_db;
+
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+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/current/t/backcompat/0.04006/23dumpmore.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/23dumpmore.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/23dumpmore.t 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,273 @@
+use strict;
+use Test::More;
+use lib qw(t/backcompat/0.04006/lib);
+use File::Path;
+use make_dbictest_db;
+require DBIx::Class::Schema::Loader;
+
+plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
+ unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
+
+$^O eq 'MSWin32' && plan skip_all =>
+"Win32 perl produces additional warnings, and this test uses unix paths";
+
+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$/,
+ ],
+ },
+);
+
+done_testing;
+
+END { rmtree($DUMP_PATH, 1, 1); }
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -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/current/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,5 @@
+package DBIx::Class::TestComponent;
+
+sub dbix_class_testcomponent { 'dbix_class_testcomponent works' }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -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/current/t/backcompat/0.04006/lib/My/ResultBaseClass.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/ResultBaseClass.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/ResultBaseClass.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,5 @@
+package My::ResultBaseClass;
+
+use base 'DBIx::Class::Core';
+
+1;
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/SchemaBaseClass.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/SchemaBaseClass.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/My/SchemaBaseClass.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,5 @@
+package My::SchemaBaseClass;
+
+use base 'DBIx::Class::Schema';
+
+1;
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditional.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditional.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditional.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,5 @@
+package TestAdditional;
+
+sub test_additional { return "test_additional"; }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditionalBase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditionalBase.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestAdditionalBase.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -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/current/t/backcompat/0.04006/lib/TestLeftBase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestLeftBase.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/TestLeftBase.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,5 @@
+package TestLeftBase;
+
+sub test_additional_base_override { return "test_left_base_override"; }
+
+1;
Added: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -0,0 +1,973 @@
+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;
+ }
+
+# for debugging...
+# {
+# mkdir '/tmp/HLAGH';
+# $conn->_loader->{dump_directory} = '/tmp/HLAGH';
+# $conn->_loader->_dump_to_dir(values %$classes);
+# }
+
+ 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/current/t/backcompat/0.04006/lib/make_dbictest_db.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/make_dbictest_db.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/make_dbictest_db.pm 2009-12-24 15:16:43 UTC (rev 8173)
@@ -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