Dogcows Code - chaz/p5-File-KDBX/blob - t/hash-block.t

   1 #!/usr/bin/env perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use lib 't/lib';
   7 use TestCommon qw(:no_warnings_test);
   8
   9 use File::KDBX::Util qw(can_fork);
  10 use IO::Handle;
  11 use Test::More;
  12
  13 BEGIN { use_ok 'PerlIO::via::File::KDBX::HashBlock' }
  14
  15 {
  16     my $expected_plaintext = 'Tiny food from Spain!';
  17
  18     pipe(my $read, my $write) or die "pipe failed: $!\n";
  19
  20     PerlIO::via::File::KDBX::HashBlock->push($write, block_size => 3);
  21     print $write $expected_plaintext;
  22     binmode($write, ':pop');    # finish stream
  23     close($write) or die "close failed: $!";
  24
  25     PerlIO::via::File::KDBX::HashBlock->push($read);
  26     my $plaintext = do { local $/; <$read> };
  27     close($read);
  28
  29     is $plaintext, $expected_plaintext, 'Hash-block just a little bit';
  30 }
  31
  32 subtest 'Error handling' => sub {
  33     pipe(my $read, my $write) or die "pipe failed: $!\n";
  34
  35     PerlIO::via::File::KDBX::HashBlock->push($read);
  36
  37     print $write 'blah blah blah';
  38     close($write) or die "close failed: $!";
  39
  40     is $read->error, 0, 'Read handle starts out fine';
  41     my $data = do { local $/; <$read> };
  42     is $read->error, 1, 'Read handle can enter and error state';
  43
  44     like $PerlIO::via::File::KDBX::HashBlock::ERROR, qr/invalid block index/i,
  45         'Error object is available';
  46 };
  47
  48 SKIP: {
  49     skip 'Tests require fork' if !can_fork;
  50
  51     my $expected_plaintext = "\x64" x (1024*1024*12 - 57);
  52
  53     pipe(my $read, my $write) or die "pipe failed: $!\n";
  54
  55     defined(my $pid = fork) or die "fork failed: $!\n";
  56     if ($pid == 0) {
  57         PerlIO::via::File::KDBX::HashBlock->push($write);
  58         print $write $expected_plaintext;
  59         binmode($write, ':pop');    # finish stream
  60         close($write) or die "close failed: $!";
  61         exit;
  62     }
  63
  64     PerlIO::via::File::KDBX::HashBlock->push($read);
  65     my $plaintext = do { local $/; <$read> };
  66     close($read);
  67
  68     is $plaintext, $expected_plaintext, 'Hash-block a lot';
  69
  70     waitpid($pid, 0) or die "wait failed: $!\n";
  71 }
  72
  73 done_testing;