The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 07-thread.t'

#########################

use strict;
use warnings;
use Config;
use Test::More;
use ExtUtils::testlib;
use Crypt::GCrypt;

#########################

my @algos = qw(aes twofish blowfish arcfour cast5 des serpent seed);
my @available_algos;

if ($Config{useithreads} && eval "use threads; use Thread::Queue; 1") {
  # test as many algorithms as we have.
  @available_algos = grep Crypt::GCrypt::cipher_algo_available($_), @algos;
  plan tests => 3 * @available_algos;

} else {
  plan skip_all => "Skipping because your perl is not compiled with thread support";
}

my $str = 'Four Score and Seven years ago, our fore-monkeys created a great blah blah blah';
my $key = 'monkeymonkeymonkey';

sub nonthreadtest {
  my $algo = shift;
  my $enc = Crypt::GCrypt->new(
                               type => 'cipher',
                               algorithm => $algo,
                               #mode => 'cbc',
                               #padding => 'null'
                              );
  $enc->start('encrypting');
  $enc->setkey($key);

  my $dec = Crypt::GCrypt->new(
                               type => 'cipher',
                               algorithm => $algo,
                               #mode => 'cbc',
                               #padding => 'null'
                              );
  $dec->start('decrypting');
  $dec->setkey($key);

  my $out = '';

  my $buf = $enc->encrypt($str);
  $out .= $dec->decrypt($buf) if (length($buf)); # should we need to test this length() ?
  $buf = $enc->finish();
  $out .= $dec->decrypt($buf) if (length($buf)); # should we need to test this length() ?
  $out .= $dec->finish();

  warn sprintf("Non-threaded: Failed to match output with algorithm '%s'\n", $algo) if ($str ne $out);
  return ($str eq $out);
}


sub producer_thread {
  my $q = shift;
  my $algo = shift;
  my $enc = Crypt::GCrypt->new(
                               type => 'cipher',
                               algorithm => $algo,
                               #mode => 'cbc',
                               #padding => 'null'
                              );
  $enc->start('encrypting');
  $enc->setkey($key);
  $q->enqueue($enc->encrypt($str));
  $q->enqueue($enc->finish());
  $q->enqueue(undef);
  return 1;
}

sub consumer_thread {
  my $q = shift;
  my $algo = shift;
  my $dec = Crypt::GCrypt->new(
                               type => 'cipher',
                               algorithm => $algo,
                               #mode => 'cbc',
                               #padding => 'null'
                              );
  $dec->start('decrypting');
  $dec->setkey($key);
  my $buf;
  my $out = '';
  do {
    $buf = $q->dequeue();
    $out .= $dec->decrypt($buf) if (defined $buf);
  } while (defined $buf);
  $out .= $dec->finish();
  warn sprintf("Threaded: failed to match output with algorithm '%s'\n".
         "Wanted: %s\n   Got: %s\n", $algo, unpack('H*', $str),
         unpack('H*', $out)) if ($str ne $out);
  return $str eq $out;
}


sub testalgo {
  my $algo = shift;

  ok(nonthreadtest($algo));

  my $queue = Thread::Queue->new();

  # create in scalar context so that the result is the returned scalar:
  my $con = threads->create('consumer_thread', $queue, $algo);
  my $pro = threads->create('producer_thread', $queue, $algo);
}


testalgo($_) for @available_algos;
ok($_->join()) for threads->list();