[Bast-commits] r9353 - in DBIx-Class-DynamicDefault/1.000/trunk: .
lib/DBIx/Class t t/lib t/lib/TestSchema
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Wed May 12 13:59:42 GMT 2010
Author: ribasushi
Date: 2010-05-12 14:59:42 +0100 (Wed, 12 May 2010)
New Revision: 9353
Removed:
DBIx-Class-DynamicDefault/1.000/trunk/t/lib/DBICTest.pm
DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Extended.pm
DBIx-Class-DynamicDefault/1.000/trunk/t/lib/sqlite.sql
Modified:
DBIx-Class-DynamicDefault/1.000/trunk/Makefile.PL
DBIx-Class-DynamicDefault/1.000/trunk/lib/DBIx/Class/DynamicDefault.pm
DBIx-Class-DynamicDefault/1.000/trunk/t/basic.t
DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Affe.pm
Log:
Revert to 03 state
Modified: DBIx-Class-DynamicDefault/1.000/trunk/Makefile.PL
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/Makefile.PL 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/Makefile.PL 2010-05-12 13:59:42 UTC (rev 9353)
@@ -8,6 +8,8 @@
requires 'DBIx::Class' => '0.08009';
requires 'parent';
+build_requires 'DBICx::TestDatabase';
+
makemaker_args(depend => { dist => 'README' });
auto_provides;
extra_tests;
Modified: DBIx-Class-DynamicDefault/1.000/trunk/lib/DBIx/Class/DynamicDefault.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/lib/DBIx/Class/DynamicDefault.pm 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/lib/DBIx/Class/DynamicDefault.pm 2010-05-12 13:59:42 UTC (rev 9353)
@@ -3,7 +3,6 @@
package DBIx::Class::DynamicDefault;
-use Carp qw/croak/;
use parent 'DBIx::Class';
our $VERSION = '0.03';
@@ -57,50 +56,25 @@
$self->next::method(@_);
- my %triggers;
- my %depends;
+ my @update_columns;
+ my @create_columns;
for my $column ($self->columns) {
my $info = $self->column_info($column);
- my $accessor = $info->{accessor} || $column;
+ my $update_trigger = $info->{dynamic_default_on_update};
+ push @update_columns, [$column => $update_trigger, $info->{always_update} || 0]
+ if $update_trigger;
- for my $op (qw/update create/) {
- my $meth = $info->{ "dynamic_default_on_${op}" };
- if (ref $meth && ref $meth eq 'SCALAR') {
- push @{ $depends{$op}->{ $$meth } }, $accessor;
- }
- elsif ($meth) {
- $triggers{$op}->{$column} = [$column => sub {
- my $row = shift;
- my $default = $row->$meth;
- $row->$accessor($default);
- return $default;
- }, $op eq 'update' ? ($info->{always_update} || 0) : ()];
- }
- }
+ my $create_trigger = $info->{dynamic_default_on_create};
+ push @create_columns, [$column => $create_trigger]
+ if $create_trigger;
}
- for my $op (qw/update create/) {
- while (my ($col, $deps) = each %{ $depends{$op} }) {
- my $orig = $triggers{$op}->{$col}->[1];
-
- unless ($orig) {
- croak "found dynamic default depending on column ${col}, but ${col} doesn't have a dynamic default callback";
- }
-
- $triggers{$op}->{$col}->[1] = sub {
- my $row = shift;
- my $default = $row->$orig;
- $row->$_($default) for @{ $deps };
- };
- }
- }
-
- if (map { keys %{ $triggers{$_} } } qw/update create/) {
+ if (@update_columns || @create_columns) {
$self->__column_dynamic_default_triggers({
- on_update => [sort { $b->[2] <=> $a->[2] } values %{ $triggers{update} }],
- on_create => [values %{ $triggers{create} }],
+ on_update => [sort { $b->[2] <=> $a->[2] } @update_columns],
+ on_create => \@create_columns,
});
}
}
@@ -114,7 +88,10 @@
next if defined $self->get_column($column_name);
my $meth = $column->[1];
- $self->$meth;
+ my $default_value = $self->$meth;
+
+ my $accessor = $self->column_info($column_name)->{accessor} || $column_name;
+ $self->$accessor($default_value);
}
return $self->next::method(@_);
@@ -133,8 +110,11 @@
next if exists $dirty{$column_name};
my $meth = $column->[1];
- $self->$meth;
+ my $default_value = $self->$meth;
+ my $accessor = $self->column_info($column_name)->{accessor} || $column_name;
+ $self->$accessor($default_value);
+
$dirty{$column_name} = 1;
}
Modified: DBIx-Class-DynamicDefault/1.000/trunk/t/basic.t
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/t/basic.t 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/t/basic.t 2010-05-12 13:59:42 UTC (rev 9353)
@@ -1,18 +1,16 @@
use strict;
use warnings;
-use Test::More tests => 28;
+use Test::More tests => 14;
use DBICx::TestDatabase;
BEGIN { use_ok('DBIx::Class::DynamicDefault') }
use FindBin;
use lib "$FindBin::Bin/lib";
-use DBICTest;
-my $schema = DBICTest->init_schema;
+my $schema = DBICx::TestDatabase->new('TestSchema');
my $rs = $schema->resultset('Table');
my $rs2 = $schema->resultset('Affe');
-my $rs3 = $schema->resultset('Extended');
my $row = $rs->create({ fred => 'affe' });
@@ -38,34 +36,12 @@
is($row->quux, -23, 'defaults don\'t get set when a value is specified explicitly on create');
-$row = $rs2->create({ moo => 0, kooh => '123', baz => 'moo', bar => 'kooh' });
+$row = $rs2->create({ moo => 0, kooh => '123' });
is($row->moo, 0, 'no default on create');
is($row->kooh, '123', 'no default on create');
-is($TestSchema::Affe::moo_default_called, 0, 'no update callback on create');
$row->update;
-is($TestSchema::Affe::moo_default_called, 1, 'callback called once to set two columns');
is($row->moo, 1, 'default on update without changes and always_update');
is($row->kooh, 'zomtec', 'on update default without always_update if another col is changed due to always_update');
-is($row->baz, 1, 'baz set according to moo');
-is($row->bar, 1, 'bar set according to moo');
-
-$row->update({ moo => 5 });
-
-is($TestSchema::Affe::moo_default_called, 2);
-is($row->moo, 5);
-is($row->baz, 2);
-is($row->bar, 2);
-
-$row->update({ baz => 5 });
-
-is($TestSchema::Affe::moo_default_called, 3);
-is($row->moo, 3);
-is($row->baz, 5);
-is($row->bar, 3);
-
-$row = $rs3->create({ fred => 'affe2' });
-ok($row->quux, 'default on create with methodname for quux');
-ok($row->extra_field, 'default on create with methodname for extra_field');
Deleted: DBIx-Class-DynamicDefault/1.000/trunk/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/t/lib/DBICTest.pm 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/t/lib/DBICTest.pm 2010-05-12 13:59:42 UTC (rev 9353)
@@ -1,71 +0,0 @@
-package # hide from PAUSE
- DBICTest;
-
-use strict;
-use warnings;
-use TestSchema;
-
-=head1 NAME
-
-DBICTest - Minimal version of DBICTest from the DBIx::Class dist
-
-=head1 SYNOPSIS
-
- use lib qw(t/lib);
- use DBICTest;
- use Test::More;
-
- my $schema = DBICTest->init_schema();
-
-=head1 DESCRIPTION
-
-This module provides the basic utilities to write tests against
-DBIx::Class.
-
-=head1 METHODS
-
-=head2 init_schema
-
- my $schema = DBICTest->init_schema;
-
-=cut
-
-sub _connect_info {
- my $self = shift;
- my $db_file = ':memory:';
-
- my $dsn = "dbi:SQLite:${db_file}";
- my $dbuser = '';
- my $dbpass = '';
-
- my @connect_info = ( $dsn, $dbuser, $dbpass );
-
- return @connect_info;
-}
-
-sub init_schema {
- my $self = shift;
-
- my $schema = TestSchema->connect( $self->_connect_info );
- $self->deploy_schema($schema);
- return $schema;
-}
-
-sub deploy_schema {
- my $self = shift;
- my $schema = shift;
-
- open IN, "t/lib/sqlite.sql";
- my $sql;
- { local $/ = undef; $sql = <IN>; }
- close IN;
- for my $chunk ( split( /;\s*\n+/, $sql ) ) {
- if ( $chunk =~ / ^ (?! --\s* ) \S /xm )
- { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment
- $schema->storage->dbh_do( sub { $_[1]->do($chunk) } ) || warn "Error executing SQL. chunk: $chunk";
- }
- }
- return;
-}
-
-1;
Modified: DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Affe.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Affe.pm 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Affe.pm 2010-05-12 13:59:42 UTC (rev 9353)
@@ -5,8 +5,6 @@
use parent qw/DBIx::Class/;
-our $moo_default_called = 0;
-
__PACKAGE__->load_components(qw/DynamicDefault Core/);
__PACKAGE__->table('affe');
@@ -20,14 +18,6 @@
data_type => 'text',
dynamic_default_on_update => 'kooh_default',
},
- baz => {
- data_type => 'integer',
- dynamic_default_on_update => \'moo',
- },
- bar => {
- data_type => 'integer',
- dynamic_default_on_update => \'moo',
- },
);
__PACKAGE__->set_primary_key(qw/moo/);
@@ -36,7 +26,6 @@
my $i = 0;
sub moo_default {
- $moo_default_called++;
return ++$i;
}
}
Deleted: DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Extended.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Extended.pm 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/t/lib/TestSchema/Extended.pm 2010-05-12 13:59:42 UTC (rev 9353)
@@ -1,15 +0,0 @@
-package TestSchema::Extended;
-
-use strict;
-use warnings;
-use parent 'TestSchema::Table';
-
-__PACKAGE__->table('fubar_extended');
-__PACKAGE__->add_column('extra_field' => {
- data_type => 'integer',
- dynamic_default_on_create => 'extra_field_default'
-});
-
-sub extra_field_default { return shift->quux + 1 }
-
-1;
Deleted: DBIx-Class-DynamicDefault/1.000/trunk/t/lib/sqlite.sql
===================================================================
--- DBIx-Class-DynamicDefault/1.000/trunk/t/lib/sqlite.sql 2010-05-12 12:36:35 UTC (rev 9352)
+++ DBIx-Class-DynamicDefault/1.000/trunk/t/lib/sqlite.sql 2010-05-12 13:59:42 UTC (rev 9353)
@@ -1,39 +0,0 @@
---
--- Created by SQL::Translator::Producer::SQLite
--- Created on Wed Nov 11 12:27:59 2009
---
-
-
-BEGIN TRANSACTION;
-
---
--- Table: affe
---
-
-CREATE TABLE affe (
- moo INTEGER PRIMARY KEY NOT NULL,
- kooh text NOT NULL,
- baz integer NOT NULL,
- bar integer NOT NULL
-);
-
---
--- Table: fubar
---
-
-CREATE TABLE fubar (
- quux INTEGER PRIMARY KEY NOT NULL,
- garply integer,
- foo integer NOT NULL,
- fred text NOT NULL
-);
-
-CREATE TABLE fubar_extended (
- quux INTEGER PRIMARY KEY NOT NULL,
- garply integer,
- foo integer NOT NULL,
- fred text NOT NULL,
- extra_field INTEGER NOT NULL
-);
-
-COMMIT;
More information about the Bast-commits
mailing list