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