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 (file)
--- 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 (file)
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 (file)
--- 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 (executable)
--- 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;