f72ef701ce01f08e40bc17668f9d923b1538e5e0
[dbsrgits/DBM-Deep.git] / t / 44_upgrade_db.t
1 $|++;
2 use strict;
3 use Test::More;
4
5 # Add skips here
6 BEGIN {
7     my @failures;
8     eval { use Pod::Usage; }; push @failures, 'Pod::Usage' if $@;
9     eval { use IO::Scalar; }; push @failures, 'IO::Scalar' if $@;
10     if ( @failures ) {
11         my $missing = join ',', @failures;
12         plan skip_all => "'$missing' must be installed to run these tests";
13     }
14 }
15
16 plan tests => 222;
17
18 use t::common qw( new_fh );
19 use File::Spec;
20 use Test::Deep;
21
22 my $PROG = File::Spec->catfile( qw( utils upgrade_db.pl ) );
23
24 my $short = get_pod( $PROG, 0 );
25 my $long = get_pod( $PROG, 1 );
26
27 is( run_prog( $PROG ), "Missing required parameters.\n$long", "Failed no params" );
28 is( run_prog( $PROG, '-input foo' ), "Missing required parameters.\n$long", "Failed only -input" );
29 is( run_prog( $PROG, '-output foo' ), "Missing required parameters.\n$long", "Failed only -output" );
30 is(
31     run_prog( $PROG, '-input foo', '-output foo' ),
32     "Cannot use the same filename for both input and output.\n$short",
33     "Failed same name",
34 );
35
36 is(
37     run_prog( $PROG, '-input foo', '-output bar' ),
38     "'foo' is not a file.\n$short",
39     "Failed input does not exist",
40 );
41
42 my (undef, $input_filename) = new_fh();
43 my (undef, $output_filename) = new_fh();
44
45 is(
46     run_prog( $PROG, "-input $input_filename", "-output $output_filename" ),
47     "'$input_filename' is not a DBM::Deep file.\n$short",
48     "Input is not a DBM::Deep file",
49 );
50
51 # All files are of the form:
52 #   $db->{foo} = [ 1 .. 3 ];
53
54 my @input_files = (
55     '0-983',
56     '0-99_04',
57     '1-0000',
58     '1-0003',
59 );
60
61 my @output_versions = (
62     '0.91', '0.92', '0.93', '0.94', '0.95', '0.96', '0.97', '0.98',
63     '0.981', '0.982', '0.983',
64     '0.99_01', '0.99_02', '0.99_03', '0.99_04',
65     '1.00', '1.000', '1.0000', '1.0001', '1.0002',
66     '1.0003', '1.0004', '1.0005', '1.0006',
67 );
68
69 foreach my $input_filename (
70     map { 
71         File::Spec->catfile( qw( t etc ), "db-$_" )
72     } @input_files
73 ) {
74     # chmod it writable because old DBM::Deep versions don't handle readonly
75     # files correctly. This is fixed in DBM::Deep 1.0000
76     chmod 0600, $input_filename;
77
78     foreach my $v ( @output_versions ) {
79         my (undef, $output_filename) = new_fh();
80         my $output = run_prog(
81             $PROG,
82             "-input $input_filename",
83             "-output $output_filename",
84             "-version $v",
85         );
86
87         # Clone was removed as a requirement in 1.0006
88         if ( $output =~ /Can\'t locate Clone\.pm in \@INC/ ) {
89             ok( 1 );
90             unless ( $input_filename =~ /_/ || $v =~ /_/ ) {
91                 ok( 1 ); ok( 1 );
92             }
93             next;
94         }
95
96         if ( $input_filename =~ /_/ ) {
97             is(
98                 $output, "'$input_filename' is a dev release and not supported.\n$short",
99                 "Input file is a dev release - not supported",
100             );
101
102             next;
103         }
104
105         if ( $v =~ /_/ ) {
106             is(
107                 $output, "-version '$v' is a dev release and not supported.\n$short",
108                 "Output version is a dev release - not supported",
109             );
110
111             next;
112         }
113
114         # Now, read the output file with the right version.
115         ok( !$output, "A successful run produces no output" );
116         die "$output\n" if $output;
117
118         my $db;
119         if ( $v =~ /^0/ ) {
120             push @INC, File::Spec->catdir( 'utils', 'lib' );
121             eval "use DBM::Deep::09830";
122             $db = DBM::Deep::09830->new( $output_filename );
123         }
124         elsif ( $v =~ /^1\.000?[0-2]?/ ) {
125             push @INC, File::Spec->catdir( 'utils', 'lib' );
126             eval "use DBM::Deep::10002";
127             $db = DBM::Deep::10002->new( $output_filename );
128         }
129         elsif ( $v =~ /^1\.000[3-6]/ ) {
130             push @INC, 'lib';
131             eval "use DBM::Deep";
132             $db = DBM::Deep->new( $output_filename );
133         }
134         else {
135             die "How did we get here?!\n";
136         }
137
138         ok( $db, "Writing to version $v made a file" );
139
140         cmp_deeply(
141             $db->export,
142             { foo => [ 1 .. 3 ] },
143             "We can read the output file",
144         );
145     }
146 }
147
148 ################################################################################
149
150 #XXX This needs to be made OS-portable
151 sub run_prog {
152     open( my $fh, '-|', "$^X @_ 2>&1" )
153       or die "Cannot launch '@_' as a piped filehandle: $!\n";
154     return join '', <$fh>;
155 }
156
157 # In 5.8, we could use in-memory filehandles and have done:
158 #     open( my $fh, '>', \my $pod ) or die "Cannot open in-memory filehandle: $!\n";
159 #     ...
160 #     return $pod;
161 # However, DBM::Deep requires 5.6, so this set of contortions will have to do.
162 sub get_pod {
163     my ($p,$v) = @_;
164
165     my ($fh, $fn) = new_fh();
166     close $fh;
167
168     open $fh, '>', $fn;
169     pod2usage({
170         -input   => $p,
171         -output  => $fh,
172         -verbose => $v,
173         -exitval => 'NOEXIT',
174     });
175     close $fh;
176
177     open $fh, '<', $fn;
178     return join '', <$fh>;
179 }