view release on metacpan or  search on metacpan

t/00-pod/cookbook-examples.t  view on Meta::CPAN

use strict;
use warnings;
use Test::Lib;
use Test::Async::Redis qw(run await_f skip_without_redis cleanup_keys redis_host redis_port with_timeout);
use Test2::V0;
use Future::AsyncAwait;
use Async::Redis;

my $cookbook = 'lib/Async/Redis/Cookbook.pod';
my @examples = _extract_cookbook_examples($cookbook);

my $janitor = skip_without_redis();
ok(@examples, 'found cookbook examples');
run { cleanup_keys($janitor, 'cookbook:*') };

for my $example (@examples) {
    subtest $example->{name} => sub {
        my $redis = Async::Redis->new(
            host            => redis_host(),
            port            => redis_port(),
            connect_timeout => 2,
        );

        my $runner = _compile_example($example);
        my $prefix = "cookbook:$example->{name}:$$";

        my $error;
        eval {
            await_f((async sub {
                await $redis->connect;
                await with_timeout(
                    8,
                    $runner->($redis, redis_host(), redis_port(), $prefix),
                );
            })->());
            1;
        } or $error = $@;

        $redis->disconnect;

        ok(!$error, 'example ran without dying')
            or diag("$error\n\nExample source:\n$example->{code}");
    };
}

run { cleanup_keys($janitor, 'cookbook:*') };

done_testing;

sub _extract_cookbook_examples {
    my ($path) = @_;

    open my $fh, '<', $path or die "open $path: $!";

    my @examples;
    my %seen;
    my $current;

    while (my $line = <$fh>) {
        if ($line =~ /^=for\s+cookbook-test\s+(\S+)\s*$/) {
            die "nested cookbook-test marker at $. in $path" if $current;
            die "duplicate cookbook-test name '$1'" if $seen{$1}++;
            $current = {
                name       => $1,
                start_line => $.,
                lines      => [],
            };
            next;
        }