From: rkinyon Date: Sun, 18 Feb 2007 10:40:50 +0000 (+0000) Subject: Further work done and a test for utils/upgrade_db.pl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=646027ff12a308a4fb7a721f124c1a4456d3d81a;p=dbsrgits%2FDBM-Deep.git Further work done and a test for utils/upgrade_db.pl --- diff --git a/t/06_error.t b/t/06_error.t index 47b5c92..c8775e8 100644 --- a/t/06_error.t +++ b/t/06_error.t @@ -10,9 +10,7 @@ use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); -## # test a corrupted file -## { my ($fh, $filename) = new_fh(); @@ -128,12 +126,12 @@ use_ok( 'DBM::Deep' ); { throws_ok { - DBM::Deep->new( 't/old_versions/db-0-983' ); + DBM::Deep->new( 't/etc/db-0-983' ); } qr/DBM::Deep: Pre-1.00 file version found/, "Fail if opening a pre-1.00 file"; } { throws_ok { - DBM::Deep->new( 't/old_versions/db-0-99_04' ); + DBM::Deep->new( 't/etc/db-0-99_04' ); } qr/DBM::Deep: Wrong file version found - 1 - expected 2/, "Fail if opening a file version 1"; } diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t new file mode 100644 index 0000000..f02529d --- /dev/null +++ b/t/44_upgrade_db.t @@ -0,0 +1,67 @@ +$|++; +use strict; +use Test::More; + +# Add skips here +BEGIN { + eval { use Pod::Usage }; + if ( $@ ) { + plan skip_all => "Pod::Usage must be installed to run these tests"; + } +} + +plan tests => 6; + +use t::common qw( new_fh ); +use File::Spec; + +my $PROG = File::Spec->catfile( qw( utils upgrade_db.pl ) ); + +my $short = get_pod( $PROG, 0 ); +my $long = get_pod( $PROG, 1 ); + +is( run_prog( $PROG ), "Missing required parameters.\n$long", "Failed no params" ); +is( run_prog( $PROG, '-input foo' ), "Missing required parameters.\n$long", "Failed only -input" ); +is( run_prog( $PROG, '-output foo' ), "Missing required parameters.\n$long", "Failed only -output" ); +is( + run_prog( $PROG, '-input foo', '-output foo' ), + "Cannot use the same filename for both input and output.\n$short", + "Failed same name", +); + +is( + run_prog( $PROG, '-input foo', '-output bar' ), + "'foo' is not a file.\n$short", + "Failed input does not exist", +); + +my (undef, $input_filename) = new_fh(); +my (undef, $output_filename) = new_fh(); + +is( + run_prog( $PROG, "-input $input_filename", "-output $output_filename" ), + "'$input_filename' is not a DBM::Deep file.\n$short", + "Input is not a DBM::Deep file", +); + +################################################################################ + +sub run_prog { + #print "Launching '@_'\n"; + #XXX This needs to be made OS-portable + open( my $fh, '-|', "@_ 2>&1" ) or die "Cannot launch '@_': $!\n"; + return join '', <$fh>; +} + +sub get_pod { + my ($p,$v) = @_; + #XXX This needs retro'ed to 5.6.0 + open( my $fh, '>', \my $pod ) or die "Cannot open in-memory filehandle: $!\n"; + pod2usage({ + -input => $p, + -output => $fh, + -verbose => $v, + -exitval => 'NOEXIT', + }); + return $pod; +} diff --git a/t/common.pm b/t/common.pm index 3b4958c..2348cb9 100644 --- a/t/common.pm +++ b/t/common.pm @@ -27,7 +27,7 @@ sub new_fh { return ($fh, $filename); } -#END{<>} + 1; __END__ diff --git a/t/old_versions/db-0-983 b/t/etc/db-0-983 similarity index 100% rename from t/old_versions/db-0-983 rename to t/etc/db-0-983 diff --git a/t/old_versions/db-0-99_04 b/t/etc/db-0-99_04 similarity index 100% rename from t/old_versions/db-0-99_04 rename to t/etc/db-0-99_04 diff --git a/t/old_versions/db-1-0000 b/t/etc/db-1-0000 similarity index 100% rename from t/old_versions/db-1-0000 rename to t/etc/db-1-0000 diff --git a/utils/upgrade_db.pl b/utils/upgrade_db.pl index 5133bda..1a37be0 100755 --- a/utils/upgrade_db.pl +++ b/utils/upgrade_db.pl @@ -37,17 +37,15 @@ GetOptions( \%opts, pod2usage(1) if $opts{help}; pod2usage(-exitstatus => 0, -verbose => 2) if $opts{man}; -pod2usage(-msg => "Missing required parameters", verbose => 1) +pod2usage(-msg => "Missing required parameters.", verbose => 1) unless $opts{input} && $opts{output}; if ( $opts{input} eq $opts{output} ) { _exit( "Cannot use the same filename for both input and output." ); } -foreach my $p ( qw( input output ) ) { - unless ( -f $opts{$p} ) { - _exit( "'$opts{$p}' is not a file." ); - } +unless ( -f $opts{input} ) { + _exit( "'$opts{input}' is not a file." ); } my %db; @@ -116,7 +114,7 @@ sub _read_file_header { _exit( "'$file' is not a DBM::Deep file." ) unless $file_sig eq 'DPDB'; - # SIG_HEADER == 'h' + # SIG_HEADER == 'h' - this means that this is a pre-1.0 file return 0 unless ($header_sig eq 'h'); return $header_ver;