[Catalyst-commits] r13797 - in Catalyst-Model-DBIC-Schema/trunk: .
lib/Catalyst/Helper/Model/DBIC t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Tue Dec 7 03:49:20 GMT 2010
Author: caelum
Date: 2010-12-07 03:49:20 +0000 (Tue, 07 Dec 2010)
New Revision: 13797
Modified:
Catalyst-Model-DBIC-Schema/trunk/Changes
Catalyst-Model-DBIC-Schema/trunk/Makefile.PL
Catalyst-Model-DBIC-Schema/trunk/lib/Catalyst/Helper/Model/DBIC/Schema.pm
Catalyst-Model-DBIC-Schema/trunk/t/05testapp.t
Log:
do not upgrade non-Moose schemas to use_moose=1 (RT#60558)
Modified: Catalyst-Model-DBIC-Schema/trunk/Changes
===================================================================
--- Catalyst-Model-DBIC-Schema/trunk/Changes 2010-12-06 19:04:22 UTC (rev 13796)
+++ Catalyst-Model-DBIC-Schema/trunk/Changes 2010-12-07 03:49:20 UTC (rev 13797)
@@ -1,6 +1,8 @@
Revision history for Perl extension Catalyst::Model::DBIC::Schema
+ - do not upgrade non-Moose schemas to use_moose=1 (RT#60558)
- added col_collision_map => 'column_%s' as default loader option
+ (will take effect on release of loader 0.07003)
0.43 Sun Jul 25 01:00:34 UTC 2010
- add dep for MooseX::NonMoose for the use_moose=1 option
Modified: Catalyst-Model-DBIC-Schema/trunk/Makefile.PL
===================================================================
--- Catalyst-Model-DBIC-Schema/trunk/Makefile.PL 2010-12-06 19:04:22 UTC (rev 13796)
+++ Catalyst-Model-DBIC-Schema/trunk/Makefile.PL 2010-12-07 03:49:20 UTC (rev 13797)
@@ -14,6 +14,7 @@
requires 'Carp::Clan';
requires 'List::MoreUtils';
requires 'Tie::IxHash';
+requires 'Try::Tiny';
test_requires 'Test::More' => '0.94';
test_requires 'Test::Exception';
Modified: Catalyst-Model-DBIC-Schema/trunk/lib/Catalyst/Helper/Model/DBIC/Schema.pm
===================================================================
--- Catalyst-Model-DBIC-Schema/trunk/lib/Catalyst/Helper/Model/DBIC/Schema.pm 2010-12-06 19:04:22 UTC (rev 13796)
+++ Catalyst-Model-DBIC-Schema/trunk/lib/Catalyst/Helper/Model/DBIC/Schema.pm 2010-12-07 03:49:20 UTC (rev 13797)
@@ -15,6 +15,8 @@
use Catalyst::Model::DBIC::Schema::Types 'CreateOption';
use List::MoreUtils 'firstidx';
use Scalar::Util 'looks_like_number';
+use File::Find 'finddepth';
+use Try::Tiny;
=head1 NAME
@@ -143,6 +145,7 @@
has loader_args => (is => 'rw', isa => HashRef);
has connect_info => (is => 'rw', isa => HashRef);
has old_schema => (is => 'rw', isa => Bool, lazy_build => 1);
+has is_moose_schema => (is => 'rw', isa => Bool, lazy_build => 1);
has components => (is => 'rw', isa => ArrayRef);
=head1 METHODS
@@ -265,7 +268,7 @@
%result = (
relationships => 1,
- use_moose => 1,
+ use_moose => $self->is_moose_schema ? 1 : 0,
col_collision_map => 'column_%s',
(!$self->old_schema ? (
use_namespaces => 1
@@ -399,6 +402,35 @@
0;
}
+sub _build_is_moose_schema {
+ my $self = shift;
+
+ my @schema_parts = split '::', $self->schema_class;
+ my $schema_dir =
+ File::Spec->catfile($self->helper->{base}, 'lib', @schema_parts);
+
+ # assume yes for new schemas
+ return 1 if not -d $schema_dir;
+
+ my $uses_moose = 1;
+
+ try {
+ finddepth(sub {
+ open my $fh, '<', $File::Find::name
+ or die "Could not open $File::Find::name: $!";
+
+ my $code = do { local $/; <$fh> };
+ close $fh;
+
+ $uses_moose = 0 if $code !~ /\nuse Moose;\n/;
+
+ die;
+ }, $schema_dir);
+ };
+
+ return $uses_moose;
+}
+
sub _data_struct_to_string {
my ($self, $data) = @_;
Modified: Catalyst-Model-DBIC-Schema/trunk/t/05testapp.t
===================================================================
--- Catalyst-Model-DBIC-Schema/trunk/t/05testapp.t 2010-12-06 19:04:22 UTC (rev 13796)
+++ Catalyst-Model-DBIC-Schema/trunk/t/05testapp.t 2010-12-07 03:49:20 UTC (rev 13797)
@@ -53,7 +53,7 @@
foreach my $tparam (@$test_params) {
my ($model, $helper, @args) = @$tparam;
- unlink for glob(File::Spec->catfile($schema_dir, 'Result', '*'));
+ cleanup_schema();
system($^X, "-I$blib_dir", $creator, 'model', $model, $helper, $model, @args);
@@ -63,17 +63,56 @@
ok($compile_rv == 0, "perl -c $model_path");
if (grep /create=static/, @args) {
- my $glob = File::Spec->catfile($schema_dir, 'Result', '*');
- my $tables =()= glob($glob);
+ my @result_files = result_files();
if (grep /constraint/, @args) {
- is $tables, 1, 'constraint works';
+ is scalar @result_files, 1, 'constraint works';
} else {
- is $tables, 2, 'correct number of tables';
+ is scalar @result_files, 2, 'correct number of tables';
}
+
+ for my $file (@result_files) {
+ my $code = code_for($file);
+
+ like $code, qr/use Moose;\n/, 'use_moose enabled';
+ like $code, qr/__PACKAGE__->meta->make_immutable;\n/, 'use_moose enabled';
+ }
}
}
+# Test that use_moose=1 is not applied to existing non-moose schemas (RT#60558)
+{
+ cleanup_schema();
+
+ system($^X, "-I$blib_dir", $creator, 'model',
+ 'TestSchemaDSN', 'DBIC::Schema', 'TestSchemaDSN',
+ 'create=static', 'use_moose=0', 'dbi:SQLite:testdb.db'
+ );
+
+ my @result_files = result_files();
+
+ for my $file (@result_files) {
+ my $code = code_for($file);
+
+ unlike $code, qr/use Moose;\n/, 'non use_moose=1 schema';
+ unlike $code, qr/__PACKAGE__->meta->make_immutable;\n/, 'non use_moose=1 schema';
+ }
+
+ system($^X, "-I$blib_dir", $creator, 'model',
+ 'TestSchemaDSN', 'DBIC::Schema', 'TestSchemaDSN',
+ 'create=static', 'dbi:SQLite:testdb.db'
+ );
+
+ for my $file (@result_files) {
+ my $code = code_for($file);
+
+ unlike $code, qr/use Moose;\n/,
+ 'non use_moose=1 schema not upgraded to use_moose=1';
+ unlike $code, qr/__PACKAGE__->meta->make_immutable;\n/,
+ 'non use_moose=1 schema not upgraded to use_moose=1';
+ }
+}
+
done_testing;
sub rm_rf {
@@ -82,9 +121,33 @@
else { unlink $name or die "Cannot unlink $name: $!" }
}
+sub cleanup_schema {
+ return unless -d $schema_dir;
+ finddepth(\&rm_rf, $schema_dir);
+ unlink "${schema_dir}.pm";
+}
+
+sub code_for {
+ my $file = shift;
+
+ open my $fh, '<', $file;
+ my $code = do { local $/; <$fh> };
+ close $fh;
+
+ return $code;
+}
+
+sub result_files {
+ my $glob = File::Spec->catfile($schema_dir, 'Result', '*');
+
+ return glob($glob);
+}
+
END {
if ($ENV{C_M_DBIC_SCHEMA_TESTAPP}) {
chdir($test_dir);
finddepth(\&rm_rf, $cat_dir);
}
}
+
+# vim:sts=3 sw=3 et tw=80:
More information about the Catalyst-commits
mailing list