1#!/usr/bin/perl -w
2
3use strict;
4
5require Test::More;
6
7require 't/test-lib.pl';
8
9if(have_db('sqlite_admin'))
10{
11  Test::More->import(tests => 1523);
12  #Test::More->import('no_plan');
13}
14else
15{
16  Test::More->import(skip_all => 'No SQLite');
17}
18
19use_ok('DateTime');
20use_ok('DateTime::Duration');
21use_ok('Time::Clock');
22use_ok('Bit::Vector');
23use_ok('Rose::DB::Object');
24
25package My::DB::Object;
26our @ISA = qw(Rose::DB::Object);
27sub init_db { Rose::DB->new('sqlite') }
28My::DB::Object->meta->table('rose_db_object_nonesuch');
29
30package My::DB::Object::USN;
31our @ISA = qw(Rose::DB::Object);
32sub init_db { Rose::DB->new('sqlite') }
33My::DB::Object::USN->meta->table('rose_db_object_nonesuch');
34
35package My::DB::Object::USN::Default;
36our @ISA = qw(Rose::DB::Object);
37sub init_db { Rose::DB->new('sqlite') }
38My::DB::Object::USN::Default->meta->table('rose_db_object_nonesuch');
39My::DB::Object::USN::Default->meta->column_undef_overrides_default(1);
40
41package main;
42
43use Rose::DB::Object::Util qw(is_in_db set_state_in_db unset_state_in_db);
44
45my $classes = My::DB::Object->meta->column_type_classes;
46
47my $meta      = My::DB::Object->meta;
48my $meta_usn  = My::DB::Object::USN->meta;
49my $meta_usnd = My::DB::Object::USN::Default->meta;
50
51my $DT   = DateTime->new(year => 2007, month => 12, day => 31);
52my $Time = Time::Clock->new('12:34:56');
53my $Dur   = DateTime::Duration->new(years => 3);
54my $Set   = [ 1, 2, 3 ];
55my $Array = [ 4, 5, 6 ];
56my $BV    = Bit::Vector->new_Dec(32, 123);
57
58my $DT2   = DateTime->new(year => 2008, month => 12, day => 31);
59my $Time2 = Time::Clock->new('22:34:56');
60my $Dur2   = DateTime::Duration->new(years => 5);
61my $Set2   = [ 7, 8, 9 ];
62my $Array2 = [ 9, 8, 7 ];
63my $BV2    = Bit::Vector->new_Dec(32, 456);
64
65my %extra =
66(
67  enum => { values => [ 'foo', 'bar' ] },
68);
69
70my $i = 0;
71
72foreach my $type (sort keys (%$classes))
73{
74  $i++;
75
76  my $default = default_for_column_type($type);
77
78  my %e = $extra{$type} ? %{$extra{$type}} : ();
79
80  $e{'add_method_types'} = [ qw(get) ];
81
82  $meta->add_column("c$i" => { type => $type, default => $default, %e });
83  $meta_usn->add_column("c$i" => { type => $type, default => $default, undef_overrides_default => 1, %e });
84  $meta_usnd->add_column("c$i" => { type => $type, default => $default, %e });
85}
86
87$meta->initialize;
88$meta_usn->initialize;
89$meta_usnd->initialize;
90
91foreach my $n (1 .. $i)
92{
93  my $col     = "c$n";
94  my $type    = $meta->column($col)->type;
95  my $default = $meta->column($col)->default;
96
97  my $method_base = method_for_column_type($type, $n);
98
99  my $db = db_for_column_type($meta->column($col)->type);
100
101  unless($db)
102  {
103    SKIP:
104    {
105      skip("db unavailable for $type tests", 15);
106    }
107
108    next;
109  }
110
111  foreach my $method ($method_base, ($type eq 'chkpass' ? () : "get_$method_base"))
112  {
113    my $o      = My::DB::Object->new;
114    my $o_usn  = My::DB::Object::USN->new;
115    my $o_usnd = My::DB::Object::USN::Default->new;
116
117    $o->db($db);
118    $o_usn->db($db);
119    $o_usnd->db($db);
120
121    set_state_in_db($o);
122    set_state_in_db($o_usn);
123    set_state_in_db($o_usnd);
124
125    is(massage_value(scalar $o->$method()), massage_value($default), "$method $type in db default $n");
126    is(massage_value(scalar $o_usn->$method()), undef, "$method $type in db undef USN explicit $n");
127    is(massage_value(scalar $o_usnd->$method()), undef, "$method $type in db undef USN default $n");
128
129    unset_state_in_db($o);
130    unset_state_in_db($o_usn);
131    unset_state_in_db($o_usnd);
132
133    is(massage_value(scalar $o->$method()), massage_value($default), "$method $type default $n");
134    is(massage_value(scalar $o_usn->$method()), massage_value($default), "$method $type USN explicit $n");
135    is(massage_value(scalar $o_usnd->$method()), massage_value($default), "$method type USN default $n");
136
137    $o->$method_base(undef);
138    $o_usn->$method_base(undef);
139    $o_usnd->$method_base(undef);
140
141    is(massage_value(scalar $o->$method()), massage_value($default), "$method $type undef default $n");
142    is(massage_value(scalar $o_usn->$method()), undef, "$method $type undef USN explicit $n");
143    is(massage_value(scalar $o_usnd->$method()), undef, "$method $type undef USN default $n");
144
145    my $value = value_for_column_type($type);
146
147    $o->$method_base($value);
148    $o_usn->$method_base($value);
149    $o_usnd->$method_base($value);
150
151    is(massage_value(scalar $o->$method()), massage_value($value), "$method $type value default $n");
152    is(massage_value(scalar $o_usn->$method()), massage_value($value), "$method $type value USN explicit $n");
153    is(massage_value(scalar $o_usnd->$method()), massage_value($value), "$method $type value USN default $n");
154
155    $o->$method_base(undef);
156    $o_usn->$method_base(undef);
157    $o_usnd->$method_base(undef);
158
159    is(massage_value(scalar $o->$method()), massage_value($default), "$method $type undef default $n");
160    is(massage_value(scalar $o_usn->$method()), undef, "$method $type undef USN explicit $n");
161    is(massage_value(scalar $o_usnd->$method()), undef, "$method $type undef USN default $n");
162  }
163}
164
165# Default true or nonexistent undef_overrides_default attribute does
166# not conflict with true not_null attribute
167My::DB::Object->meta->add_column('nn' => { type => 'scalar', not_null => 1 });
168My::DB::Object->meta->initialize(replace_existing => 1);
169
170My::DB::Object::USN->meta->add_column('nn' => { type => 'scalar', not_null => 1 });
171My::DB::Object::USN->meta->initialize(replace_existing => 1);
172
173My::DB::Object::USN::Default->meta->add_column('nn' => { type => 'scalar', not_null => 1 });
174My::DB::Object::USN::Default->meta->initialize(replace_existing => 1);
175
176# Explicit true undef_overrides_default attribute conflicts with true not_null attribute
177
178My::DB::Object->meta->add_column('nn' => { type => 'scalar', not_null => 1, undef_overrides_default => 1 });
179eval { My::DB::Object->meta->initialize(replace_existing => 1) };
180
181ok($@, 'not_null undef_overrides_default conflict 1');
182
183My::DB::Object::USN->meta->add_column('nn' => { type => 'scalar', not_null => 1, undef_overrides_default => 1 });
184eval { My::DB::Object::USN->meta->initialize(replace_existing => 1) };
185
186ok($@, 'not_null undef_overrides_default conflict 2');
187
188My::DB::Object::USN::Default->meta->add_column('nn' => { type => 'scalar', not_null => 1, undef_overrides_default => 1});
189eval { My::DB::Object::USN::Default->meta->initialize(replace_existing => 1) };
190
191ok($@, 'not_null undef_overrides_default conflict 3');
192
193sub massage_value
194{
195  my($value) = shift;
196
197  if(ref $value eq 'ARRAY')
198  {
199    return "@$value";
200  }
201
202  return undef  unless(defined $value);
203
204  # XXX: Trim off leading + sign that some versions of Math::BigInt seem to add
205  $value =~ s/^\+//;
206
207  return "$value";
208}
209
210my %DB;
211
212sub db_for_column_type
213{
214  my($type) = shift;
215
216  if($type =~ / year to |^set$/)
217  {
218    return $DB{'informix'} ||= Rose::DB->new('informix');
219  }
220  elsif($type =~ /^(?:interval|chkpass)$/)
221  {
222    return $DB{'pg'} ||= Rose::DB->new('pg');
223  }
224  else
225  {
226    return $DB{'sqlite'} ||= Rose::DB->new('sqlite');
227  }
228}
229
230sub method_for_column_type
231{
232  my($type, $i) = @_;
233
234  if($type eq 'chkpass')
235  {
236    return "c${i}_encrypted";
237  }
238
239  return "c$i";
240}
241
242sub default_for_column_type
243{
244  my($type) = shift;
245
246  if($type =~ /date|timestamp|epoch/)
247  {
248    return $DT;
249  }
250  elsif($type eq 'time')
251  {
252    return $Time;
253  }
254  elsif($type eq 'interval')
255  {
256    return $Dur;
257  }
258  elsif($type eq 'enum')
259  {
260    return 'foo';
261  }
262  elsif($type eq 'set')
263  {
264    return $Set;
265  }
266  elsif($type eq 'array')
267  {
268    return $Array;
269  }
270  elsif($type =~ /^(?:bitfield|bits)/)
271  {
272    return $BV;
273  }
274  elsif($type =~ /^bool/)
275  {
276    return 1;
277  }
278  elsif($type eq 'chkpass')
279  {
280    return ':vOR7BujbRZSLM';
281  }
282
283  return 123;
284}
285
286sub value_for_column_type
287{
288  my($type) = shift;
289
290  if($type =~ /date|timestamp|epoch/)
291  {
292    return $DT2;
293  }
294  elsif($type eq 'time')
295  {
296    return $Time2;
297  }
298  elsif($type eq 'interval')
299  {
300    return $Dur2;
301  }
302  elsif($type eq 'enum')
303  {
304    return 'bar';
305  }
306  elsif($type eq 'set')
307  {
308    return $Set2;
309  }
310  elsif($type eq 'array')
311  {
312    return $Array2;
313  }
314  elsif($type =~ /^(?:bitfield|bits)/)
315  {
316    return $BV2;
317  }
318  elsif($type =~ /^bool/)
319  {
320    return 0;
321  }
322  elsif($type eq 'chkpass')
323  {
324    return ':vOR7BujbRZSLP';
325  }
326
327  return 456;
328}