5 plan skip_all => "upgrade_db.pl doesn't actually do anything correct.";
9 plan skip_all => "Skipping the upgrade_db.pl tests on Win32/cygwin for now."
10 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
12 plan skip_all => "Skipping the upgrade_db.pl tests on *bsd for now."
16 eval "use Pod::Usage 1.3;"; push @failures, 'Pod::Usage' if $@;
17 eval "use IO::Scalar;"; push @failures, 'IO::Scalar' if $@;
18 eval "use FileHandle::Fmode;"; push @failures, 'FileHandle::Fmode' if $@;
20 my $missing = join ',', @failures;
21 plan skip_all => "'$missing' must be installed to run these tests";
27 use t::common qw( new_fh );
31 my $PROG = File::Spec->catfile( qw( utils upgrade_db.pl ) );
33 my $short = get_pod( $PROG, 0 );
34 my $long = get_pod( $PROG, 1 );
36 is( run_prog( $PROG ), "Missing required parameters.\n$long", "Failed no params" );
37 is( run_prog( $PROG, '-input foo' ), "Missing required parameters.\n$long", "Failed only -input" );
38 is( run_prog( $PROG, '-output foo' ), "Missing required parameters.\n$long", "Failed only -output" );
40 run_prog( $PROG, '-input foo', '-output foo' ),
41 "Cannot use the same filename for both input and output.\n$short",
46 run_prog( $PROG, '-input foo', '-output bar' ),
47 "'foo' is not a file.\n$short",
48 "Failed input does not exist",
51 my (undef, $input_filename) = new_fh();
52 my (undef, $output_filename) = new_fh();
55 run_prog( $PROG, "-input $input_filename", "-output $output_filename" ),
56 "'$input_filename' is not a DBM::Deep file.\n$short",
57 "Input is not a DBM::Deep file",
60 unlink $input_filename;unlink $output_filename;
62 # All files are of the form:
63 # $db->{foo} = [ 1 .. 3 ];
72 my @output_versions = (
73 '0.91', '0.92', '0.93', '0.94', '0.95', '0.96', '0.97', '0.98',
74 '0.981', '0.982', '0.983',
75 '0.99_01', '0.99_02', '0.99_03', '0.99_04',
76 '1.00', '1.000', '1.0000', '1.0001', '1.0002',
77 '1.0003', '1.0004', '1.0005', '1.0006', '1.0007', '1.0008', '1.0009', '1.0010',
78 '1.0011', '1.0012', '1.0013', '1.0014',
81 foreach my $input_filename (
83 File::Spec->catfile( qw( t etc ), "db-$_" )
86 # chmod it writable because old DBM::Deep versions don't handle readonly
87 # files correctly. This is fixed in DBM::Deep 1.0000
88 chmod 0600, $input_filename;
90 foreach my $v ( @output_versions ) {
91 my (undef, $output_filename) = new_fh();
93 my $output = run_prog(
95 "-input $input_filename",
96 "-output $output_filename",
100 #warn "Testing $input_filename against $v\n";
102 # Clone was removed as a requirement in 1.0006
103 if ( $output =~ /Can\'t locate Clone\.pm in \@INC/ ) {
105 unless ( $input_filename =~ /_/ || $v =~ /_/ ) {
111 if ( $input_filename =~ /_/ ) {
113 $output, "'$input_filename' is a dev release and not supported.\n$short",
114 "Input file is a dev release - not supported",
122 $output, "-version '$v' is a dev release and not supported.\n$short",
123 "Output version is a dev release - not supported",
129 # Now, read the output file with the right version.
130 ok( !$output, "A successful run produces no output" );
131 die "'$input_filename' -> '$v' : $output\n" if $output;
134 if ( $v =~ /^1\.001[0-4]/ || $v =~ /^1\.000[3-9]/ ) {
136 eval "use DBM::Deep $v"; die $@ if $@;
137 $db = DBM::Deep->new( $output_filename );
139 elsif ( $v =~ /^1\.000?[0-2]?/ ) {
140 push @INC, File::Spec->catdir( 'utils', 'lib' );
141 eval "use DBM::Deep::10002";
142 $db = DBM::Deep::10002->new( $output_filename );
144 elsif ( $v =~ /^0/ ) {
145 push @INC, File::Spec->catdir( 'utils', 'lib' );
146 eval "use DBM::Deep::09830";
147 $db = DBM::Deep::09830->new( $output_filename );
150 die "How did we get here?!\n";
153 ok( $db, "Writing to version $v made a file" );
157 { foo => [ 1 .. 3 ] },
158 "We can read the output file",
163 ################################################################################
165 #XXX This needs to be made OS-portable
167 open( my $fh, '-|', "$^X @_ 2>&1" )
168 or die "Cannot launch '@_' as a piped filehandle: $!\n";
169 return join '', <$fh>;
172 # In 5.8, we could use in-memory filehandles and have done:
173 # open( my $fh, '>', \my $pod ) or die "Cannot open in-memory filehandle: $!\n";
176 # However, DBM::Deep requires 5.6, so this set of contortions will have to do.
180 my ($fh, $fn) = new_fh();
188 -exitval => 'NOEXIT',
193 return join '', <$fh>;