Commit | Line | Data |
70350518 |
1 | use strict; |
55087b99 |
2 | use warnings; |
e59c17fe |
3 | |
70350518 |
4 | use Test::More; |
d38cd95c |
5 | use Test::Warn; |
70350518 |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
e59c17fe |
8 | |
72ae8e40 |
9 | { |
10 | package A::Comp; |
11 | use base 'DBIx::Class'; |
12 | sub store_column { shift->next::method (@_) }; |
13 | 1; |
14 | } |
15 | |
16 | { |
17 | package A::SubComp; |
18 | use base 'A::Comp'; |
1415f198 |
19 | |
72ae8e40 |
20 | 1; |
21 | } |
7146f619 |
22 | |
72ae8e40 |
23 | warnings_are ( |
24 | sub { |
1415f198 |
25 | package A::Test1; |
72ae8e40 |
26 | use base 'DBIx::Class::Core'; |
27 | __PACKAGE__->load_components(qw(Core +A::Comp Ordered UTF8Columns)); |
1415f198 |
28 | __PACKAGE__->load_components(qw(Ordered +A::SubComp Row UTF8Columns Core)); |
29 | sub store_column { shift->next::method (@_) }; |
72ae8e40 |
30 | 1; |
31 | }, |
32 | [], |
33 | 'no spurious warnings issued', |
34 | ); |
35 | |
1415f198 |
36 | my $test1_mro; |
72ae8e40 |
37 | my $idx = 0; |
1415f198 |
38 | for (@{mro::get_linear_isa ('A::Test1')} ) { |
39 | $test1_mro->{$_} = $idx++; |
72ae8e40 |
40 | } |
41 | |
1415f198 |
42 | cmp_ok ($test1_mro->{'A::SubComp'}, '<', $test1_mro->{'A::Comp'}, 'mro of Test1 correct (A::SubComp before A::Comp)' ); |
43 | cmp_ok ($test1_mro->{'A::Comp'}, '<', $test1_mro->{'DBIx::Class::UTF8Columns'}, 'mro of Test1 correct (A::Comp before UTF8Col)' ); |
44 | cmp_ok ($test1_mro->{'DBIx::Class::UTF8Columns'}, '<', $test1_mro->{'DBIx::Class::Core'}, 'mro of Test1 correct (UTF8Col before Core)' ); |
45 | cmp_ok ($test1_mro->{'DBIx::Class::Core'}, '<', $test1_mro->{'DBIx::Class::Row'}, 'mro of Test1 correct (Core before Row)' ); |
46 | |
1415f198 |
47 | warnings_like ( |
48 | sub { |
49 | package A::Test2; |
50 | use base 'DBIx::Class::Core'; |
51 | __PACKAGE__->load_components(qw(UTF8Columns +A::Comp)); |
52 | sub store_column { shift->next::method (@_) }; |
53 | 1; |
54 | }, |
55 | [qr/Incorrect loading order of DBIx::Class::UTF8Columns.+affect other components overriding 'store_column' \(A::Comp\)/], |
56 | 'incorrect order warning issued (violator defines)', |
57 | ); |
58 | |
59 | warnings_like ( |
60 | sub { |
61 | package A::Test3; |
62 | use base 'DBIx::Class::Core'; |
63 | __PACKAGE__->load_components(qw(UTF8Columns +A::SubComp)); |
64 | sub store_column { shift->next::method (@_) }; |
65 | 1; |
66 | }, |
67 | [qr/Incorrect loading order of DBIx::Class::UTF8Columns.+affect other components overriding 'store_column' \(A::SubComp \(via A::Comp\)\)/], |
68 | 'incorrect order warning issued (violator inherits)', |
69 | ); |
72ae8e40 |
70 | |
a47e1233 |
71 | my $schema = DBICTest->init_schema(); |
404939a4 |
72 | DBICTest::Schema::CD->load_components('UTF8Columns'); |
73 | DBICTest::Schema::CD->utf8_columns('title'); |
70350518 |
74 | Class::C3->reinitialize(); |
75 | |
cdd254a5 |
76 | { |
77 | package DBICTest::UTF8::Debugger; |
337c98ef |
78 | |
cdd254a5 |
79 | use base 'DBIx::Class::Storage::Statistics'; |
a786c458 |
80 | |
cdd254a5 |
81 | __PACKAGE__->mk_group_accessors(simple => 'call_stack'); |
337c98ef |
82 | |
cdd254a5 |
83 | sub query_start { |
84 | my $self = shift; |
85 | my $sql = shift; |
86 | |
87 | my @bind = map { substr $_, 1, -1 } (@_); # undo the effect of _fix_bind_params |
88 | |
89 | $self->call_stack ( [ @{$self->call_stack || [] }, [$sql, @bind] ] ); |
90 | $self->next::method ($sql, @_); |
91 | } |
92 | } |
93 | |
fed2c7d7 |
94 | # as per http://search.cpan.org/dist/Test-Simple/lib/Test/More.pm#utf8 |
95 | binmode (Test::More->builder->$_, ':utf8') for qw/output failure_output todo_output/; |
cdd254a5 |
96 | |
97 | my $bytestream_title = my $utf8_title = "weird \x{466} stuff"; |
98 | utf8::encode($bytestream_title); |
99 | cmp_ok ($bytestream_title, 'ne', $utf8_title, 'unicode/raw differ (sanity check)'); |
100 | |
101 | my $storage = $schema->storage; |
102 | $storage->debugobj (DBICTest::UTF8::Debugger->new); |
103 | $storage->debugobj->silence (1); |
104 | $storage->debug (1); |
337c98ef |
105 | |
cdd254a5 |
106 | my $cd = $schema->resultset('CD')->create( { artist => 1, title => $utf8_title, year => '2048' } ); |
1d0057bd |
107 | |
cdd254a5 |
108 | # bind values are always alphabetically ordered by column, thus [2] |
109 | TODO: { |
110 | local $TODO = "This has been broken since rev 1191, Mar 2006"; |
111 | is ($storage->debugobj->call_stack->[-1][2], $bytestream_title, 'INSERT: raw bytes sent to the database'); |
112 | } |
113 | |
114 | # this should be using the cursor directly, no inflation/processing of any sort |
115 | my ($raw_db_title) = $schema->resultset('CD') |
116 | ->search ($cd->ident_condition) |
117 | ->get_column('title') |
118 | ->_resultset |
119 | ->cursor |
120 | ->next; |
121 | |
122 | is ($raw_db_title, $bytestream_title, 'INSERT: raw bytes retrieved from database'); |
123 | |
124 | for my $reloaded (0, 1) { |
125 | my $test = $reloaded ? 'reloaded' : 'stored'; |
126 | $cd->discard_changes if $reloaded; |
1d0057bd |
127 | |
cdd254a5 |
128 | ok( utf8::is_utf8( $cd->title ), "got $test title with utf8 flag" ); |
129 | ok(! utf8::is_utf8( $cd->{_column_data}{title} ), "in-object $test title without utf8" ); |
130 | |
131 | ok(! utf8::is_utf8( $cd->year ), "got $test year without utf8 flag" ); |
132 | ok(! utf8::is_utf8( $cd->{_column_data}{year} ), "in-object $test year without utf8" ); |
133 | } |
134 | |
135 | $cd->title('nonunicode'); |
136 | ok(! utf8::is_utf8( $cd->title ), 'update title without utf8 flag' ); |
137 | ok(! utf8::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less title' ); |
138 | |
139 | $cd->update; |
140 | $cd->discard_changes; |
141 | ok(! utf8::is_utf8( $cd->title ), 'reloaded title without utf8 flag' ); |
142 | ok(! utf8::is_utf8( $cd->{_column_data}{title} ), 'reloaded utf8-less title' ); |
143 | |
144 | $bytestream_title = $utf8_title = "something \x{219} else"; |
145 | utf8::encode($bytestream_title); |
146 | |
147 | $cd->update ({ title => $utf8_title }); |
148 | is ($storage->debugobj->call_stack->[-1][1], $bytestream_title, 'UPDATE: raw bytes sent to the database'); |
149 | ($raw_db_title) = $schema->resultset('CD') |
150 | ->search ($cd->ident_condition) |
151 | ->get_column('title') |
152 | ->_resultset |
153 | ->cursor |
154 | ->next; |
155 | is ($raw_db_title, $bytestream_title, 'UPDATE: raw bytes retrieved from database'); |
156 | |
157 | $cd->discard_changes; |
158 | $cd->title($utf8_title); |
1d0057bd |
159 | ok( !$cd->is_column_changed('title'), 'column is not dirty after setting the same unicode value' ); |
160 | |
cdd254a5 |
161 | $cd->update ({ title => $utf8_title }); |
1d0057bd |
162 | $cd->title('something_else'); |
163 | ok( $cd->is_column_changed('title'), 'column is dirty after setting to something completely different'); |
db087eb1 |
164 | |
165 | TODO: { |
166 | local $TODO = 'There is currently no way to propagate aliases to inflate_result()'; |
cdd254a5 |
167 | $cd = $schema->resultset('CD')->find ({ title => $utf8_title }, { select => 'title', as => 'name' }); |
55087b99 |
168 | ok (utf8::is_utf8( $cd->get_column ('name') ), 'utf8 flag propagates via as'); |
db087eb1 |
169 | } |
170 | |
55087b99 |
171 | done_testing; |