t/09_output_record_sep.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 BEGIN {
   5         $|  = 1;
   6         $^W = 1;
   7 }
   8
   9 use Test::More tests => 6;
  10 use File::Spec       ();
  11 use File::Spec::Unix ();
  12 use Archive::Zip     qw( :ERROR_CODES );
  13
  14 my $expected_fn = File::Spec->catfile(
  15     File::Spec->curdir, "t", "badjpeg", "expected.jpg"
  16 );
  17 my $expected_zip = File::Spec::Unix->catfile(
  18     File::Spec::Unix->curdir, "t", "badjpeg", "expected.jpg",
  19 );
  20
  21 my $got_fn = "got.jpg";
  22 my $archive_fn = "out.zip";
  23 my ( $before, $after );
  24 sub slurp_file {
  25         my $filename = shift;
  26         open my $fh, "<$filename"
  27         or die 'Can not open file';
  28         my $contents;
  29         binmode( $fh );
  30         SCOPE: {
  31                 local $/;
  32                 $contents = <$fh>;
  33         }
  34         close $fh;
  35         return $contents;
  36 }
  37
  38 sub binary_is {
  39     my ($got, $expected, $msg) = @_;
  40     local $Test::Builder::Level = $Test::Builder::Level+1;
  41     my $verdict = ($got eq $expected);
  42     ok ($verdict, $msg);
  43     if (!$verdict) {
  44         my $len;
  45         if (length($got) > length($expected)) {
  46             $len = length($expected);
  47             diag("got is longer than expected");
  48         } elsif (length($got) < length($expected)) {
  49             $len = length($got);
  50             diag("expected is longer than got");
  51         } else {
  52             $len = length($got);
  53         }
  54
  55         BYTE_LOOP:
  56         for my $byte_idx (0 .. ($len-1)) {
  57             my $got_byte      = substr($got, $byte_idx, 1);
  58             my $expected_byte = substr($expected, $byte_idx, 1);
  59             if ($got_byte ne $expected_byte) {
  60                 diag(
  61                     sprintf(
  62                         "Byte %i differ: got == 0x%.2x, expected == 0x%.2x",
  63                         $byte_idx, ord($got_byte), ord($expected_byte)
  64                     )
  65                 );
  66                 last BYTE_LOOP;
  67             }
  68         }
  69     }
  70 }
  71
  72 sub run_tests {
  73     my $id = shift;
  74     my $msg_it = sub {
  75         my $msg_raw = shift;
  76         return "$id - $msg_raw";
  77     };
  78
  79     # Read the contents of the good file into the variable.
  80     $before = slurp_file($expected_fn);
  81
  82     # Zip the file.
  83     SCOPE: {
  84         my $zip = Archive::Zip->new();
  85         $zip->addFile( $expected_fn );
  86         $zip->extractMember( $expected_zip, $got_fn );
  87         $after = slurp_file($got_fn);
  88
  89         unlink $got_fn;
  90
  91         # TEST:$n=$n+1
  92         binary_is(
  93             $after, $before,
  94             $msg_it->("Content of file after extraction"),
  95         );
  96
  97         my $status = $zip->writeToFileNamed( $archive_fn );
  98         # TEST:$n=$n+1
  99         cmp_ok( $status, '==', AZ_OK, $msg_it->('Zip was written fine') );
 100     }
 101
 102     # Read back the file from the archive.
 103     SCOPE: {
 104         my $zip2;
 105         $zip2 = Archive::Zip->new( $archive_fn );
 106
 107         $zip2->extractMember( $expected_zip, $got_fn );
 108
 109         $after = slurp_file( $got_fn );
 110
 111         unlink $got_fn;
 112         unlink $archive_fn;
 113
 114         # TEST:$n=$n+1
 115         binary_is(
 116             $after, $before,
 117             $msg_it->('Read back the file from the archive'),
 118         );
 119     }
 120 }
 121
 122 # Run the tests once with $\ undef.
 123 run_tests("Normal");
 124
 125 # Run them once while setting $\.
 126 SCOPE: {
 127     local $\ = "\n";
 128     run_tests(q{$\ is \n});
 129 }