#!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');