1#!/usr/bin/perl
2
3use strict;
4
5use FindBin qw($Bin);
6
7use Rose::DB;
8
9BEGIN
10{
11  Rose::DB->default_domain('test');
12
13  #
14  # PostgreSQL
15  #
16
17  eval { require DBD::Pg };
18
19  $ENV{'PGDATESTYLE'} = 'MDY';
20
21  no warnings 'uninitialized';
22
23  # Many tests don't work with DBD::Pg version 2.1.x and 2.2.0
24  unless($DBD::Pg::VERSION =~ /^2\.(?:1\.|2\.0)/)
25  {
26    # Main
27    Rose::DB->register_db(
28      domain   => 'test',
29      type     => 'pg',
30      driver   => 'Pg',
31      database => 'test',
32      host     => 'localhost',
33      username => 'postgres',
34      password => '',
35      connect_options => { AutoCommit => 1 },
36      post_connect_sql =>
37      [
38        'SET default_transaction_isolation TO "read committed"',
39      ],
40    );
41
42    # Private schema
43    Rose::DB->register_db(
44      domain   => 'test',
45      type     => 'pg_with_schema',
46      schema   => 'rose_db_object_private',
47      driver   => 'Pg',
48      database => 'test',
49      host     => 'localhost',
50      username => 'postgres',
51      password => '',
52      connect_options => { AutoCommit => 1 },
53      post_connect_sql =>
54      [
55        'SET default_transaction_isolation TO "read committed"',
56      ],
57    );
58
59    # Admin
60    Rose::DB->register_db(
61      domain   => 'test',
62      type     => 'pg_admin',
63      driver   => 'Pg',
64      database => 'test',
65      host     => 'localhost',
66      username => 'postgres',
67      password => '',
68      connect_options => { AutoCommit => 1 },
69      post_connect_sql =>
70      [
71        'SET default_transaction_isolation TO "read committed"',
72      ],
73    );
74  }
75
76  #
77  # MySQL
78  #
79
80  # Main
81  Rose::DB->register_db(
82    domain   => 'test',
83    type     => 'mysql',
84    driver   => 'mysql',
85    database => 'test',
86    host     => 'localhost',
87    username => 'root',
88    password => ''
89  );
90
91  # Admin
92  Rose::DB->register_db(
93    domain   => 'test',
94    type     => 'mysql_admin',
95    driver   => 'mysql',
96    database => 'test',
97    host     => 'localhost',
98    username => 'root',
99    password => ''
100  );
101
102  #
103  # Informix
104  #
105
106  # Main
107  Rose::DB->register_db(
108    domain   => 'test',
109    type     => 'informix',
110    driver   => 'Informix',
111    database => 'test@test',
112    connect_options => { AutoCommit => 1 },
113    post_connect_sql =>
114    [
115      'SET LOCK MODE TO WAIT 100',
116      'SET ISOLATION TO DIRTY READ',
117    ],
118  );
119
120  # Admin
121  Rose::DB->register_db(
122    domain   => 'test',
123    type     => 'informix_admin',
124    driver   => 'Informix',
125    database => 'test@test',
126    connect_options => { AutoCommit => 1 },
127    post_connect_sql =>
128    [
129      'SET LOCK MODE TO WAIT 100',
130      'SET ISOLATION TO DIRTY READ',
131    ],
132  );
133
134  #
135  # SQLite
136  #
137
138  eval
139  {
140    local $^W = 0;
141    require DBD::SQLite;
142  };
143
144  (my $version = $DBD::SQLite::VERSION || 0) =~ s/_//g;
145
146  unless($ENV{'RDBO_NO_SQLITE'} || $version < 1.11 || ($version >= 1.13 && $version < 1.1902))
147  {
148    #unlink("$Bin/sqlite.db");
149
150    # Main
151    Rose::DB->register_db(
152      domain   => 'test',
153      type     => 'sqlite',
154      driver   => 'sqlite',
155      database => "$Bin/sqlite.db",
156      auto_create     => 0,
157      connect_options => { AutoCommit => 1 },
158      post_connect_sql =>
159      [
160        'PRAGMA synchronous = OFF',
161        'PRAGMA temp_store = MEMORY',
162      ],
163    );
164
165    # Admin
166    Rose::DB->register_db(
167      domain   => 'test',
168      type     => 'sqlite_admin',
169      driver   => 'sqlite',
170      database => "$Bin/sqlite.db",
171      connect_options => { AutoCommit => 1 },
172      post_connect_sql =>
173      [
174        'PRAGMA synchronous = OFF',
175        'PRAGMA temp_store = MEMORY',
176      ],
177    );
178  }
179
180  #
181  # Oracle
182  #
183
184  # Main
185  Rose::DB->register_db(
186    domain   => 'test',
187    type     => 'oracle',
188    driver   => 'oracle',
189    database => 'test@test',
190    connect_options => { AutoCommit => 1 },
191  );
192
193  # Admin
194  Rose::DB->register_db(
195    domain   => 'test',
196    type     => 'oracle_admin',
197    driver   => 'oracle',
198    database => 'test@test',
199    connect_options => { AutoCommit => 1 },
200  );
201
202  my @types = qw(pg pg_with_schema pg_admin mysql mysql_admin
203                 informix informix_admin oracle oracle_admin);
204
205  unless($Rose::DB::Object::Test::NoDefaults)
206  {
207    foreach my $db_type (qw(PG MYSQL INFORMIX ORACLE))
208    {
209      if(my $dsn = $ENV{"RDBO_${db_type}_DSN"})
210      {
211        foreach my $type (grep { /^$db_type(?:_|$)/i } @types)
212        {
213          Rose::DB->modify_db(domain => 'test', type => $type, dsn => $dsn);
214        }
215      }
216
217      if(my $user = $ENV{"RDBO_${db_type}_USER"})
218      {
219        foreach my $type (grep { /^$db_type(?:_|$)/i } @types)
220        {
221          Rose::DB->modify_db(domain => 'test', type => $type, username => $user);
222        }
223      }
224
225      if(my $user = $ENV{"RDBO_${db_type}_PASS"})
226      {
227        foreach my $type (grep { /^$db_type(?:_|$)/i } @types)
228        {
229          Rose::DB->modify_db(domain => 'test', type => $type, password => $user);
230        }
231      }
232    }
233  }
234}
235
236package main;
237
238my %Have_DB;
239
240sub get_db
241{
242  my($type) = shift;
243
244  if((defined $Have_DB{$type} && !$Have_DB{$type}) || !get_dbh($type))
245  {
246    return undef;
247  }
248
249  return Rose::DB->new($type);
250}
251
252sub get_dbh
253{
254  my($type) = shift;
255
256  my $dbh;
257
258  local $@;
259
260  eval
261  {
262    $dbh = Rose::DB->new($type)->retain_dbh()
263      or die Rose::DB->error;
264  };
265
266  if(!$@ && $dbh)
267  {
268    $Have_DB{$type} = 1;
269    return $dbh;
270  }
271
272  return $Have_DB{$type} = 0;
273}
274
275sub have_db
276{
277  my($type) = shift;
278
279  if($type =~ /^sqlite(?:_admin)$/ && $ENV{'RDBO_NO_SQLITE'})
280  {
281    return $Have_DB{$type} = 0;
282  }
283
284  return $Have_DB{$type} = shift if(@_);
285  return $Have_DB{$type}  if(exists $Have_DB{$type});
286  return get_dbh($type) ? 1 : 0;
287}
288
289sub mysql_supports_innodb
290{
291  my $db = get_db('mysql_admin') or return 0;
292
293  eval
294  {
295    my $dbh = $db->dbh;
296
297    CLEAR:
298    {
299      local $dbh->{'RaiseError'} = 0;
300      local $dbh->{'PrintError'} = 0;
301      $dbh->do('DROP TABLE rdbo_innodb_test');
302    }
303
304    $dbh->do(<<"EOF");
305CREATE TABLE rdbo_innodb_test
306(
307  id INTEGER PRIMARY KEY
308)
309ENGINE=InnoDB
310EOF
311
312    # MySQL will silently ignore the "ENGINE=InnoDB" part and create
313    # a MyISAM table instead.  MySQL is evil!  Now we have to manually
314    # check to make sure an InnoDB table was really created.
315    my $db_name = $db->database;
316    my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?");
317    $sth->execute('rdbo_innodb_test');
318    my $info = $sth->fetchrow_hashref;
319
320    no warnings 'uninitialized';
321    unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb')
322    {
323      die "Missing InnoDB support";
324    }
325
326    $dbh->do('DROP TABLE rdbo_innodb_test');
327  };
328
329  if($@)
330  {
331    warn $@  unless($@ =~ /Missing InnoDB support/);
332    return 0;
333  }
334
335  return 1;
336}
337
338our $PG_HAS_CHKPASS = $ENV{'PG_HAS_CHKPASS'};
339
340sub pg_has_chkpass
341{
342  return $PG_HAS_CHKPASS  if(defined $PG_HAS_CHKPASS);
343
344  my $dbh = get_dbh('pg_admin') or return undef;
345
346  eval
347  {
348    local $dbh->{'RaiseError'} = 1;
349    local $dbh->{'PrintError'} = 0;
350    $dbh->do('CREATE TABLE rose_db_object_chkpass_test (pass CHKPASS)');
351    $dbh->do('DROP TABLE rose_db_object_chkpass_test');
352  };
353
354  return $PG_HAS_CHKPASS = $@ ? 0 : 1;
355}
356
357our $PG_MAX_CONNECTIONS;
358
359sub pg_max_connections
360{
361  return $PG_MAX_CONNECTIONS  if(defined $PG_MAX_CONNECTIONS);
362
363  my $dbh = get_dbh('pg') or return 0;
364  my @dbh = ($dbh);
365
366  for(;;)
367  {
368    eval { $dbh = get_dbh('pg') or die; push(@dbh, $dbh) };
369    last if($@ || @dbh > 50);
370  }
371
372  return $PG_MAX_CONNECTIONS = @dbh;
373}
374
375sub oracle_is_broken
376{
377  return undef  unless(have_db('oracle'));
378
379  my $db = get_db('oracle');
380
381  # This particular version of Oracle 10g on Mac OS X is broken
382  return ($db->database_version == 100010300 && $^O =~ /darwin/i) ? 1 : 0;
383}
384
385our $HAVE_TEST_MEMORY_CYCLE;
386
387eval
388{
389  require Test::Memory::Cycle;
390  $HAVE_TEST_MEMORY_CYCLE = 1;
391};
392
393sub test_memory_cycle_ok
394{
395  my($val, $msg) = @_;
396
397  $HAVE_TEST_MEMORY_CYCLE ?
398    Test::Memory::Cycle::memory_cycle_ok($val, $msg) :
399    Test::More::ok(1, "$msg (skipped)");
400}
401
402my %Column_Args =
403(
404  enum => [ values => [ 'a' .. 'z' ] ],
405);
406
407sub nonpersistent_column_definitions
408{
409  my @columns;
410  my $i = 1;
411
412  foreach my $type (Rose::DB::Object::Metadata->column_type_names)
413  {
414    next  if($type =~ /(?:chkpass| to |serial|array|\bset\b)/);
415    push(@columns, 'np' . $i++ => { type => $type, smart_modification => 0,
416         temp => 1, @{ $Column_Args{$type} || [] } });
417  }
418
419  return @columns;
420}
421
422sub modify_nonpersistent_column_values
423{
424  my($object) = shift;
425
426  foreach my $column ($object->meta->nonpersistent_columns)
427  {
428    my $method = $column->mutator_method_name;
429    $object->$method(undef); # with smart modification off, this should be sufficient
430  }
431}
432
433sub add_nonpersistent_columns_and_methods
434{
435  my($class) = shift;
436  my $meta = $class->meta;
437
438  $meta->add_columns(nonpersistent_column_definitions());
439  $meta->make_nonpersistent_column_methods();
440}
441
4421;
443