[Bast-commits] r9357 - in
DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing:
lib/DBIx/Class t t/lib/TestSchema
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Wed May 12 14:14:31 GMT 2010
Author: ribasushi
Date: 2010-05-12 15:14:31 +0100 (Wed, 12 May 2010)
New Revision: 9357
Modified:
DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/lib/DBIx/Class/DynamicDefault.pm
DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/basic.t
DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/lib/TestSchema/Affe.pm
Log:
Changes from former trunk
Modified: DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/lib/DBIx/Class/DynamicDefault.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/lib/DBIx/Class/DynamicDefault.pm 2010-05-12 14:13:45 UTC (rev 9356)
+++ DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/lib/DBIx/Class/DynamicDefault.pm 2010-05-12 14:14:31 UTC (rev 9357)
@@ -3,6 +3,7 @@
package DBIx::Class::DynamicDefault;
+use Carp qw/croak/;
use parent 'DBIx::Class';
our $VERSION = '0.03';
@@ -56,25 +57,50 @@
$self->next::method(@_);
- my @update_columns;
- my @create_columns;
+ my %triggers;
+ my %depends;
for my $column ($self->columns) {
my $info = $self->column_info($column);
- my $update_trigger = $info->{dynamic_default_on_update};
- push @update_columns, [$column => $update_trigger, $info->{always_update} || 0]
- if $update_trigger;
+ my $accessor = $info->{accessor} || $column;
- my $create_trigger = $info->{dynamic_default_on_create};
- push @create_columns, [$column => $create_trigger]
- if $create_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) : ()];
+ }
+ }
}
- if (@update_columns || @create_columns) {
+ 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/) {
$self->__column_dynamic_default_triggers({
- on_update => [sort { $b->[2] <=> $a->[2] } @update_columns],
- on_create => \@create_columns,
+ on_update => [sort { $b->[2] <=> $a->[2] } values %{ $triggers{update} }],
+ on_create => [values %{ $triggers{create} }],
});
}
}
@@ -88,10 +114,7 @@
next if defined $self->get_column($column_name);
my $meth = $column->[1];
- my $default_value = $self->$meth;
-
- my $accessor = $self->column_info($column_name)->{accessor} || $column_name;
- $self->$accessor($default_value);
+ $self->$meth;
}
return $self->next::method(@_);
@@ -110,11 +133,8 @@
next if exists $dirty{$column_name};
my $meth = $column->[1];
- my $default_value = $self->$meth;
+ $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/branches/post-03_rafl_faffing/t/basic.t
===================================================================
--- DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/basic.t 2010-05-12 14:13:45 UTC (rev 9356)
+++ DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/basic.t 2010-05-12 14:14:31 UTC (rev 9357)
@@ -1,6 +1,6 @@
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 26;
use DBICx::TestDatabase;
BEGIN { use_ok('DBIx::Class::DynamicDefault') }
@@ -36,12 +36,30 @@
is($row->quux, -23, 'defaults don\'t get set when a value is specified explicitly on create');
-$row = $rs2->create({ moo => 0, kooh => '123' });
+$row = $rs2->create({ moo => 0, kooh => '123', baz => 'moo', bar => 'kooh' });
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);
Modified: DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/lib/TestSchema/Affe.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/lib/TestSchema/Affe.pm 2010-05-12 14:13:45 UTC (rev 9356)
+++ DBIx-Class-DynamicDefault/1.000/branches/post-03_rafl_faffing/t/lib/TestSchema/Affe.pm 2010-05-12 14:14:31 UTC (rev 9357)
@@ -5,6 +5,8 @@
use parent qw/DBIx::Class/;
+our $moo_default_called = 0;
+
__PACKAGE__->load_components(qw/DynamicDefault Core/);
__PACKAGE__->table('affe');
@@ -18,6 +20,14 @@
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/);
@@ -26,6 +36,7 @@
my $i = 0;
sub moo_default {
+ $moo_default_called++;
return ++$i;
}
}
More information about the Bast-commits
mailing list