Skip to content

Instantly share code, notes, and snippets.

@kablamo
Last active August 29, 2015 13:56
Show Gist options
  • Save kablamo/8971234 to your computer and use it in GitHub Desktop.
Save kablamo/8971234 to your computer and use it in GitHub Desktop.
Create tests for example queries in DDG::Goodie::* with no tests
#!/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);
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment