The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;
use Test::More;
use Test::Exception;
use IO::Scalar;

BEGIN {
    eval 'use Scalar::Util qw/looks_like_number/';
    plan skip_all => 'Scalar::Util required' if $@;

    plan tests => 24;
}

BEGIN {
	use_ok( 'Crypt::GpgME' );
}

delete $ENV{GPG_AGENT_INFO};
$ENV{GNUPGHOME} = 't/gpg';

my $ctx;
lives_ok (sub {
        $ctx = Crypt::GpgME->new;
}, 'create new context');

isa_ok ($ctx, 'Crypt::GpgME');

my $plain = IO::Scalar->new(\q/test test test/);

$ctx->set_passphrase_cb(sub { return 'abc' });

my $called = 0;

sub progress_cb {
    return if $called;

    is (@_, 5, 'cb got 5 params');

    my ($c, $what, $type, $current, $total) = @_;

    isa_ok ($c, 'Crypt::GpgME');
    ok($c == $ctx, 'context references are equal');
    ok ($what, 'what looks sane');
    like ($type, qr/^.$/, 'type looks sane'); #FIXME: what chars are valid?
    ok (looks_like_number($current), 'current looks sane');
    ok (looks_like_number($total), 'total looks sane');

    ++$called;
}

lives_ok (sub {
        $ctx->set_progress_cb(\&progress_cb);
}, 'setting progress cb without user data');

is ($called, 0, 'just setting the cb doesn\'t call it');

$ctx->sign($plain, 'clear');

ok ($called > 0, 'signing calls the cb');

$called = 0;

sub progress_cb_ud {
    return if $called;

    is (@_, 6, 'cb got 6 params');

    my ($c, $what, $type, $current, $total, $user_data) = @_;

    isa_ok ($c, 'Crypt::GpgME');
    ok($c == $ctx, 'context references are equal');
    ok ($what, 'what looks sane');
    like ($type, qr/^.$/, 'type looks sane'); #FIXME: what chars are valid?
    ok (looks_like_number($current), 'current looks sane');
    ok (looks_like_number($total), 'total looks sane');
    is ($user_data, 'foo', 'user data looks sane');

    ++$called;
}

lives_ok (sub {
        $ctx->set_progress_cb(\&progress_cb_ud, 'foo');
}, 'setting progress cb with user data');

is ($called, 0, 'just setting the cb doesn\'t call it');

eval {
    $ctx->sign($plain, 'clear');
};

ok ($called > 0, 'signing calls the cb');