1#!/usr/bin/perl -w
2
3use strict;
4
5require Test::More;
6
7eval { require Storable };
8
9if($@)
10{
11  Test::More->import(skip_all => 'Could not load Storable');
12}
13else
14{
15  Test::More->import(tests => 1 + (4 * 5));
16}
17
18use Config;
19use FindBin qw($Bin);
20
21require 't/test-lib.pl';
22use_ok('Rose::DB');
23
24my $frozen_file = "$Bin/frozen";
25
26my $Perl = $^X;
27
28if($^O ne 'VMS')
29{
30  $Perl .= $Config{'_exe'}  unless($Perl =~ /$Config{'_exe'}$/i);
31}
32
33my($db, @Cleanup);
34
35foreach my $db_type (qw(pg mysql informix sqlite oracle))
36{
37  $db = get_db($db_type);
38
39  unless($db)
40  {
41    SKIP: { skip("Could not connect to $db_type", 4) }
42    next;
43  }
44
45  CLEAR:
46  {
47    my $dbh = $db->dbh;
48    local $dbh->{'RaiseError'} = 0;
49    local $dbh->{'PrintError'} = 0;
50    $dbh->do('DROP TABLE rose_db_storable_test');
51  }
52
53  $db->dbh->do('CREATE TABLE rose_db_storable_test (i INT)');
54
55  CLEANUP:
56  {
57    my $dbh = $db->dbh;
58    push(@Cleanup, sub { $dbh->do('DROP TABLE rose_db_storable_test') });
59  }
60
61  my $frozen = Storable::freeze($db);
62
63  Storable::nstore($db, $frozen_file);
64
65  my $thawed = Storable::thaw($frozen);
66
67  ok(!defined $thawed->{'dbh'}, "check dbh - $db_type");
68
69  if(!defined $db->password)
70  {
71    ok(!defined $thawed->{'password'}, "check password - $db_type");
72    ok(!defined $thawed->{'password_closure'}, "check password closure - $db_type");
73  }
74  else
75  {
76    ok(!defined $thawed->{'password'}, "check password - $db_type");
77    ok(ref $thawed->{'password_closure'}, "check password closure - $db_type");
78  }
79
80  $thawed->dbh->do('DROP TABLE rose_db_storable_test');
81  pop(@Cleanup);
82
83  # Disconnect to flush SQLite memory buffers
84  if($db_type eq 'sqlite')
85  {
86    $thawed->disconnect;
87    $db->disconnect;
88  }
89
90  $db->dbh->do('CREATE TABLE rose_db_storable_test (i INT)');
91
92  CLEANUP:
93  {
94    my $dbh = $db->dbh;
95    push(@Cleanup, sub
96    {
97      $dbh->{'RaiseError'} = 0;
98      $dbh->{'PrintError'} = 0;
99      $dbh->do('DROP TABLE rose_db_storable_test');
100    });
101  }
102
103  my($ok, $script_fh);
104
105  # Perl 5.8.x and later support the FILEHANDLE,MODE,EXPR,LIST form of
106  # open, but not (apparently) on Windows
107  if($Config{'version'} =~ /^5\.([89]|10)\./ && $^O !~ /Win32/i)
108  {
109    $ok = open($script_fh, '-|', $Perl, 't/storable.ext', $db_type);
110  }
111  else
112  {
113    $ok = open($script_fh, "$Perl t/storable.ext $db_type |");
114  }
115
116  if($ok)
117  {
118    chomp(my $line = <$script_fh>);
119    close($script_fh);
120    is($line, 'dropped', "external test - $db_type");
121    pop(@Cleanup)  if($line eq 'dropped');
122  }
123  else
124  {
125    ok(0, "Failed to open external script for $db_type - $!");
126  }
127}
128
129END
130{
131  unlink($frozen_file); # ignore errors
132
133  foreach my $code (@Cleanup)
134  {
135    $code->();
136  }
137}
138