[Bast-commits] r3480 - in trunk/DBIx-Class-Schema-Loader: .
lib/DBIx/Class/Schema lib/DBIx/Class/Schema/Loader
lib/DBIx/Class/Schema/Loader/DBI t t/lib
blblack at dev.catalyst.perl.org
blblack at dev.catalyst.perl.org
Fri Jun 8 02:08:18 GMT 2007
Author: blblack
Date: 2007-06-08 02:08:18 +0100 (Fri, 08 Jun 2007)
New Revision: 3480
Added:
trunk/DBIx-Class-Schema-Loader/MANIFEST
trunk/DBIx-Class-Schema-Loader/README
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
trunk/DBIx-Class-Schema-Loader/t/14ora_common.t
trunk/DBIx-Class-Schema-Loader/t/23dumpmore.t
Modified:
trunk/DBIx-Class-Schema-Loader/
trunk/DBIx-Class-Schema-Loader/Build.PL
trunk/DBIx-Class-Schema-Loader/Changes
trunk/DBIx-Class-Schema-Loader/MANIFEST.SKIP
trunk/DBIx-Class-Schema-Loader/Makefile.PL
trunk/DBIx-Class-Schema-Loader/TODO
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/Base.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
trunk/DBIx-Class-Schema-Loader/t/
trunk/DBIx-Class-Schema-Loader/t/01use.t
trunk/DBIx-Class-Schema-Loader/t/20invocations.t
trunk/DBIx-Class-Schema-Loader/t/21misc_fatal.t
trunk/DBIx-Class-Schema-Loader/t/22dump.t
trunk/DBIx-Class-Schema-Loader/t/lib/dbixcsl_common_tests.pm
Log:
r20309 at brandon-blacks-computer (orig r2763): blblack | 2006-09-12 11:24:26 -0500
creating -current branch for Schema::Loader
r20310 at brandon-blacks-computer (orig r2764): blblack | 2006-09-12 11:30:34 -0500
bump version to 0.03999_01, added $VERSION to all packages
r20311 at brandon-blacks-computer (orig r2765): blblack | 2006-09-12 11:34:25 -0500
fix issue w/ M::B and Class::Accessor
r20314 at brandon-blacks-computer (orig r2768): blblack | 2006-09-12 14:28:42 -0500
kill deprecated options/methods, make relationship loading the default
r20318 at brandon-blacks-computer (orig r2772): blblack | 2006-09-12 15:56:37 -0500
columns_info_for imported from DBIx::Class
Changes updated
r20370 at brandon-blacks-computer (orig r2824): blblack | 2006-10-12 11:07:43 -0500
removed legacy_default_inflections. Apparently it has never worked right anyways and nobody ever complained, so deprecating it earlier than expected
r20430 at brandon-blacks-computer (orig r2884): blblack | 2006-11-15 08:17:26 -0600
no need for suppression in current
r20442 at brandon-blacks-computer (orig r2896): blblack | 2006-11-15 12:12:52 -0600
TODO updated
r27323 at brandon-blacks-computer (orig r3152): blblack | 2007-03-29 09:11:00 -0500
import latest changes to DBIC::Storage::DBI to-be-deprecated columns_info_for to our variant
r27325 at brandon-blacks-computer (orig r3154): blblack | 2007-03-29 17:20:10 -0500
statistics_info support
r27326 at brandon-blacks-computer (orig r3155): blblack | 2007-03-29 19:53:01 -0500
preserve local changes to generated files by default (still needs tests)
r27327 at brandon-blacks-computer (orig r3156): blblack | 2007-03-29 20:11:31 -0500
oops, did not want to commit that comment-out
r27328 at brandon-blacks-computer (orig r3157): blblack | 2007-03-30 00:25:14 -0500
dtrt when previous dumpfile was not generated by us
r27329 at brandon-blacks-computer (orig r3158): blblack | 2007-03-30 01:09:38 -0500
refactor load_external, mainly to prevent requiring files out of the dump directory
r27330 at brandon-blacks-computer (orig r3159): blblack | 2007-03-30 10:42:17 -0500
refactoring top-level loading code with an eye towards the ability to add new tables at runtime
r27331 at brandon-blacks-computer (orig r3160): blblack | 2007-03-30 16:44:30 -0500
refactor relationship building code for runtime table adds as well
r27332 at brandon-blacks-computer (orig r3161): blblack | 2007-03-30 17:17:33 -0500
added rescan method to pick up newly created tables at runtime
r27334 at brandon-blacks-computer (orig r3163): blblack | 2007-03-30 17:25:41 -0500
changes update from last commit
r27337 at brandon-blacks-computer (orig r3166): blblack | 2007-03-30 17:37:04 -0500
Merging oracle branch into current:
r27336 (orig r3165): blblack | 2007-03-30 17:29:24 -0500
tweak up the oracle support, needs some testing
r20321 (orig r2775): blblack | 2006-09-12 16:21:11 -0500
added Oracle code from TSUNODA Kazuya
r20319 (orig r2773): blblack | 2006-09-12 15:58:20 -0500
creating new oracle branch
r27338 at brandon-blacks-computer (orig r3167): blblack | 2007-03-30 17:42:17 -0500
wrong test count
r27340 at brandon-blacks-computer (orig r3169): blblack | 2007-03-30 17:46:18 -0500
only _load_external for the classes we are supposed to
r27341 at brandon-blacks-computer (orig r3170): blblack | 2007-03-30 18:38:00 -0500
update requirements
r27342 at brandon-blacks-computer (orig r3171): blblack | 2007-03-30 20:07:15 -0500
added test for rescan, fixed a few issues
r27343 at brandon-blacks-computer (orig r3172): blblack | 2007-03-31 01:54:51 -0500
sqlite fixups
r29667 at brandon-blacks-computer (orig r3174): blblack | 2007-04-02 20:12:24 -0500
some little cleanups, svn meta stuff, and the beginnings a new test file for the new dump code
r30518 at brandon-blacks-computer (orig r3192): blblack | 2007-04-14 15:12:50 -0500
more dumping tests
r30519 at brandon-blacks-computer (orig r3193): blblack | 2007-04-14 15:40:51 -0500
3999_01 release
r31935 at brandon-blacks-computer (orig r3345): blblack | 2007-05-21 13:45:30 -0500
resolved test conflict from trunk, renamed current branch loader_test25 to loader_test30
r31954 at brandon-blacks-computer (orig r3362): blblack | 2007-05-22 09:06:29 -0500
convert to M::I, release 0.03999_02
Property changes on: trunk/DBIx-Class-Schema-Loader
___________________________________________________________________
Name: svn:ignore
+ Build
_build
*.bak
blib
*gz
inc
pm_to_blib
Makefile
Name: svk:merge
+ bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/current:3362
Modified: trunk/DBIx-Class-Schema-Loader/Build.PL
===================================================================
--- trunk/DBIx-Class-Schema-Loader/Build.PL 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/Build.PL 2007-06-08 01:08:18 UTC (rev 3480)
@@ -1,39 +1,3 @@
-use strict;
-use Module::Build;
-
-my %arguments = (
- license => 'perl',
- module_name => 'DBIx::Class::Schema::Loader',
- requires => {
- 'File::Spec' => 0,
- 'Scalar::Util' => 0,
- 'Data::Dump' => 1.06,
- 'UNIVERSAL::require' => 0.10,
- 'Lingua::EN::Inflect' => 1.89,
- 'Lingua::EN::Inflect::Number' => 1.1,
- 'Text::Balanced' => 0,
- 'Class::Accessor' => 0.22,
- 'Class::Data::Accessor' => 0.02,
- 'Class::C3' => 0.11,
- 'Carp::Clan' => 0,
- 'DBIx::Class' => 0.06003,
- },
- recommends => {
- 'Class::Inspector' => 0,
- 'DBI' => 1.50,
- 'DBD::SQLite' => 1.12,
- 'DBD::mysql' => 3.0003,
- 'DBD::Pg' => 1.49,
- 'DBD::DB2' => 0.78,
- },
- build_requires => {
- 'Test::More' => 0.32,
- 'DBI' => 1.50,
- 'DBD::SQLite' => 1.12,
- 'File::Path' => 0,
- },
- create_makefile_pl => 'passthrough',
- create_readme => 1,
-);
-
-Module::Build->new(%arguments)->create_build_script;
+# Dear Distribution Packager. This use of require is intentional.
+# Module::Install detects Build.PL usage and acts accordingly.
+require 'Makefile.PL';
Modified: trunk/DBIx-Class-Schema-Loader/Changes
===================================================================
--- trunk/DBIx-Class-Schema-Loader/Changes 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/Changes 2007-06-08 01:08:18 UTC (rev 3480)
@@ -1,11 +1,30 @@
Revision history for Perl extension DBIx::Class::Schema::Loader
+0.03999_02 Tue May 22, 2007
+ - Converted to Module::Install
+
0.03012 Tue May 22, 2007
- Relationship names for multiple multi-col rels between
the same table fixed by ilmari
- Fix from Marc Espie for CREATE TABLE 'foo' for SQLite
- skip ^sqlite_ tables in SQLite (thanks chromatic)
+0.03999_01 Sat Apr 14 19:57:40 GMT 2007
+ - Added *experimental* Oracle support from work done
+ by Tsunoda Kazuya some months ago. Not well tested.
+ - Added "rescan" schema (and loader) method, which picks
+ up newly created tables at runtime
+ - Made dump_to_dir / dump_overwrite much more intelligent
+ (they now preserve customizations by default)
+ - Added support for DBI's new standard "statistics_info"
+ method to gather unique key info (only supported by
+ DBD::Pg trunk afaik)
+ - columns_info_for imported from DBIx::Class
+ - relationships are now on by default, use skip_relationships
+ to disable them
+ - Removed previously deprecated methods/options
+ - Added $VERSION to all packages in this dist
+
0.03011 Sat Apr 14 19:03:07 UTC 2007
- fix case-sensitivity in UNIQUE parsing for SQLite
Added: trunk/DBIx-Class-Schema-Loader/MANIFEST
===================================================================
--- trunk/DBIx-Class-Schema-Loader/MANIFEST (rev 0)
+++ trunk/DBIx-Class-Schema-Loader/MANIFEST 2007-06-08 01:08:18 UTC (rev 3480)
@@ -0,0 +1,48 @@
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Build.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/DBIx/Class/Schema/Loader.pm
+lib/DBIx/Class/Schema/Loader/Base.pm
+lib/DBIx/Class/Schema/Loader/DBI.pm
+lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
+lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
+lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
+lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
+lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
+lib/DBIx/Class/Schema/Loader/DBI/Writing.pm
+lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/01use.t
+t/02pod.t
+t/03podcoverage.t
+t/04kwalitee.t
+t/10sqlite_common.t
+t/11mysql_common.t
+t/12pg_common.t
+t/13db2_common.t
+t/14ora_common.t
+t/20invocations.t
+t/21misc_fatal.t
+t/22dump.t
+t/23dumpmore.t
+t/lib/DBIx/Class/TestComponent.pm
+t/lib/DBIx/Class/TestRSComponent.pm
+t/lib/dbixcsl_common_tests.pm
+t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
+t/lib/make_dbictest_db.pm
+t/lib/TestAdditional.pm
+t/lib/TestAdditionalBase.pm
+t/lib/TestLeftBase.pm
Modified: trunk/DBIx-Class-Schema-Loader/MANIFEST.SKIP
===================================================================
--- trunk/DBIx-Class-Schema-Loader/MANIFEST.SKIP 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/MANIFEST.SKIP 2007-06-08 01:08:18 UTC (rev 3480)
@@ -50,3 +50,6 @@
# Don't try to add dist dirs to MANIFEST
^DBIx-Class-Schema-Loader
+
+# Build.PL for maint only
+Build.PL
Modified: trunk/DBIx-Class-Schema-Loader/Makefile.PL
===================================================================
--- trunk/DBIx-Class-Schema-Loader/Makefile.PL 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/Makefile.PL 2007-06-08 01:08:18 UTC (rev 3480)
@@ -1,31 +1,58 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
-
- unless (eval "use Module::Build::Compat 0.02; 1" ) {
- print "This module requires Module::Build to install itself.\n";
-
- require ExtUtils::MakeMaker;
- my $yn = ExtUtils::MakeMaker::prompt
- (' Install Module::Build now from CPAN?', 'y');
-
- unless ($yn =~ /^y/i) {
- die " *** Cannot install without Module::Build. Exiting ...\n";
- }
-
- require Cwd;
- require File::Spec;
- require CPAN;
-
- # Save this 'cause CPAN will chdir all over the place.
- my $cwd = Cwd::cwd();
-
- CPAN::Shell->install('Module::Build::Compat');
- CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
- or die "Couldn't install Module::Build, giving up.\n";
-
- chdir $cwd or die "Cannot chdir() back to $cwd: $!";
- }
- eval "use Module::Build::Compat 0.02; 1" or die $@;
-
- Module::Build::Compat->run_build_pl(args => \@ARGV);
- require Module::Build;
- Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+
+use inc::Module::Install;
+
+name 'DBIx-Class-Schema-Loader';
+all_from 'lib/DBIx/Class/Schema/Loader.pm';
+
+test_requires 'Test::More' => '0.47';
+test_requires 'DBI' => '1.56';
+test_requires 'DBD::SQLite' => '1.12';
+test_requires 'File::Path' => 0;
+
+requires 'File::Spec' => 0;
+requires 'Scalar::Util' => 0;
+requires 'Data::Dump' => '1.06';
+requires 'UNIVERSAL::require' => '0.11';
+requires 'Lingua::EN::Inflect::Number' => '1.1';
+requires 'Text::Balanced' => 0;
+requires 'Digest::MD5' => '2.36';
+requires 'Class::Accessor::Fast' => '0.30';
+requires 'Class::Data::Accessor' => '0.03';
+requires 'Class::C3' => '0.18';
+requires 'Carp::Clan' => 0;
+requires 'Class::Inspector' => 0;
+requires 'DBIx::Class' => '0.07006';
+
+feature 'SQLite Support' =>
+ -default => $ENV{DBIC_FEATURE_SQLITE} || 0,
+ 'DBI' => '1.56',
+ 'DBD::SQLite' => '1.12';
+
+feature 'MySQL Support' =>
+ -default => $ENV{DBIC_FEATURE_MYSQL} || 0,
+ 'DBI' => '1.56',
+ 'DBD::mysql' => '4.004';
+
+feature 'PostgreSQL Support' =>
+ -default => $ENV{DBIC_FEATURE_PG} || 0,
+ 'DBI' => '1.56',
+ 'DBD::Pg' => '1.49'; # Soon to be 1.50
+
+feature 'DB2 Support' =>
+ -default => $ENV{DBIC_FEATURE_DB2} || 0,
+ 'DBI' => '1.56',
+ 'DBD::DB2' => '1.0';
+
+feature 'Oracle Support (*experimental*)' =>
+ -default => $ENV{DBIC_FEATURE_ORACLE} || 0,
+ 'DBI' => '1.56',
+ 'DBD::Oracle' => '0.19';
+
+# Rebuild README for maintainers
+if(-e 'MANIFEST.SKIP') {
+ system("pod2text lib/DBIx/Class/Schema/Loader.pm > README");
+}
+
+auto_provides;
+auto_install;
+WriteAll;
Added: trunk/DBIx-Class-Schema-Loader/README
===================================================================
--- trunk/DBIx-Class-Schema-Loader/README (rev 0)
+++ trunk/DBIx-Class-Schema-Loader/README 2007-06-08 01:08:18 UTC (rev 3480)
@@ -0,0 +1,215 @@
+NAME
+ DBIx::Class::Schema::Loader - Dynamic definition of a
+ DBIx::Class::Schema
+
+SYNOPSIS
+ package My::Schema;
+ use base qw/DBIx::Class::Schema::Loader/;
+
+ __PACKAGE__->loader_options(
+ constraint => '^foo.*',
+ # debug => 1,
+ );
+
+ # in seperate application code ...
+
+ use My::Schema;
+
+ my $schema1 = My::Schema->connect( $dsn, $user, $password, $attrs);
+ # -or-
+ my $schema1 = "My::Schema"; $schema1->connection(as above);
+
+DESCRIPTION
+ DBIx::Class::Schema::Loader automates the definition of a
+ DBIx::Class::Schema by scanning database table definitions and setting
+ up the columns, primary keys, and relationships.
+
+ DBIx::Class::Schema::Loader currently supports only the DBI storage
+ type. It has explicit support for DBD::Pg, DBD::mysql, DBD::DB2,
+ DBD::SQLite, and DBD::Oracle. Other DBI drivers may function to a
+ greater or lesser degree with this loader, depending on how much of the
+ DBI spec they implement, and how standard their implementation is.
+
+ Patches to make other DBDs work correctly welcome.
+
+ See DBIx::Class::Schema::Loader::DBI::Writing for notes on writing your
+ own vendor-specific subclass for an unsupported DBD driver.
+
+ This module requires DBIx::Class 0.07006 or later, and obsoletes the
+ older DBIx::Class::Loader.
+
+ This module is designed more to get you up and running quickly against
+ an existing database, or to be effective for simple situations, rather
+ than to be what you use in the long term for a complex database/project.
+
+ That being said, transitioning your code from a Schema generated by this
+ module to one that doesn't use this module should be straightforward and
+ painless, so don't shy away from it just for fears of the transition
+ down the road.
+
+METHODS
+ loader_options
+ Example in Synopsis above demonstrates a few common arguments. For
+ detailed information on all of the arguments, most of which are only
+ useful in fairly complex scenarios, see the
+ DBIx::Class::Schema::Loader::Base documentation.
+
+ If you intend to use "loader_options", you must call "loader_options"
+ before any connection is made, or embed the "loader_options" in the
+ connection information itself as shown below. Setting "loader_options"
+ after the connection has already been made is useless.
+
+ connection
+ See DBIx::Class::Schema for basic usage.
+
+ If the final argument is a hashref, and it contains a key
+ "loader_options", that key will be deleted, and its value will be used
+ for the loader options, just as if set via the "loader_options" method
+ above.
+
+ The actual auto-loading operation (the heart of this module) will be
+ invoked as soon as the connection information is defined.
+
+ clone
+ See DBIx::Class::Schema.
+
+ dump_to_dir
+ Argument: directory name.
+
+ Calling this as a class method on either DBIx::Class::Schema::Loader or
+ any derived schema class will cause all affected schemas to dump manual
+ versions of themselves to the named directory when they are loaded. In
+ order to be effective, this must be set before defining a connection on
+ this schema class or any derived object (as the loading happens as soon
+ as both a connection and loader_options are set, and only once per
+ class).
+
+ See "dump_directory" in DBIx::Class::Schema::Loader::Base for more
+ details on the dumping mechanism.
+
+ This can also be set at module import time via the import option
+ "dump_to_dir:/foo/bar" to DBIx::Class::Schema::Loader, where "/foo/bar"
+ is the target directory.
+
+ Examples:
+
+ # My::Schema isa DBIx::Class::Schema::Loader, and has connection info
+ # hardcoded in the class itself:
+ perl -MDBIx::Class::Schema::Loader=dump_to_dir:/foo/bar -MMy::Schema -e1
+
+ # Same, but no hard-coded connection, so we must provide one:
+ perl -MDBIx::Class::Schema::Loader=dump_to_dir:/foo/bar -MMy::Schema -e 'My::Schema->connection("dbi:Pg:dbname=foo", ...)'
+
+ # Or as a class method, as long as you get it done *before* defining a
+ # connection on this schema class or any derived object:
+ use My::Schema;
+ My::Schema->dump_to_dir('/foo/bar');
+ My::Schema->connection(........);
+
+ # Or as a class method on the DBIx::Class::Schema::Loader itself, which affects all
+ # derived schemas
+ use My::Schema;
+ use My::OtherSchema;
+ DBIx::Class::Schema::Loader->dump_to_dir('/foo/bar');
+ My::Schema->connection(.......);
+ My::OtherSchema->connection(.......);
+
+ # Another alternative to the above:
+ use DBIx::Class::Schema::Loader qw| dump_to_dir:/foo/bar |;
+ use My::Schema;
+ use My::OtherSchema;
+ My::Schema->connection(.......);
+ My::OtherSchema->connection(.......);
+
+ make_schema_at
+ This simple function allows one to create a Loader-based schema
+ in-memory on the fly without any on-disk class files of any kind. When
+ used with the "dump_directory" option, you can use this to generate a
+ rough draft manual schema from a dsn without the intermediate step of
+ creating a physical Loader-based schema class.
+
+ The return value is the input class name.
+
+ This function can be exported/imported by the normal means, as
+ illustrated in these Examples:
+
+ # Simple example, creates as a new class 'New::Schema::Name' in
+ # memory in the running perl interpreter.
+ use DBIx::Class::Schema::Loader qw/ make_schema_at /;
+ make_schema_at(
+ 'New::Schema::Name',
+ { debug => 1 },
+ [ 'dbi:Pg:dbname="foo"','postgres' ],
+ );
+
+ # Complex: dump loaded schema to disk, all from the commandline:
+ perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib -e 'make_schema_at("New::Schema::Name", { debug => 1 }, [ "dbi:Pg:dbname=foo","postgres" ])'
+
+ # Same, but inside a script, and using a different way to specify the
+ # dump directory:
+ use DBIx::Class::Schema::Loader qw/ make_schema_at /;
+ make_schema_at(
+ 'New::Schema::Name',
+ { debug => 1, dump_directory => './lib' },
+ [ 'dbi:Pg:dbname="foo"','postgres' ],
+ );
+
+ rescan
+ Re-scans the database for newly added tables since the initial load, and
+ adds them to the schema at runtime, including relationships, etc. Does
+ not process drops or changes.
+
+ Returns a list of the new monikers added.
+
+EXAMPLE
+ Using the example in DBIx::Class::Manual::ExampleSchema as a basis
+ replace the DB::Main with the following code:
+
+ package DB::Main;
+
+ use base qw/DBIx::Class::Schema::Loader/;
+
+ __PACKAGE__->loader_options(
+ debug => 1,
+ );
+ __PACKAGE__->connection('dbi:SQLite:example.db');
+
+ 1;
+
+ and remove the Main directory tree (optional). Every thing else should
+ work the same
+
+KNOWN ISSUES
+ Multiple Database Schemas
+ Currently the loader is limited to working within a single schema (using
+ the database vendors' definition of "schema"). If you have a
+ multi-schema database with inter-schema relationships (which is easy to
+ do in PostgreSQL or DB2 for instance), you only get to automatically
+ load the tables of one schema, and any relationships to tables in other
+ schemas will be silently ignored.
+
+ At some point in the future, an intelligent way around this might be
+ devised, probably by allowing the "db_schema" option to be an arrayref
+ of schemas to load.
+
+ In "normal" DBIx::Class::Schema usage, manually-defined source classes
+ and relationships have no problems crossing vendor schemas.
+
+AUTHOR
+ Brandon Black, "blblack at gmail.com"
+
+ Based on DBIx::Class::Loader by Sebastian Riedel
+
+ Based upon the work of IKEBE Tomohiro
+
+THANK YOU
+ Matt S Trout, all of the #dbix-class folks, and everyone who's ever sent
+ in a bug report or suggestion.
+
+LICENSE
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+SEE ALSO
+ DBIx::Class, DBIx::Class::Manual::ExampleSchema
+
Modified: trunk/DBIx-Class-Schema-Loader/TODO
===================================================================
--- trunk/DBIx-Class-Schema-Loader/TODO 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/TODO 2007-06-08 01:08:18 UTC (rev 3480)
@@ -3,8 +3,6 @@
support pk/uk/fk info on views, possibly. May or may not be a sane thing to try to do.
-dump_to_dir needs an overwrite flag, and needs to not overwrite by default
-
Fix up ResultSet Manager / Methods / etc stuff. May require some work in the
main DBIx::Class first.
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/Base.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/Base.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -10,8 +10,12 @@
use Data::Dump qw/ dump /;
use POSIX qw//;
use File::Spec qw//;
+use Cwd qw//;
+use Digest::MD5 qw//;
require DBIx::Class;
+our $VERSION = '0.03999_02';
+
__PACKAGE__->mk_ro_accessors(qw/
schema
schema_class
@@ -23,7 +27,7 @@
left_base_classes
components
resultset_components
- relationships
+ skip_relationships
moniker_map
inflect_singular
inflect_plural
@@ -31,8 +35,6 @@
dump_directory
dump_overwrite
- legacy_default_inflections
-
db_schema
_tables
classes
@@ -57,9 +59,10 @@
These constructor options are the base options for
L<DBIx::Class::Schema::Loader/loader_opts>. Available constructor options are:
-=head2 relationships
+=head2 skip_relationships
-Try to automatically detect/setup has_a and has_many relationships.
+Skip setting up relationships. The default is to attempt the loading
+of relationships.
=head2 debug
@@ -137,19 +140,6 @@
C<ResultSetManager> will be automatically added to the above
C<components> list if this option is set.
-=head2 legacy_default_inflections
-
-Setting this option changes the default fallback for L</inflect_plural> to
-utilize L<Lingua::EN::Inflect/PL>, and L</inflect_singular> to a no-op.
-Those choices produce substandard results, but might be necessary to support
-your existing code if you started developing on a version prior to 0.03 and
-don't wish to go around updating all your relationship names to the new
-defaults.
-
-This option will continue to be supported until at least version 0.05xxx,
-but may dissappear sometime thereafter. It is recommended that you update
-your code to use the newer-style inflections when you have the time.
-
=head2 dump_directory
This option is designed to be a tool to help you transition from this
@@ -162,11 +152,7 @@
The created schema class will have the same classname as the one on
which you are setting this option (and the ResultSource classes will be
-based on this name as well). Therefore it is wise to note that if you
-point the C<dump_directory> option of a schema class at the live libdir
-where that class is currently located, it will overwrite itself with a
-manual version of itself. This might be a really good or bad thing
-depending on your situation and perspective.
+based on this name as well).
Normally you wouldn't hard-code this setting in your schema class, as it
is meant for one-time manual usage.
@@ -176,29 +162,19 @@
=head2 dump_overwrite
-If set to a true value, the dumping code will overwrite existing files.
-The default is false, which means the dumping code will skip the already
-existing files.
+Default false. If true, Loader will unconditionally delete any existing
+files before creating the new ones from scratch when dumping a schema to disk.
-=head1 DEPRECATED CONSTRUCTOR OPTIONS
+The default behavior is instead to only replace the top portion of the
+file, up to and including the final stanza which contains
+C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
+leaving any customizations you placed after that as they were.
-B<These will be removed in version 0.04000 !!!>
+When C<dump_overwrite> is not set, if the output file already exists,
+but the aforementioned final stanza is not found, or the checksum
+contained there does not match the generated contents, Loader will
+croak and not touch the file.
-=head2 inflect_map
-
-Equivalent to L</inflect_plural>.
-
-=head2 inflect
-
-Equivalent to L</inflect_plural>.
-
-=head2 connect_info, dsn, user, password, options
-
-You connect these schemas the same way you would any L<DBIx::Class::Schema>,
-which is by calling either C<connect> or C<connection> on a schema class
-or object. These options are only supported via the deprecated
-C<load_from_connection> interface, which is also being removed in 0.04000.
-
=head1 METHODS
None of these methods are intended for direct invocation by regular
@@ -233,7 +209,6 @@
bless $self => $class;
- $self->{db_schema} ||= '';
$self->_ensure_arrayref(qw/additional_classes
additional_base_classes
left_base_classes
@@ -247,65 +222,80 @@
$self->{monikers} = {};
$self->{classes} = {};
- # Support deprecated arguments
- for(qw/inflect_map inflect/) {
- warn "Argument $_ is deprecated in favor of 'inflect_plural'"
- . ", and will be removed in 0.04000"
- if $self->{$_};
- }
- $self->{inflect_plural} ||= $self->{inflect_map} || $self->{inflect};
-
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
$self->{schema} ||= $self->{schema_class};
+ $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
+ $self->schema_class, $self->inflect_plural, $self->inflect_singular
+ ) if !$self->{skip_relationships};
+
$self;
}
+sub _find_file_in_inc {
+ my ($self, $file) = @_;
+
+ foreach my $prefix (@INC) {
+ my $fullpath = $prefix . '/' . $file;
+ return $fullpath if -f $fullpath;
+ }
+
+ return;
+}
+
sub _load_external {
- my $self = shift;
+ my ($self, $class) = @_;
- my $abs_dump_dir;
+ my $class_path = $class;
+ $class_path =~ s{::}{/}g;
+ $class_path .= '.pm';
- $abs_dump_dir = File::Spec->rel2abs($self->dump_directory)
- if $self->dump_directory;
+ my $inc_path = $self->_find_file_in_inc($class_path);
- foreach my $table_class (values %{$self->classes}) {
- $table_class->require;
- if($@ && $@ !~ /^Can't locate /) {
- croak "Failed to load external class definition"
- . " for '$table_class': $@";
- }
- next if $@; # "Can't locate" error
+ return if !$inc_path;
- # If we make it to here, we loaded an external definition
- warn qq/# Loaded external class definition for '$table_class'\n/
- if $self->debug;
+ my $real_dump_path = $self->dump_directory
+ ? Cwd::abs_path(
+ File::Spec->catfile($self->dump_directory, $class_path)
+ )
+ : '';
+ my $real_inc_path = Cwd::abs_path($inc_path);
+ return if $real_inc_path eq $real_dump_path;
- if($abs_dump_dir) {
- my $class_path = $table_class;
- $class_path =~ s{::}{/}g;
- $class_path .= '.pm';
- my $filename = File::Spec->rel2abs($INC{$class_path});
- croak 'Failed to locate actual external module file for '
- . "'$table_class'"
- if !$filename;
- next if($filename =~ /^$abs_dump_dir/);
- open(my $fh, '<', $filename)
- or croak "Failed to open $filename for reading: $!";
- $self->_raw_stmt($table_class,
- q|# These lines loaded from user-supplied external file: |
- );
- while(<$fh>) {
- chomp;
- $self->_raw_stmt($table_class, $_);
- }
- $self->_raw_stmt($table_class,
- q|# End of lines loaded from user-supplied external file |
- );
- close($fh)
- or croak "Failed to close $filename: $!";
- }
+ $class->require;
+ croak "Failed to load external class definition"
+ . " for '$class': $@"
+ if $@;
+
+ # If we make it to here, we loaded an external definition
+ warn qq/# Loaded external class definition for '$class'\n/
+ if $self->debug;
+
+ # The rest is only relevant when dumping
+ return if !$self->dump_directory;
+
+ 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,
+ qq|# These lines were loaded from '$real_inc_path' found in \@INC.|
+ .q|# They are now part of the custom portion of this file|
+ .q|# for you to hand-edit. If you do not either delete|
+ .q|# this section or remove that file from @INC, this section|
+ .q|# will be repeated redundantly when you re-create this|
+ .q|# file again via Loader!|
+ );
+ while(<$fh>) {
+ chomp;
+ $self->_ext_stmt($class, $_);
}
+ $self->_ext_stmt($class,
+ q|# End of lines loaded from '$real_inc_path' |
+ );
+ close($fh)
+ or croak "Failed to close $real_inc_path: $!";
}
=head2 load
@@ -317,9 +307,79 @@
sub load {
my $self = shift;
- $self->_load_classes;
- $self->_load_relationships if $self->relationships;
- $self->_load_external;
+ $self->_load_tables($self->_tables_list);
+}
+
+=head2 rescan
+
+Arguments: schema
+
+Rescan the database for newly added tables. Does
+not process drops or changes. Returns a list of
+the newly added table monikers.
+
+The schema argument should be the schema class
+or object to be affected. It should probably
+be derived from the original schema_class used
+during L</load>.
+
+=cut
+
+sub rescan {
+ my ($self, $schema) = @_;
+
+ $self->{schema} = $schema;
+
+ my @created;
+ my @current = $self->_tables_list;
+ foreach my $table ($self->_tables_list) {
+ if(!exists $self->{_tables}->{$table}) {
+ push(@created, $table);
+ }
+ }
+
+ $self->_load_tables(@created);
+
+ return map { $self->monikers->{$_} } @created;
+}
+
+sub _load_tables {
+ my ($self, @tables) = @_;
+
+ # First, use _tables_list with constraint and exclude
+ # to get a list of tables to operate on
+
+ my $constraint = $self->constraint;
+ my $exclude = $self->exclude;
+
+ @tables = grep { /$constraint/ } @tables if $constraint;
+ @tables = grep { ! /$exclude/ } @tables if $exclude;
+
+ # Save the new tables to the tables list
+ foreach (@tables) {
+ $self->{_tables}->{$_} = 1;
+ }
+
+ # Set up classes/monikers
+ {
+ no warnings 'redefine';
+ local *Class::C3::reinitialize = sub { };
+ use warnings;
+
+ $self->_make_src_class($_) for @tables;
+ }
+
+ Class::C3::reinitialize;
+
+ $self->_setup_src_meta($_) for @tables;
+
+ if(!$self->skip_relationships) {
+ $self->_load_relationships($_) for @tables;
+ }
+
+ $self->_load_external($_)
+ for map { $self->classes->{$_} } @tables;
+
$self->_dump_to_dir if $self->dump_directory;
# Drop temporary cache
@@ -343,11 +403,12 @@
# which is a filename
my $dir = $self->dump_directory;
- foreach (@name_parts) {
- $dir = File::Spec->catdir($dir,$_);
- if(! -d $dir) {
+ while (1) {
+ if(!-d $dir) {
mkdir($dir) or croak "mkdir('$dir') failed: $!";
}
+ last if !@name_parts;
+ $dir = File::Spec->catdir($dir, shift @name_parts);
}
}
@@ -362,52 +423,99 @@
warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
- if(! -d $target_dir) {
- mkdir($target_dir) or croak "mkdir('$target_dir') failed: $!";
- }
+ my $schema_text =
+ qq|package $schema_class;\n\n|
+ . qq|use strict;\nuse warnings;\n\n|
+ . qq|use base 'DBIx::Class::Schema';\n\n|
+ . qq|__PACKAGE__->load_classes;\n|;
- my $verstr = $DBIx::Class::Schema::Loader::VERSION;
- my $datestr = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime);
- my $tagline = qq|# Created by DBIx::Class::Schema::Loader v$verstr @ $datestr|;
+ $self->_write_classfile($schema_class, $schema_text);
- $self->_ensure_dump_subdirs($schema_class);
+ foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
+ my $src_text =
+ qq|package $src_class;\n\n|
+ . qq|use strict;\nuse warnings;\n\n|
+ . qq|use base 'DBIx::Class';\n\n|;
- my $schema_fn = $self->_get_dump_filename($schema_class);
- if (-f $schema_fn && !$self->dump_overwrite) {
- warn "$schema_fn exists, will not overwrite\n";
+ $self->_write_classfile($src_class, $src_text);
}
- else {
- open(my $schema_fh, '>', $schema_fn)
- or croak "Cannot open $schema_fn for writing: $!";
- print $schema_fh qq|package $schema_class;\n\n$tagline\n\n|;
- print $schema_fh qq|use strict;\nuse warnings;\n\n|;
- print $schema_fh qq|use base 'DBIx::Class::Schema';\n\n|;
- print $schema_fh qq|__PACKAGE__->load_classes;\n|;
- print $schema_fh qq|\n1;\n\n|;
- close($schema_fh)
- or croak "Cannot close $schema_fn: $!";
- }
- foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
- $self->_ensure_dump_subdirs($src_class);
- my $src_fn = $self->_get_dump_filename($src_class);
- if (-f $src_fn && !$self->dump_overwrite) {
- warn "$src_fn exists, will not overwrite\n";
- next;
- }
- open(my $src_fh, '>', $src_fn)
- or croak "Cannot open $src_fn for writing: $!";
- print $src_fh qq|package $src_class;\n\n$tagline\n\n|;
- print $src_fh qq|use strict;\nuse warnings;\n\n|;
- print $src_fh qq|use base 'DBIx::Class';\n\n|;
- print $src_fh qq|$_\n|
- for @{$self->{_dump_storage}->{$src_class}};
- print $src_fh qq|\n1;\n\n|;
- close($src_fh)
- or croak "Cannot close $src_fn: $!";
+ warn "Schema dump completed.\n";
+}
+
+sub _write_classfile {
+ my ($self, $class, $text) = @_;
+
+ my $filename = $self->_get_dump_filename($class);
+ $self->_ensure_dump_subdirs($class);
+
+ if (-f $filename && $self->dump_overwrite) {
+ warn "Deleting existing file '$filename' due to "
+ . "'dump_overwrite' setting\n";
+ unlink($filename);
+ }
+
+ my $custom_content = $self->_get_custom_content($class, $filename);
+
+ $custom_content ||= qq|\n# You can replace this text with custom|
+ . qq| content, and it will be preserved on regeneration|
+ . qq|\n1;\n|;
+
+ $text .= qq|$_\n|
+ for @{$self->{_dump_storage}->{$class} || []};
+
+ $text .= qq|\n\n# Created by DBIx::Class::Schema::Loader|
+ . qq| v| . $DBIx::Class::Schema::Loader::VERSION
+ . q| @ | . POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
+ . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
+
+ open(my $fh, '>', $filename)
+ or croak "Cannot open '$filename' for writing: $!";
+
+ # Write the top half and its MD5 sum
+ print $fh $text . Digest::MD5::md5_base64($text) . "\n\n";
+
+ # Write out anything loaded via external partial class file in @INC
+ print $fh qq|$_\n|
+ for @{$self->{_ext_storage}->{$class} || []};
+
+ print $fh $custom_content;
+
+ close($fh)
+ or croak "Cannot close '$filename': $!";
+}
+
+sub _get_custom_content {
+ my ($self, $class, $filename) = @_;
+
+ return if ! -f $filename;
+ open(my $fh, '<', $filename)
+ or croak "Cannot open '$filename' for reading: $!";
+
+ my $mark_re =
+ qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
+
+ my $found = 0;
+ my $buffer = '';
+ while(<$fh>) {
+ if(!$found && /$mark_re/) {
+ $found = 1;
+ $buffer .= $1;
+ croak "Checksum mismatch in '$filename'"
+ if Digest::MD5::md5_base64($buffer) ne $2;
+
+ $buffer = '';
+ }
+ else {
+ $buffer .= $_;
+ }
}
- warn "Schema dump completed.\n";
+ croak "Cannot not overwrite '$filename' without 'dump_overwrite',"
+ . " it does not appear to have been generated by Loader"
+ if !$found;
+
+ return $buffer;
}
sub _use {
@@ -439,87 +547,70 @@
}
}
-# Load and setup classes
-sub _load_classes {
- my $self = shift;
+# Create class with applicable bases, setup monikers, etc
+sub _make_src_class {
+ my ($self, $table) = @_;
my $schema = $self->schema;
my $schema_class = $self->schema_class;
- my $constraint = $self->constraint;
- my $exclude = $self->exclude;
- my @tables = sort $self->_tables_list;
- warn "No tables found in database, nothing to load" if !@tables;
+ my $table_moniker = $self->_table2moniker($table);
+ my $table_class = $schema_class . q{::} . $table_moniker;
- if(@tables) {
- @tables = grep { /$constraint/ } @tables if $constraint;
- @tables = grep { ! /$exclude/ } @tables if $exclude;
+ my $table_normalized = lc $table;
+ $self->classes->{$table} = $table_class;
+ $self->classes->{$table_normalized} = $table_class;
+ $self->monikers->{$table} = $table_moniker;
+ $self->monikers->{$table_normalized} = $table_moniker;
- warn "All tables excluded by constraint/exclude, nothing to load"
- if !@tables;
- }
+ { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
- $self->{_tables} = \@tables;
+ $self->_use ($table_class, @{$self->additional_classes});
+ $self->_inject($table_class, @{$self->additional_base_classes});
- foreach my $table (@tables) {
- my $table_moniker = $self->_table2moniker($table);
- my $table_class = $schema_class . q{::} . $table_moniker;
+ $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
- my $table_normalized = lc $table;
- $self->classes->{$table} = $table_class;
- $self->classes->{$table_normalized} = $table_class;
- $self->monikers->{$table} = $table_moniker;
- $self->monikers->{$table_normalized} = $table_moniker;
+ $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
+ if @{$self->resultset_components};
+ $self->_inject($table_class, @{$self->left_base_classes});
+}
- no warnings 'redefine';
- local *Class::C3::reinitialize = sub { };
- use warnings;
+# Set up metadata (cols, pks, etc) and register the class with the schema
+sub _setup_src_meta {
+ my ($self, $table) = @_;
- { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
+ my $schema = $self->schema;
+ my $schema_class = $self->schema_class;
- $self->_use ($table_class, @{$self->additional_classes});
- $self->_inject($table_class, @{$self->additional_base_classes});
+ my $table_class = $self->classes->{$table};
+ my $table_moniker = $self->monikers->{$table};
- $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, qw/PK::Auto Core/);
+ $self->_dbic_stmt($table_class,'table',$table);
- $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
- if @{$self->resultset_components};
- $self->_inject($table_class, @{$self->left_base_classes});
+ my $cols = $self->_table_columns($table);
+ my $col_info;
+ eval { $col_info = $self->_columns_info_for($table) };
+ if($@) {
+ $self->_dbic_stmt($table_class,'add_columns',@$cols);
}
+ else {
+ my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
+ $self->_dbic_stmt(
+ $table_class,
+ 'add_columns',
+ map { $_, ($col_info_lc{$_}||{}) } @$cols
+ );
+ }
- Class::C3::reinitialize;
+ my $pks = $self->_table_pk_info($table) || [];
+ @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
+ : carp("$table has no primary key");
- foreach my $table (@tables) {
- my $table_class = $self->classes->{$table};
- my $table_moniker = $self->monikers->{$table};
+ my $uniqs = $self->_table_uniq_info($table) || [];
+ $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
- $self->_dbic_stmt($table_class,'table',$table);
-
- my $cols = $self->_table_columns($table);
- my $col_info;
- eval { $col_info = $schema->storage->columns_info_for($table) };
- if($@) {
- $self->_dbic_stmt($table_class,'add_columns',@$cols);
- }
- else {
- my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
- $self->_dbic_stmt(
- $table_class,
- 'add_columns',
- map { $_, ($col_info_lc{$_}||{}) } @$cols
- );
- }
-
- my $pks = $self->_table_pk_info($table) || [];
- @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
- : carp("$table has no primary key");
-
- my $uniqs = $self->_table_uniq_info($table) || [];
- $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
-
- $schema_class->register_class($table_moniker, $table_class);
- $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
- }
+ $schema_class->register_class($table_moniker, $table_class);
+ $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
}
=head2 tables
@@ -532,7 +623,7 @@
sub tables {
my $self = shift;
- return @{$self->_tables};
+ return keys %{$self->_tables};
}
# Make a moniker from a table
@@ -554,27 +645,17 @@
}
sub _load_relationships {
- my $self = shift;
+ my ($self, $table) = @_;
- # Construct the fk_info RelBuilder wants to see, by
- # translating table names to monikers in the _fk_info output
- my %fk_info;
- foreach my $table ($self->tables) {
- my $tbl_fk_info = $self->_table_fk_info($table);
- foreach my $fkdef (@$tbl_fk_info) {
- $fkdef->{remote_source} =
- $self->monikers->{delete $fkdef->{remote_table}};
- }
- my $moniker = $self->monikers->{$table};
- $fk_info{$moniker} = $tbl_fk_info;
+ my $tbl_fk_info = $self->_table_fk_info($table);
+ foreach my $fkdef (@$tbl_fk_info) {
+ $fkdef->{remote_source} =
+ $self->monikers->{delete $fkdef->{remote_table}};
}
- my $relbuilder = DBIx::Class::Schema::Loader::RelBuilder->new(
- $self->schema_class, \%fk_info, $self->inflect_plural,
- $self->inflect_singular
- );
+ my $local_moniker = $self->monikers->{$table};
+ my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info);
- my $rel_stmts = $relbuilder->generate_code;
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
foreach my $stmt (@$src_stmts) {
@@ -628,6 +709,12 @@
push(@{$self->{_dump_storage}->{$class}}, $stmt) if $self->dump_directory;
}
+# Like above, but separately for the externally loaded stuff
+sub _ext_stmt {
+ my ($self, $class, $stmt) = @_;
+ push(@{$self->{_ext_storage}->{$class}}, $stmt) if $self->dump_directory;
+}
+
=head2 monikers
Returns a hashref of loaded table to moniker mappings. There will
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -6,6 +6,8 @@
use Carp::Clan qw/^DBIx::Class/;
use Class::C3;
+our $VERSION = '0.03999_02';
+
=head1 NAME
DBIx::Class::Schema::Loader::DBI::DB2 - DBIx::Class::Schema::Loader::DBI DB2 Implementation.
@@ -15,10 +17,7 @@
package My::Schema;
use base qw/DBIx::Class::Schema::Loader/;
- __PACKAGE__->loader_options(
- relationships => 1,
- db_schema => "MYSCHEMA",
- );
+ __PACKAGE__->loader_options( db_schema => "MYSCHEMA" );
1;
Added: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm (rev 0)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -0,0 +1,142 @@
+package DBIx::Class::Schema::Loader::DBI::Oracle;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Schema::Loader::DBI';
+use Carp::Clan qw/^DBIx::Class/;
+use Class::C3;
+
+our $VERSION = '0.03999_02';
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::DBI::Oracle - DBIx::Class::Schema::Loader::DBI
+Oracle Implementation.
+
+=head1 SYNOPSIS
+
+ package My::Schema;
+ use base qw/DBIx::Class::Schema::Loader/;
+
+ __PACKAGE__->loader_options( debug => 1 );
+
+ 1;
+
+=head1 DESCRIPTION
+
+See L<DBIx::Class::Schema::Loader::Base>.
+
+This module is considered experimental and not well tested yet.
+
+=cut
+
+sub _table_columns {
+ my ($self, $table) = @_;
+
+ my $dbh = $self->schema->storage->dbh;
+
+ my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0'));
+ $sth->execute;
+ return \@{$sth->{NAME_lc}};
+}
+
+sub _tables_list {
+ my $self = shift;
+
+ my $dbh = $self->schema->storage->dbh;
+
+ my @tables;
+ for my $table ( $dbh->tables(undef, $self->db_schema, '%', 'TABLE,VIEW') ) { #catalog, schema, table, type
+ my $quoter = $dbh->get_info(29);
+ $table =~ s/$quoter//g;
+
+ # remove "user." (schema) prefixes
+ $table =~ s/\w+\.//;
+
+ next if $table eq 'PLAN_TABLE';
+ $table = lc $table;
+ push @tables, $1
+ if $table =~ /\A(\w+)\z/;
+ }
+ return @tables;
+}
+
+sub _table_uniq_info {
+ my ($self, $table) = @_;
+
+ my @uniqs;
+ my $dbh = $self->schema->storage->dbh;
+
+ my $sth = $dbh->prepare_cached(
+ qq{SELECT constraint_name, ucc.column_name FROM user_constraints JOIN user_cons_columns ucc USING (constraint_name) WHERE ucc.table_name=? AND constraint_type='U'}
+ ,{}, 1);
+
+ $sth->execute(uc $table);
+ my %constr_names;
+ while(my $constr = $sth->fetchrow_arrayref) {
+ my $constr_name = $constr->[0];
+ my $constr_def = $constr->[1];
+ $constr_name =~ s/\Q$self->{_quoter}\E//;
+ $constr_def =~ s/\Q$self->{_quoter}\E//;
+ push @{$constr_names{$constr_name}}, lc $constr_def;
+ }
+ map {
+ push(@uniqs, [ lc $_ => $constr_names{$_} ]);
+ } keys %constr_names;
+
+ return \@uniqs;
+}
+
+sub _table_pk_info {
+ my ( $self, $table ) = @_;
+ return $self->SUPER::_table_pk_info(uc $table);
+}
+
+sub _table_fk_info {
+ my ($self, $table) = @_;
+
+ my $dbh = $self->schema->storage->dbh;
+ my $sth = $dbh->foreign_key_info( '', '', '', '',
+ $self->db_schema, uc $table );
+ return [] if !$sth;
+
+ my %rels;
+
+ my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
+ while(my $raw_rel = $sth->fetchrow_arrayref) {
+ my $uk_tbl = lc $raw_rel->[2];
+ my $uk_col = lc $raw_rel->[3];
+ my $fk_col = lc $raw_rel->[7];
+ my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
+ $uk_tbl =~ s/\Q$self->{_quoter}\E//g;
+ $uk_col =~ s/\Q$self->{_quoter}\E//g;
+ $fk_col =~ s/\Q$self->{_quoter}\E//g;
+ $relid =~ s/\Q$self->{_quoter}\E//g;
+ $rels{$relid}->{tbl} = $uk_tbl;
+ $rels{$relid}->{cols}->{$uk_col} = $fk_col;
+ }
+
+ my @rels;
+ foreach my $relid (keys %rels) {
+ push(@rels, {
+ remote_columns => [ keys %{$rels{$relid}->{cols}} ],
+ local_columns => [ values %{$rels{$relid}->{cols}} ],
+ remote_table => $rels{$relid}->{tbl},
+ });
+ }
+
+ return \@rels;
+}
+
+=head1 SEE ALSO
+
+L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
+L<DBIx::Class::Schema::Loader::DBI>
+
+=head1 AUTHOR
+
+TSUNODA Kazuya C<drk at drk7.jp>
+
+=cut
+
+1;
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -6,6 +6,8 @@
use Carp::Clan qw/^DBIx::Class/;
use Class::C3;
+our $VERSION = '0.03999_02';
+
=head1 NAME
DBIx::Class::Schema::Loader::DBI::Pg - DBIx::Class::Schema::Loader::DBI
@@ -16,9 +18,7 @@
package My::Schema;
use base qw/DBIx::Class::Schema::Loader/;
- __PACKAGE__->loader_options(
- relationships => 1,
- );
+ __PACKAGE__->loader_options( debug => 1 );
1;
@@ -38,6 +38,10 @@
sub _table_uniq_info {
my ($self, $table) = @_;
+ # Use the default support if available
+ return $self->next::method($table)
+ if $DBD::Pg::VERSION >= 1.50;
+
my @uniqs;
my $dbh = $self->schema->storage->dbh;
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -7,6 +7,8 @@
use Text::Balanced qw( extract_bracketed );
use Class::C3;
+our $VERSION = '0.03999_02';
+
=head1 NAME
DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLite Implementation.
@@ -16,7 +18,7 @@
package My::Schema;
use base qw/DBIx::Class::Schema::Loader/;
- __PACKAGE__->loader_optoins( relationships => 1 );
+ __PACKAGE__->loader_options( debug => 1 );
1;
@@ -24,8 +26,26 @@
See L<DBIx::Class::Schema::Loader::Base>.
+=head1 METHODS
+
+=head2 rescan
+
+SQLite will fail all further commands on a connection if the
+underlying schema has been modified. Therefore, any runtime
+changes requiring C<rescan> also require us to re-connect
+to the database. The C<rescan> method here handles that
+reconnection for you, but beware that this must occur for
+any other open sqlite connections as well.
+
=cut
+sub rescan {
+ my ($self, $schema) = @_;
+
+ $schema->storage->disconnect if $schema->storage;
+ $self->next::method($schema);
+}
+
# XXX this really needs a re-factor
sub _sqlite_parse_table {
my ($self, $table) = @_;
@@ -150,6 +170,7 @@
next if $row->{tbl_name} =~ /^sqlite_/;
push @tables, $row->{tbl_name};
}
+ $sth->finish;
return @tables;
}
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/Writing.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -1,6 +1,8 @@
package DBIx::Class::Schema::Loader::DBI::Writing;
use strict;
+our $VERSION = '0.03999_02';
+
# Empty. POD only.
1;
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -6,6 +6,8 @@
use Carp::Clan qw/^DBIx::Class/;
use Class::C3;
+our $VERSION = '0.03999_02';
+
=head1 NAME
DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation.
@@ -15,9 +17,7 @@
package My::Schema;
use base qw/DBIx::Class::Schema::Loader/;
- __PACKAGE__->load_from_connection(
- relationships => 1,
- );
+ __PACKAGE__->loader_options( debug => 1 );
1;
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/DBI.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -2,11 +2,13 @@
use strict;
use warnings;
-use base qw/DBIx::Class::Schema::Loader::Base Class::Accessor::Fast/;
+use base qw/DBIx::Class::Schema::Loader::Base/;
use Class::C3;
use Carp::Clan qw/^DBIx::Class/;
use UNIVERSAL::require;
+our $VERSION = '0.03999_02';
+
=head1 NAME
DBIx::Class::Schema::Loader::DBI - DBIx::Class::Schema::Loader DBI Implementation.
@@ -81,6 +83,20 @@
return @tables;
}
+=head2 load
+
+We override L<DBIx::Class::Schema::Loader::Base/load> here to hook in our localized settings for C<$dbh> error handling.
+
+=cut
+
+sub load {
+ my $self = shift;
+
+ local $self->schema->storage->dbh->{RaiseError} = 1;
+ local $self->schema->storage->dbh->{PrintError} = 0;
+ $self->next::method(@_);
+}
+
# Returns an arrayref of column names
sub _table_columns {
my ($self, $table) = @_;
@@ -93,12 +109,15 @@
my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0'));
$sth->execute;
- return \@{$sth->{NAME_lc}};
+ my $retval = \@{$sth->{NAME_lc}};
+ $sth->finish;
+
+ $retval;
}
# Returns arrayref of pk col names
sub _table_pk_info {
- my ( $self, $table ) = @_;
+ my ($self, $table) = @_;
my $dbh = $self->schema->storage->dbh;
@@ -108,10 +127,41 @@
return \@primary;
}
-# Override this for uniq info
+# Override this for vendor-specific uniq info
sub _table_uniq_info {
- warn "No UNIQUE constraint information can be gathered for this vendor";
- return [];
+ my ($self, $table) = @_;
+
+ my $dbh = $self->schema->storage->dbh;
+ if(!$dbh->can('statistics_info')) {
+ warn "No UNIQUE constraint information can be gathered for this vendor";
+ return [];
+ }
+
+ my %indices;
+ my $sth = $dbh->statistics_info(undef, $self->db_schema, $table, 1, 1);
+ while(my $row = $sth->fetchrow_hashref) {
+ # skip table-level stats, conditional indexes, and any index missing
+ # critical fields
+ next if $row->{TYPE} eq 'table'
+ || defined $row->{FILTER_CONDITION}
+ || !$row->{INDEX_NAME}
+ || !defined $row->{ORDINAL_POSITION}
+ || !$row->{COLUMN_NAME};
+
+ $indices{$row->{INDEX_NAME}}->{$row->{ORDINAL_POSITION}} = $row->{COLUMN_NAME};
+ }
+ $sth->finish;
+
+ my @retval;
+ foreach my $index_name (keys %indices) {
+ my $index = $indices{$index_name};
+ push(@retval, [ $index_name => [
+ map { $index->{$_} }
+ sort keys %$index
+ ]]);
+ }
+
+ return \@retval;
}
# Find relationships
@@ -138,6 +188,7 @@
$rels{$relid}->{tbl} = $uk_tbl;
$rels{$relid}->{cols}->{$uk_col} = $fk_col;
}
+ $sth->finish;
my @rels;
foreach my $relid (keys %rels) {
@@ -151,6 +202,69 @@
return \@rels;
}
+# ported in from DBIx::Class::Storage::DBI:
+sub _columns_info_for {
+ my ($self, $table) = @_;
+
+ my $dbh = $self->schema->storage->dbh;
+
+ if ($dbh->can('column_info')) {
+ my %result;
+ eval {
+ my $sth = $dbh->column_info( undef, $self->db_schema, $table, '%' );
+ $sth->execute();
+ while ( my $info = $sth->fetchrow_hashref() ){
+ my %column_info;
+ $column_info{data_type} = $info->{TYPE_NAME};
+ $column_info{size} = $info->{COLUMN_SIZE};
+ $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
+ $column_info{default_value} = $info->{COLUMN_DEF};
+ my $col_name = $info->{COLUMN_NAME};
+ $col_name =~ s/^\"(.*)\"$/$1/;
+
+ $result{$col_name} = \%column_info;
+ }
+ $sth->finish;
+ };
+ return \%result if !$@ && scalar keys %result;
+ }
+
+ if($self->db_schema) {
+ $table = $self->db_schema . $self->{_namesep} . $table;
+ }
+ my %result;
+ my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0'));
+ $sth->execute;
+ my @columns = @{$sth->{NAME_lc}};
+ for my $i ( 0 .. $#columns ){
+ my %column_info;
+ $column_info{data_type} = $sth->{TYPE}->[$i];
+ $column_info{size} = $sth->{PRECISION}->[$i];
+ $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
+
+ if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
+ $column_info{data_type} = $1;
+ $column_info{size} = $2;
+ }
+
+ $result{$columns[$i]} = \%column_info;
+ }
+ $sth->finish;
+
+ foreach my $col (keys %result) {
+ my $colinfo = $result{$col};
+ my $type_num = $colinfo->{data_type};
+ my $type_name;
+ if(defined $type_num && $dbh->can('type_info')) {
+ my $type_info = $dbh->type_info($type_num);
+ $type_name = $type_info->{TYPE_NAME} if $type_info;
+ $colinfo->{data_type} = $type_name if $type_name;
+ }
+ }
+
+ return \%result;
+}
+
=head1 SEE ALSO
L<DBIx::Class::Schema::Loader>
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -3,9 +3,10 @@
use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class/;
-use Lingua::EN::Inflect ();
use Lingua::EN::Inflect::Number ();
+our $VERSION = '0.03999_02';
+
=head1 NAME
DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
@@ -23,43 +24,47 @@
=head2 new
-Arguments: schema_class (scalar), fk_info (hashref), inflect_plural, inflect_singular
+Arguments: schema_class (scalar), inflect_plural, inflect_singular
C<$schema_class> should be a schema class name, where the source
classes have already been set up and registered. Column info, primary
key, and unique constraints will be drawn from this schema for all
of the existing source monikers.
-The fk_info hashref's contents should take the form:
-
- {
- TableMoniker => [
- {
- local_columns => [ 'col2', 'col3' ],
- remote_columns => [ 'col5', 'col7' ],
- remote_moniker => 'AnotherTableMoniker',
- },
- # ...
- ],
- AnotherTableMoniker => [
- # ...
- ],
- # ...
- }
-
Options inflect_plural and inflect_singular are optional, and are better documented
in L<DBIx::Class::Schema::Loader::Base>.
=head2 generate_code
-This method will return the generated relationships as a hashref per table moniker,
-containing an arrayref of code strings which can be "eval"-ed in the context of
-the source class, like:
+Arguments: local_moniker (scalar), fk_info (arrayref)
+This generates the code for the relationships of a given table.
+
+C<local_moniker> is the moniker name of the table which had the REFERENCES
+statements. The fk_info arrayref's contents should take the form:
+
+ [
+ {
+ local_columns => [ 'col2', 'col3' ],
+ remote_columns => [ 'col5', 'col7' ],
+ remote_moniker => 'AnotherTableMoniker',
+ },
+ {
+ local_columns => [ 'col1', 'col4' ],
+ remote_columns => [ 'col1', 'col2' ],
+ remote_moniker => 'YetAnotherTableMoniker',
+ },
+ # ...
+ ],
+
+This method will return the generated relationships as a hashref keyed on the
+class names. The values are arrayrefs of hashes containing method name and
+arguments, like so:
+
{
'Some::Source::Class' => [
- "belongs_to( col1 => 'AnotherTableMoniker' )",
- "has_many( anothers => 'AnotherTableMoniker', 'col15' )",
+ { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
+ { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
],
'Another::Source::Class' => [
# ...
@@ -67,18 +72,13 @@
# ...
}
-You might want to use this in building an on-disk source class file, by
-adding each string to the appropriate source class file,
-prefixed by C<__PACKAGE__-E<gt>>.
-
=cut
sub new {
- my ( $class, $schema, $fk_info, $inflect_pl, $inflect_singular ) = @_;
+ my ( $class, $schema, $inflect_pl, $inflect_singular ) = @_;
my $self = {
schema => $schema,
- fk_info => $fk_info,
inflect_plural => $inflect_pl,
inflect_singular => $inflect_singular,
};
@@ -102,9 +102,7 @@
return $inflected if $inflected;
}
- return $self->{legacy_default_inflections}
- ? Lingua::EN::Inflect::PL($relname)
- : Lingua::EN::Inflect::Number::to_PL($relname);
+ return Lingua::EN::Inflect::Number::to_PL($relname);
}
# Singularize a relationship name
@@ -120,97 +118,92 @@
return $inflected if $inflected;
}
- return $self->{legacy_default_inflections}
- ? $relname
- : Lingua::EN::Inflect::Number::to_S($relname);
+ return Lingua::EN::Inflect::Number::to_S($relname);
}
sub generate_code {
- my $self = shift;
+ my ($self, $local_moniker, $rels) = @_;
my $all_code = {};
- foreach my $local_moniker (keys %{$self->{fk_info}}) {
- my $local_table = $self->{schema}->source($local_moniker)->from;
- my $local_class = $self->{schema}->class($local_moniker);
- my $rels = $self->{fk_info}->{$local_moniker};
+ my $local_table = $self->{schema}->source($local_moniker)->from;
+ my $local_class = $self->{schema}->class($local_moniker);
- my %counters;
- foreach my $rel (@$rels) {
- next if !$rel->{remote_source};
- $counters{$rel->{remote_source}}++;
- }
+ my %counters;
+ foreach my $rel (@$rels) {
+ next if !$rel->{remote_source};
+ $counters{$rel->{remote_source}}++;
+ }
- foreach my $rel (@$rels) {
- next if !$rel->{remote_source};
- my $local_cols = $rel->{local_columns};
- my $remote_cols = $rel->{remote_columns};
- my $remote_moniker = $rel->{remote_source};
- my $remote_obj = $self->{schema}->source($remote_moniker);
- my $remote_class = $self->{schema}->class($remote_moniker);
- my $remote_table = $remote_obj->from;
- $remote_cols ||= [ $remote_obj->primary_columns ];
+ foreach my $rel (@$rels) {
+ next if !$rel->{remote_source};
+ my $local_cols = $rel->{local_columns};
+ my $remote_cols = $rel->{remote_columns};
+ my $remote_moniker = $rel->{remote_source};
+ my $remote_obj = $self->{schema}->source($remote_moniker);
+ my $remote_class = $self->{schema}->class($remote_moniker);
+ my $remote_table = $remote_obj->from;
+ $remote_cols ||= [ $remote_obj->primary_columns ];
- if($#$local_cols != $#$remote_cols) {
- croak "Column count mismatch: $local_moniker (@$local_cols) "
- . "$remote_moniker (@$remote_cols)";
- }
+ if($#$local_cols != $#$remote_cols) {
+ croak "Column count mismatch: $local_moniker (@$local_cols) "
+ . "$remote_moniker (@$remote_cols)";
+ }
- my %cond;
- foreach my $i (0 .. $#$local_cols) {
- $cond{$remote_cols->[$i]} = $local_cols->[$i];
- }
+ my %cond;
+ foreach my $i (0 .. $#$local_cols) {
+ $cond{$remote_cols->[$i]} = $local_cols->[$i];
+ }
- my $local_relname;
- my $remote_relname;
+ my $local_relname;
+ 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) {
- my ($col) = keys %cond;
- $remote_relname = $self->_inflect_singular($cond{$col});
- }
- else {
- $remote_relname = $self->_inflect_singular(lc $remote_table);
- }
+ # for single-column case, set the remote relname to the column
+ # name, to make filter accessors work
+ if(scalar keys %cond == 1) {
+ my ($col) = keys %cond;
+ $remote_relname = $self->_inflect_singular($cond{$col});
+ }
+ else {
+ $remote_relname = $self->_inflect_singular(lc $remote_table);
+ }
- # If more than one rel between this pair of tables, use the local
- # col names to distinguish
- if($counters{$remote_moniker} > 1) {
- my $colnames = q{_} . join(q{_}, @$local_cols);
- $local_relname = $self->_inflect_plural(
- lc($local_table) . $colnames
- );
- $remote_relname .= $colnames if keys %cond > 1;
- } else {
- $local_relname = $self->_inflect_plural(lc $local_table);
- }
+ # If more than one rel between this pair of tables, use the local
+ # col names to distinguish
+ if($counters{$remote_moniker} > 1) {
+ my $colnames = q{_} . join(q{_}, @$local_cols);
+ $local_relname = $self->_inflect_plural(
+ lc($local_table) . $colnames
+ );
+ $remote_relname .= $colnames if keys %cond > 1;
+ } else {
+ $local_relname = $self->_inflect_plural(lc $local_table);
+ }
- my %rev_cond = reverse %cond;
+ my %rev_cond = reverse %cond;
- for (keys %rev_cond) {
- $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
- delete $rev_cond{$_};
+ for (keys %rev_cond) {
+ $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
+ delete $rev_cond{$_};
+ }
+
+ push(@{$all_code->{$local_class}},
+ { method => 'belongs_to',
+ args => [ $remote_relname,
+ $remote_class,
+ \%cond,
+ ],
}
+ );
- push(@{$all_code->{$local_class}},
- { method => 'belongs_to',
- args => [ $remote_relname,
- $remote_class,
- \%cond,
- ],
- }
- );
-
- push(@{$all_code->{$remote_class}},
- { method => 'has_many',
- args => [ $local_relname,
- $local_class,
- \%rev_cond,
- ],
- }
- );
- }
+ push(@{$all_code->{$remote_class}},
+ { method => 'has_many',
+ args => [ $local_relname,
+ $local_class,
+ \%rev_cond,
+ ],
+ }
+ );
}
return $all_code;
Modified: trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/lib/DBIx/Class/Schema/Loader.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -11,11 +11,10 @@
# Always remember to do all digits for the version even if they're 0
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-our $VERSION = '0.03012';
+our $VERSION = '0.03999_02';
-__PACKAGE__->mk_classaccessor('dump_to_dir');
-__PACKAGE__->mk_classaccessor('loader');
-__PACKAGE__->mk_classaccessor('_loader_args');
+__PACKAGE__->mk_classaccessor('_loader_args' => {});
+__PACKAGE__->mk_classaccessors(qw/dump_to_dir _loader_invoked _loader/);
=head1 NAME
@@ -27,7 +26,6 @@
use base qw/DBIx::Class::Schema::Loader/;
__PACKAGE__->loader_options(
- relationships => 1,
constraint => '^foo.*',
# debug => 1,
);
@@ -47,16 +45,17 @@
setting up the columns, primary keys, and relationships.
DBIx::Class::Schema::Loader currently supports only the DBI storage type.
-It has explicit support for L<DBD::Pg>, L<DBD::mysql>, L<DBD::DB2>, and
-L<DBD::SQLite>. Other DBI drivers may function to a greater or lesser
-degree with this loader, depending on how much of the DBI spec they
-implement, and how standard their implementation is. Patches to make
-other DBDs work correctly welcome.
+It has explicit support for L<DBD::Pg>, L<DBD::mysql>, L<DBD::DB2>,
+L<DBD::SQLite>, and L<DBD::Oracle>. Other DBI drivers may function to
+a greater or lesser degree with this loader, depending on how much of the
+DBI spec they implement, and how standard their implementation is.
+Patches to make other DBDs work correctly welcome.
+
See L<DBIx::Class::Schema::Loader::DBI::Writing> for notes on writing
your own vendor-specific subclass for an unsupported DBD driver.
-This module requires L<DBIx::Class> 0.06 or later, and obsoletes
+This module requires L<DBIx::Class> 0.07006 or later, and obsoletes
the older L<DBIx::Class::Loader>.
This module is designed more to get you up and running quickly against
@@ -65,9 +64,8 @@
That being said, transitioning your code from a Schema generated by this
module to one that doesn't use this module should be straightforward and
-painless (as long as you're not using any methods that are now deprecated
-in this document), so don't shy away from it just for fears of the
-transition down the road.
+painless, so don't shy away from it just for fears of the transition down
+the road.
=head1 METHODS
@@ -78,36 +76,19 @@
only useful in fairly complex scenarios, see the
L<DBIx::Class::Schema::Loader::Base> documentation.
-This method is *required* at this time, for backwards compatibility
-reasons. If you do not wish to change any options, just call it
-with an empty argument list during schema class initialization.
+If you intend to use C<loader_options>, you must call
+C<loader_options> before any connection is made, or embed the
+C<loader_options> in the connection information itself as shown
+below. Setting C<loader_options> after the connection has
+already been made is useless.
-Setting these options explicitly via this method B<after> calling
-C<connection> is deprecated and will stop working in version 0.04000.
-For now the code merely warns about this condition.
-
-The preferred way of doing things is to either call C<loader_options>
-before any connection is made, or embed the C<loader_options> in
-the connection information itself as shown below.
-
=cut
sub loader_options {
my $self = shift;
my %args = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
-
- my $class = ref $self || $self;
- $args{schema} = $self;
- $args{schema_class} = $class;
- weaken($args{schema}) if ref $self;
-
$self->_loader_args(\%args);
- if($self->storage && !$class->loader) {
- warn "Do not set loader_options after specifying the connection info,"
- . " this will be unsupported in 0.04000";
- $self->_invoke_loader;
- }
$self;
}
@@ -116,18 +97,23 @@
my $self = shift;
my $class = ref $self || $self;
- $self->_loader_args->{dump_directory} ||= $self->dump_to_dir;
+ my $args = $self->_loader_args;
+ # set up the schema/schema_class arguments
+ $args->{schema} = $self;
+ $args->{schema_class} = $class;
+ weaken($args->{schema}) if ref $self;
+ $args->{dump_directory} ||= $self->dump_to_dir;
+
# XXX this only works for relative storage_type, like ::DBI ...
my $impl = "DBIx::Class::Schema::Loader" . $self->storage_type;
$impl->require or
croak qq/Could not load storage_type loader "$impl": / .
qq/"$UNIVERSAL::require::ERROR"/;
- # XXX in the future when we get rid of ->loader, the next two
- # lines can be replaced by "$impl->new(%{$self->_loader_args})->load;"
- $class->loader($impl->new(%{$self->_loader_args}));
- $class->loader->load;
+ $self->_loader($impl->new(%$args));
+ $self->_loader->load;
+ $self->_loader_invoked(1);
$self;
}
@@ -158,7 +144,7 @@
$self = $self->next::method(@_);
my $class = ref $self || $self;
- if($self->_loader_args && !$class->loader) {
+ if(!$class->_loader_invoked) {
$self->_invoke_loader
}
@@ -269,19 +255,19 @@
use DBIx::Class::Schema::Loader qw/ make_schema_at /;
make_schema_at(
'New::Schema::Name',
- { relationships => 1, debug => 1 },
+ { debug => 1 },
[ 'dbi:Pg:dbname="foo"','postgres' ],
);
# Complex: dump loaded schema to disk, all from the commandline:
- perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib -e 'make_schema_at("New::Schema::Name", { relationships => 1 }, [ "dbi:Pg:dbname=foo","postgres" ])'
+ perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib -e 'make_schema_at("New::Schema::Name", { debug => 1 }, [ "dbi:Pg:dbname=foo","postgres" ])'
# Same, but inside a script, and using a different way to specify the
# dump directory:
use DBIx::Class::Schema::Loader qw/ make_schema_at /;
make_schema_at(
'New::Schema::Name',
- { relationships => 1, debug => 1, dump_directory => './lib' },
+ { debug => 1, dump_directory => './lib' },
[ 'dbi:Pg:dbname="foo"','postgres' ],
);
@@ -299,6 +285,18 @@
$target->connection(@$connect_info);
}
+=head2 rescan
+
+Re-scans the database for newly added tables since the initial
+load, and adds them to the schema at runtime, including relationships,
+etc. Does not process drops or changes.
+
+Returns a list of the new monikers added.
+
+=cut
+
+sub rescan { my $self = shift; $self->_loader->rescan($self) }
+
=head1 EXAMPLE
Using the example in L<DBIx::Class::Manual::ExampleSchema> as a basis
@@ -309,7 +307,6 @@
use base qw/DBIx::Class::Schema::Loader/;
__PACKAGE__->loader_options(
- relationships => 1,
debug => 1,
);
__PACKAGE__->connection('dbi:SQLite:example.db');
@@ -319,89 +316,6 @@
and remove the Main directory tree (optional). Every thing else
should work the same
-=head1 DEPRECATED METHODS
-
-You don't need to read anything in this section unless you're upgrading
-code that was written against pre-0.03 versions of this module. This
-version is intended to be backwards-compatible with pre-0.03 code, but
-will issue warnings about your usage of deprecated features/methods.
-
-B<All of these deprecated methods will dissappear in version 0.04000>,
-and converting code that uses these methods should be trivial.
-
-=head2 load_from_connection
-
-This deprecated method is now roughly an alias for L</loader_options>.
-
-For now, using this method will invoke the legacy behavior for
-backwards compatibility, and merely emit a warning about upgrading
-your code.
-
-It also reverts the default inflection scheme to
-use L<Lingua::EN::Inflect> just like pre-0.03 versions of this
-module did.
-
-You can force these legacy inflections with the
-option L<DBIx::Class::Schema::Loader::Base/legacy_default_inflections>,
-even after switch over to the preferred L</loader_options> way of doing
-things. That option will not go away until at least 0.05.
-
-See the source of this method for more details.
-
-=cut
-
-sub load_from_connection {
- my ($self, %args) = @_;
-
- my $cmds_ver = $Catalyst::Model::DBIC::Schema::VERSION;
- if($cmds_ver) {
- if($cmds_ver < 0.14) {
- warn 'You should upgrade your installation of'
- . ' Catalyst::Model::DBIC::Schema to 0.14 or higher, then:';
- }
- warn 'You should regenerate your Model files, which may eliminate'
- . ' the following deprecation warning:';
- }
- warn 'load_from_connection deprecated, and will dissappear in 0.04000, '
- . 'please [re-]read the [new] DBIx::Class::Schema::Loader '
- . 'documentation';
-
- # Support the old connect_info / dsn / etc args...
- $args{connect_info} = [
- delete $args{dsn},
- delete $args{user},
- delete $args{password},
- delete $args{options},
- ] if $args{dsn};
-
- $self->connection(@{delete $args{connect_info}})
- if $args{connect_info};
-
- $self->loader_options('legacy_default_inflections' => 1, %args);
-}
-
-=head2 loader
-
-This is an accessor in the generated Schema class for accessing
-the L<DBIx::Class::Schema::Loader::Base> -based loader object
-that was used during construction. See the
-L<DBIx::Class::Schema::Loader::Base> docs for more information
-on the available loader methods there.
-
-This accessor is deprecated. Do not use it. Anything you can
-get from C<loader>, you can get via the normal L<DBIx::Class::Schema>
-methods, and your code will be more robust and forward-thinking
-for doing so.
-
-If you're already using C<loader> in your code, make an effort
-to get rid of it. If you think you've found a situation where it
-is necessary, let me know and we'll see what we can do to remedy
-that situation.
-
-In some future version, this accessor *will* disappear. It was
-apparently quite a design/API mistake to ever have exposed it to
-user-land in the first place, all things considered.
-
=head1 KNOWN ISSUES
=head2 Multiple Database Schemas
Property changes on: trunk/DBIx-Class-Schema-Loader/t
___________________________________________________________________
Name: svn:ignore
+ _dump
Modified: trunk/DBIx-Class-Schema-Loader/t/01use.t
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/01use.t 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/t/01use.t 2007-06-08 01:08:18 UTC (rev 3480)
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 9;
+use Test::More tests => 10;
BEGIN {
use_ok 'DBIx::Class::Schema::Loader';
@@ -10,5 +10,6 @@
use_ok 'DBIx::Class::Schema::Loader::DBI::mysql';
use_ok 'DBIx::Class::Schema::Loader::DBI::Pg';
use_ok 'DBIx::Class::Schema::Loader::DBI::DB2';
+ use_ok 'DBIx::Class::Schema::Loader::DBI::Oracle';
use_ok 'DBIx::Class::Schema::Loader::DBI::Writing';
}
Added: trunk/DBIx-Class-Schema-Loader/t/14ora_common.t
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/14ora_common.t (rev 0)
+++ trunk/DBIx-Class-Schema-Loader/t/14ora_common.t 2007-06-08 01:08:18 UTC (rev 3480)
@@ -0,0 +1,22 @@
+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 => 'SERIAL NOT NULL PRIMARY KEY',
+ 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();
+}
Modified: trunk/DBIx-Class-Schema-Loader/t/20invocations.t
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/20invocations.t 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/t/20invocations.t 2007-06-08 01:08:18 UTC (rev 3480)
@@ -3,8 +3,6 @@
use lib qw(t/lib);
use make_dbictest_db;
-$SIG{__WARN__} = sub { }; # Suppress warnings, as we test a lot of deprecated stuff here
-
# Takes a $schema as input, runs 4 basic tests
sub test_schema {
my ($testname, $schema) = @_;
@@ -23,56 +21,23 @@
}
my @invocations = (
- 'deprecated_one' => sub {
- package DBICTest::Schema::1;
- use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->connection($make_dbictest_db::dsn);
- __PACKAGE__->load_from_connection( relationships => 1 );
- __PACKAGE__;
- },
- 'deprecated_two' => sub {
- package DBICTest::Schema::2;
- use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->load_from_connection(
- relationships => 1,
- connect_info => [ $make_dbictest_db::dsn ],
- );
- __PACKAGE__;
- },
- 'deprecated_three' => sub {
- package DBICTest::Schema::3;
- use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->load_from_connection(
- relationships => 1,
- dsn => $make_dbictest_db::dsn,
- );
- __PACKAGE__;
- },
- 'deprecated_four' => sub {
- package DBICTest::Schema::4;
- use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->connection($make_dbictest_db::dsn);
- __PACKAGE__->loader_options( relationships => 1 );
- __PACKAGE__;
- },
'hardcode' => sub {
package DBICTest::Schema::5;
use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->loader_options( relationships => 1 );
__PACKAGE__->connection($make_dbictest_db::dsn);
__PACKAGE__;
},
'normal' => sub {
package DBICTest::Schema::6;
use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->loader_options( relationships => 1 );
+ __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',
- { relationships => 1 },
+ { dump_overwrite => 1 },
[ $make_dbictest_db::dsn ],
);
DBICTest::Schema::7->clone;
@@ -82,7 +47,7 @@
use base qw/ DBIx::Class::Schema::Loader /;
__PACKAGE__->connect(
$make_dbictest_db::dsn,
- { loader_options => { relationships => 1 } }
+ { loader_options => { dump_overwrite => 1 } }
);
},
'embedded_options_in_attrs' => sub {
@@ -92,7 +57,7 @@
$make_dbictest_db::dsn,
undef,
undef,
- { AutoCommit => 1, loader_options => { relationships => 1 } }
+ { AutoCommit => 1, loader_options => { dump_overwrite => 1 } }
);
},
'embedded_options_make_schema_at' => sub {
@@ -102,7 +67,7 @@
{ },
[
$make_dbictest_db::dsn,
- { loader_options => { relationships => 1 } },
+ { loader_options => { dump_overwrite => 1 } },
],
);
"DBICTest::Schema::10";
@@ -110,7 +75,7 @@
'almost_embedded' => sub {
package DBICTest::Schema::11;
use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->loader_options( relationships => 1 );
+ __PACKAGE__->loader_options( dump_overwrite => 1 );
__PACKAGE__->connect(
$make_dbictest_db::dsn,
undef, undef, { AutoCommit => 1 }
@@ -120,7 +85,7 @@
use DBIx::Class::Schema::Loader;
DBIx::Class::Schema::Loader::make_schema_at(
'DBICTest::Schema::12',
- { relationships => 1 },
+ { dump_overwrite => 1 },
[ $make_dbictest_db::dsn ],
);
DBICTest::Schema::12->clone;
Modified: trunk/DBIx-Class-Schema-Loader/t/21misc_fatal.t
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/21misc_fatal.t 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/t/21misc_fatal.t 2007-06-08 01:08:18 UTC (rev 3480)
@@ -12,7 +12,7 @@
package DBICTest::Schema;
use base qw/ DBIx::Class::Schema::Loader /;
- __PACKAGE__->loader_options( relationships => 1 );
+ __PACKAGE__->loader_options( dump_overwrite => 1 );
__PACKAGE__->storage_type( '::xyzzy' );
}
Modified: trunk/DBIx-Class-Schema-Loader/t/22dump.t
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/22dump.t 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/t/22dump.t 2007-06-08 01:08:18 UTC (rev 3480)
@@ -10,7 +10,6 @@
package DBICTest::Schema::1;
use base qw/ DBIx::Class::Schema::Loader /;
__PACKAGE__->loader_options(
- relationships => 1,
dump_directory => $dump_path,
);
}
@@ -19,20 +18,19 @@
package DBICTest::Schema::2;
use base qw/ DBIx::Class::Schema::Loader /;
__PACKAGE__->loader_options(
- relationships => 1,
dump_directory => $dump_path,
dump_overwrite => 1,
);
}
-plan tests => 8;
+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(undef);
+DBICTest::Schema::1->_loader_invoked(undef);
SKIP: {
skip "ActiveState perl produces additional warnings", 5
@@ -45,7 +43,6 @@
}
my @warnings_regexes = (
qr|Dumping manual schema|,
- (qr|DBICTest/Schema/1.*?.pm exists, will not overwrite|) x 3,
qr|Schema dump completed|,
);
@@ -58,7 +55,7 @@
ok(!$@, 'no death with dump_directory set (overwrite1)')
or diag "Dump failed: $@";
-DBICTest::Schema::2->loader(undef);
+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: $@";
Added: trunk/DBIx-Class-Schema-Loader/t/23dumpmore.t
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/23dumpmore.t (rev 0)
+++ trunk/DBIx-Class-Schema-Loader/t/23dumpmore.t 2007-06-08 01:08:18 UTC (rev 3480)
@@ -0,0 +1,173 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use File::Path;
+use make_dbictest_db;
+require DBIx::Class::Schema::Loader;
+
+plan tests => 40;
+
+plan skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths"
+ if ($^O eq 'MSWin32');
+
+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 => { dump_overwrite => 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/,
+ ],
+ },
+);
+
+END { rmtree($DUMP_PATH, 1, 1); }
Modified: trunk/DBIx-Class-Schema-Loader/t/lib/dbixcsl_common_tests.pm
===================================================================
--- trunk/DBIx-Class-Schema-Loader/t/lib/dbixcsl_common_tests.pm 2007-06-07 23:42:57 UTC (rev 3479)
+++ trunk/DBIx-Class-Schema-Loader/t/lib/dbixcsl_common_tests.pm 2007-06-08 01:08:18 UTC (rev 3480)
@@ -43,7 +43,7 @@
sub run_tests {
my $self = shift;
- plan tests => 84;
+ plan tests => 88;
$self->create();
@@ -100,8 +100,13 @@
}
my $conn = $schema_class->clone;
- my $monikers = $schema_class->loader->monikers;
- my $classes = $schema_class->loader->classes;
+ 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};
@@ -466,6 +471,36 @@
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 {
@@ -791,7 +826,7 @@
},
q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) },
- );
+ );
$self->drop_tables;
@@ -866,6 +901,8 @@
loader_test14
/;
+ my @tables_rescan = qw/ loader_test30 /;
+
my $drop_fk_mysql =
q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
@@ -891,6 +928,7 @@
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->disconnect;
More information about the Bast-commits
mailing list