[Bast-commits] r8254 - in DBIx-Class/0.08/trunk: lib/DBIx
lib/DBIx/Class t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Fri Jan 8 16:52:01 GMT 2010
Author: ribasushi
Date: 2010-01-08 16:52:01 +0000 (Fri, 08 Jan 2010)
New Revision: 8254
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Componentised.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/UTF8Columns.pm
DBIx-Class/0.08/trunk/t/85utf8.t
Log:
Put utf8columns in line with the store_column fix
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Componentised.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Componentised.pm 2010-01-08 16:48:50 UTC (rev 8253)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Componentised.pm 2010-01-08 16:52:01 UTC (rev 8254)
@@ -4,10 +4,34 @@
use strict;
use warnings;
-###
-# Keep this class for backwards compatibility
-###
-
use base 'Class::C3::Componentised';
+use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/;
+use mro 'c3';
+# this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
+sub inject_base {
+ my $class = shift;
+ my $target = shift;
+
+ my @present_components = (@{mro::get_linear_isa ($target)||[]});
+
+ no strict 'refs';
+ for my $comp (reverse @_) {
+ if (
+ $comp->isa ('DBIx::Class::UTF8Columns')
+ and
+ my @broken = grep { $_ ne 'DBIx::Class::Row' and defined ${"${_}::"}{store_column} } (@present_components)
+ ) {
+ carp "Incorrect loading order of $comp by ${target} will affect other components overriding store_column ("
+ . join (', ', @broken)
+ .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info';
+ }
+ else {
+ unshift @present_components, $comp;
+ }
+ }
+
+ $class->next::method($target, @_);
+}
+
1;
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/UTF8Columns.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/UTF8Columns.pm 2010-01-08 16:48:50 UTC (rev 8253)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/UTF8Columns.pm 2010-01-08 16:52:01 UTC (rev 8254)
@@ -26,6 +26,15 @@
This module allows you to get columns data that have utf8 (Unicode) flag.
+=head2 Warning
+
+Note that this module overloads L<DBIx::Class::Row/store_column> in a way
+that may prevent other components overloading the same method from working
+correctly. This component must be the last one before L<DBIx::Class::Row>
+(which is provided by L<DBIx::Class::Core>). DBIx::Class will detect such
+incorrect component order and issue an appropriate warning, advising which
+components need to be loaded differently.
+
=head1 SEE ALSO
L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
@@ -42,7 +51,7 @@
foreach my $col (@_) {
$self->throw_exception("column $col doesn't exist")
unless $self->has_column($col);
- }
+ }
return $self->_utf8_columns({ map { $_ => 1 } @_ });
} else {
return $self->_utf8_columns;
@@ -59,10 +68,9 @@
my ( $self, $column ) = @_;
my $value = $self->next::method($column);
- my $cols = $self->_utf8_columns;
- if ( $cols and defined $value and $cols->{$column} ) {
- utf8::decode($value) unless utf8::is_utf8($value);
- }
+ utf8::decode($value) if (
+ defined $value and $self->_is_utf8_column($column) and ! utf8::is_utf8($value)
+ );
return $value;
}
@@ -75,8 +83,10 @@
my $self = shift;
my %data = $self->next::method(@_);
- foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
- utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
+ foreach my $col (keys %data) {
+ utf8::decode($data{$col}) if (
+ exists $data{$col} and defined $data{$col} and $self->_is_utf8_column($col) and ! utf8::is_utf8($data{$col})
+ );
}
return %data;
@@ -89,27 +99,32 @@
sub store_column {
my ( $self, $column, $value ) = @_;
- my $cols = $self->_utf8_columns;
- if ( $cols and defined $value and $cols->{$column} ) {
- utf8::encode($value) if utf8::is_utf8($value);
+ # the dirtyness comparison must happen on the non-encoded value
+ my $copy;
+
+ if ( defined $value and $self->_is_utf8_column($column) and utf8::is_utf8($value) ) {
+ $copy = $value;
+ utf8::encode($value);
}
$self->next::method( $column, $value );
+
+ return $copy || $value;
}
-=head1 AUTHOR
+# override this if you want to force everything to be encoded/decoded
+sub _is_utf8_column {
+ return (shift->utf8_columns || {})->{shift};
+}
-Daisuke Murase <typester at cpan.org>
+=head1 AUTHORS
-=head1 COPYRIGHT
+See L<DBIx::Class/CONTRIBUTORS>.
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
+=head1 LICENSE
-The full text of the license can be found in the
-LICENSE file included with this module.
+You may distribute this code under the same terms as Perl itself.
=cut
1;
-
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class.pm 2010-01-08 16:48:50 UTC (rev 8253)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class.pm 2010-01-08 16:52:01 UTC (rev 8254)
@@ -4,9 +4,10 @@
use warnings;
use MRO::Compat;
+use mro 'c3';
use vars qw($VERSION);
-use base qw/Class::C3::Componentised Class::Accessor::Grouped/;
+use base qw/DBIx::Class::Componentised Class::Accessor::Grouped/;
use DBIx::Class::StartupCheck;
sub mk_classdata {
Modified: DBIx-Class/0.08/trunk/t/85utf8.t
===================================================================
--- DBIx-Class/0.08/trunk/t/85utf8.t 2010-01-08 16:48:50 UTC (rev 8253)
+++ DBIx-Class/0.08/trunk/t/85utf8.t 2010-01-08 16:52:01 UTC (rev 8254)
@@ -2,10 +2,25 @@
use warnings;
use Test::More;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
use utf8;
+warning_like (sub {
+
+ package A::Comp;
+ use base 'DBIx::Class';
+ sub store_column { shift->next::method (@_) };
+ 1;
+
+ package A::Test;
+ use base 'DBIx::Class::Core';
+ __PACKAGE__->load_components(qw(UTF8Columns +A::Comp));
+ 1;
+}, qr/Incorrect loading order of DBIx::Class::UTF8Columns/ );
+
+
my $schema = DBICTest->init_schema();
DBICTest::Schema::CD->load_components('UTF8Columns');
More information about the Bast-commits
mailing list