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

create_missing_spice_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;
use HTML::Entities;

{
    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);
        #p @missing_queries;
        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::Spice::');
        shift_until(\@tokens, ']');
        shift_until(\@tokens, ',');

        while (@tokens) {
            my $previous_token = shift_until(\@tokens, 'test_spice');
            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/Spice");

    for my $file ($dir->children) {
        if (-d $file) {
            for my $child ($file->children) {
                my $basename = $child->basename;
                $basename =~ s/.pm$//;
                my $dir = $file->basename;
                my $lib = "DDG::Spice::${dir}::${basename}";
                push @LIBS, $lib;
            }
            next;
        }
        else {
            my $basename = $file->basename;
            $basename =~ s/.pm$//;
            my $lib = "DDG::Spice::$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;
    }

    pop @lines_out;

    if ($previous !~ /,\s*$/) {
        $previous =~ s/\s+$//;
        $previous .= ",\n";
    }

    push @lines_out, $previous;

    my $indent = 8;
    $previous =~ m/^(\s+)/;
    $indent = length($1) if $1;
    my $i = " " x $indent;
    my $i2 = $i . $i;

    foreach my $query (@$queries) {
        my $response  = response($query) || next;
        my $call      = encode_entities $response->call;
        my $caller    = $response->caller;
        my $call_type = $response->call_type;

        my $test = "${i}'$query' => test_spice(\n";
        $test   .= "${i2}'$call',\n";
        $test   .= "${i2}caller    => '$caller',\n";
        $test   .= "${i2}call_type => '$call_type',\n" if $call_type ne 'include';
        $test   .= "${i2}is_unsafe => 1,\n" if $response->is_unsafe;
        $test   .= "${i}),\n";

        push @lines_out, $test;
    }

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

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