Create tests for example queries in DDG::Goodie::* with no tests

create_missing_goodie_tests.pl

#!/usr/bin/env perl

use strict;
use warnings;
use v5.19.6;

use Class::Load ':all';
use Path::Tiny;
use PPI;
use List::AllUtils qw/first_index/;
use DDP;

{
    binmode STDOUT, ":utf8";
    my @libs = libs();

    load_class($_) for @libs;
    
    foreach my $lib (sort @libs) {
        alarm 0;  # I have no idea why this is necessary but it is
        my $test_file       = test_file($lib);
        my @example_queries = find_example_queries($lib);
        my @missing_queries = find_missing_queries(\@example_queries, $test_file);
        create_missing_tests(\@missing_queries, $test_file);
    }

    exit;
}

sub test_file {
    my $lib           = shift;
    my $dir           = path("t");
    my @filenames     = split(/::/, $lib);
    my $test_filename = $filenames[-1] . ".t";
    return $dir->child($test_filename);
}

sub find_missing_queries {
    my ($expected_queries, $file) = @_;

    return () unless -r $file;

    my $src = $file->slurp_utf8;
    my $doc = PPI::Document->new(\$src) || return;
    my $statements = $doc->find('Statement');

    foreach my $statement (@$statements) {
        next unless $statement->content =~ /ddg_.*_test/;

        my @tokens = $statement->tokens;

        my $token = shift @tokens;
        shift_until(\@tokens, 'DDG::Goodie::');
        shift_until(\@tokens, ']');
        shift_until(\@tokens, ',');

        while (@tokens) {
            my $previous_token = shift_until(\@tokens, 'test_zci');
            last unless @tokens;

            $previous_token =~ s/^['"](.*)['"]$/$1/; # rm single and double quotes
            
            # delete $previous_token from @expected_queries
            my $i = first_index { $previous_token eq $_ } @$expected_queries;
            splice(@$expected_queries, $i, 1) unless $i == -1; 
        }
    }

    return @$expected_queries;
}

sub shift_until {
    my $tokens = shift;
    my $regex  = shift;

    my $token = shift @$tokens;
    my $previous;

    while ($token && $token !~ /$regex/) {
        $previous = $token unless $token =~ /^\s+$/ || $token eq '=>';
        $token = shift @$tokens;
    }

    return $previous;
}

sub find_example_queries {
    my $lib       = shift;
    my $meta_info = $lib->get_meta_information;
    my @example_queries;

    push @example_queries, @{ $meta_info->{primary_example_queries} }
        if $meta_info->{primary_example_queries};

    push @example_queries, @{ $meta_info->{secondary_example_queries} }
        if $meta_info->{secondary_example_queries};

    return @example_queries;
}

sub response {
    my $query   = shift;
    my @blocks  = blocks();
    my $request = DDG::Request->new( query_raw => $query );

    foreach my $block (@blocks) {
        my @response = $block->request($request);
        next unless @response;
        return $response[0];
    }

    warn "\033[31mQuery \"$query\" did not trigger anything\033[0m";
    return undef;
}


sub blocks {
    my @blocks;
    my @libs = libs();
    my %blocks_plugins;
    
    for (@libs) {
        unless ($blocks_plugins{$_->triggers_block_type}) {
            $blocks_plugins{$_->triggers_block_type} = [];
        }
        push @{$blocks_plugins{$_->triggers_block_type}}, $_;
    }

    for (keys %blocks_plugins) {
        my $block_class = 'DDG::Block::'.$_;
        load_class($block_class);
        # $blocks_plugins{$_} is just an array, it can be replaced with specific plugins to query at this point
        push @blocks, $block_class->new( plugins => $blocks_plugins{$_} );
    }
    load_class('DDG::Request');

    return @blocks;
}

my @LIBS;

sub libs {
    return @LIBS if @LIBS;

    my $dir = path("lib/DDG/Goodie");

    for my $file ($dir->children) {
        my $basename = $file->basename;
        $basename =~ s/.pm$//;
        my $lib = "DDG::Goodie::$basename";
        push @LIBS, $lib;
    }

    return @LIBS;
}

sub create_missing_tests {
    my ($queries, $file) = @_;

    return unless @$queries;

    say ">> " . $file;
    my @lines_in = $file->lines_utf8;

    my $previous;
    my @lines_out;

    while (my $line_in = shift @lines_in) {
        last if $line_in =~ /^\s*\);\s*$/;
        push @lines_out, $line_in;
        $previous = $line_in;
    }

    my $indent = 8;
    $previous =~ m/^(\s+)/;
    $indent = length($1) if $1;

    foreach my $query (@$queries) {
        my $response = response($query) || next;
        my $answer   = $response->answer;
        my $html     = $response->html;
        my $heading  = $response->heading;

        my $q = $answer && $answer =~ /'/ ? '"' : "'";
        my $x = $html   && $html   =~ /'/ ? '"' : "'";

        my $test     = " " x $indent . "'$query' => test_zci(";
        $test .= $answer ? "$q$answer$q" : "$q$q";
        $test .= ", html => $x$html$x"     if $html;
        $test .= ", heading => '$heading'" if $heading;
        $test .= "),\n";

        push @lines_out, $test;
    }

    push @lines_out, ");\n", @lines_in;

    #say join "", @lines_out;
    $file->spew_utf8(@lines_out);
}