File Coverage

blib/lib/DDG/Test/Block.pm
Criterion Covered Total %
statement 63 65 96.9
branch 12 16 75.0
condition 3 3 100.0
subroutine 13 13 100.0
pod n/a
total 91 97 93.8


line stmt bran cond sub pod time code
1             package DDG::Test::Block;
2             our $AUTHORITY = 'cpan:DDG';
3             # ABSTRACT: Adds a function to easily test L.
4             $DDG::Test::Block::VERSION = '1017';
5 8     8   45 use strict;
  8         16  
  8         241  
6 8     8   37 use warnings;
  8         15  
  8         171  
7 8     8   35 use Carp;
  8         15  
  8         353  
8 8     8   40 use Test::More;
  8         13  
  8         63  
9 8     8   4093 use Class::Load ':all';
  8         99867  
  8         936  
10 8     8   2099 use DDG::Request;
  8         29  
  8         236  
11 8     8   2916 use DDG::Block::Words;
  8         26  
  8         248  
12 8     8   2482 use DDG::Block::Regexp;
  8         21  
  8         185  
13 8     8   2694 use DDG::Test::Location;
  8         21  
  8         43  
14 8     8   2792 use DDG::Test::Language;
  8         23  
  8         41  
15 8     8   42 use Package::Stash;
  8         32  
  8         2285  
16              
17             sub import {
18 9     9   58 my ( $class, %params ) = @_;
19 9         24 my $target = caller;
20              
21 9         73 my $stash = Package::Stash->new($target);
22              
23              
24             $stash->add_symbol('&block_test',sub {
25 7     7   19 my $result_callback = shift;
26 7         14 my $plugins_ref = shift;
27 7         13 my @plugins = @{$plugins_ref};
  7         19  
28 7         21 my @regexp; my @words;
29 7         21 foreach my $plugin (@plugins) {
30 15         60 load_class($plugin);
31 15 100       3972 if ($plugin->triggers_block_type eq 'Words') {
    50          
32 13         36 push @words, $plugin;
33             } elsif ($plugin->triggers_block_type eq 'Regexp') {
34 2         5 push @regexp, $plugin;
35             } else {
36 0         0 croak "Unknown plugin type";
37             }
38             }
39 7 50       128 my $words_block = @words ? DDG::Block::Words->new( plugins => [@words]) : undef;
40 7 100       103 my $regexp_block = @regexp ? DDG::Block::Regexp->new( plugins => [@regexp]) : undef;
41 7         28 while (@_) {
42 19         20822 my $query = shift;
43 19         36 my $request;
44 19 100       51 if (ref $query eq 'DDG::Request') {
45 5         9 $request = $query;
46 5         18 $query = $request->query_raw;
47             } else {
48 14         52 $request = DDG::Request->new(
49             query_raw => $query,
50             location => test_location('us'),
51             language => test_language('us'),
52             );
53             }
54 19         8552 my $target = shift;
55 19         35 my $answer = undef;
56 19 50       389 ( $answer ) = $words_block->request($request) if $words_block;
57 19 100 100     125 ( $answer ) = $regexp_block->request($request) if $regexp_block && !$answer;
58 19 50       47 if ( defined $target ) {
59 19         41 for ($answer) {
60 19         61 $result_callback->($query,$answer,$target);
61             }
62             } else {
63 0           is($answer,$target,'Checking for not matching on '.$query);
64             }
65             }
66 9         344 });
67              
68             }
69              
70             1;
71              
72             __END__