#!/usr/bin/perl -w use strict; require Test::More; eval { require Storable }; if($@) { Test::More->import(skip_all => 'Could not load Storable'); } else { Test::More->import(tests => 1 + (4 * 5)); } use Config; use FindBin qw($Bin); require 't/test-lib.pl'; use_ok('Rose::DB'); my $frozen_file = "$Bin/frozen"; my $Perl = $^X; if($^O ne 'VMS') { $Perl .= $Config{'_exe'} unless($Perl =~ /$Config{'_exe'}$/i); } my($db, @Cleanup); foreach my $db_type (qw(pg mysql informix sqlite oracle)) { $db = get_db($db_type); unless($db) { SKIP: { skip("Could not connect to $db_type", 4) } next; } CLEAR: { my $dbh = $db->dbh; local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_storable_test'); } $db->dbh->do('CREATE TABLE rose_db_storable_test (i INT)'); CLEANUP: { my $dbh = $db->dbh; push(@Cleanup, sub { $dbh->do('DROP TABLE rose_db_storable_test') }); } my $frozen = Storable::freeze($db); Storable::nstore($db, $frozen_file); my $thawed = Storable::thaw($frozen); ok(!defined $thawed->{'dbh'}, "check dbh - $db_type"); if(!defined $db->password) { ok(!defined $thawed->{'password'}, "check password - $db_type"); ok(!defined $thawed->{'password_closure'}, "check password closure - $db_type"); } else { ok(!defined $thawed->{'password'}, "check password - $db_type"); ok(ref $thawed->{'password_closure'}, "check password closure - $db_type"); } $thawed->dbh->do('DROP TABLE rose_db_storable_test'); pop(@Cleanup); # Disconnect to flush SQLite memory buffers if($db_type eq 'sqlite') { $thawed->disconnect; $db->disconnect; } $db->dbh->do('CREATE TABLE rose_db_storable_test (i INT)'); CLEANUP: { my $dbh = $db->dbh; push(@Cleanup, sub { $dbh->{'RaiseError'} = 0; $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_storable_test'); }); } my($ok, $script_fh); # Perl 5.8.x and later support the FILEHANDLE,MODE,EXPR,LIST form of # open, but not (apparently) on Windows if($Config{'version'} =~ /^5\.([89]|10)\./ && $^O !~ /Win32/i) { $ok = open($script_fh, '-|', $Perl, 't/storable.ext', $db_type); } else { $ok = open($script_fh, "$Perl t/storable.ext $db_type |"); } if($ok) { chomp(my $line = <$script_fh>); close($script_fh); is($line, 'dropped', "external test - $db_type"); pop(@Cleanup) if($line eq 'dropped'); } else { ok(0, "Failed to open external script for $db_type - $!"); } } END { unlink($frozen_file); # ignore errors foreach my $code (@Cleanup) { $code->(); } }