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 = '1018';
5 8     8   63 use strict;
  8         20  
  8         268  
6 8     8   51 use warnings;
  8         19  
  8         244  
7 8     8   50 use Carp;
  8         19  
  8         556  
8 8     8   57 use Test::More;
  8         19  
  8         64  
9 8     8   4532 use Class::Load ':all';
  8         122326  
  8         1627  
10 8     8   2789 use DDG::Request;
  8         31  
  8         341  
11 8     8   3153 use DDG::Block::Words;
  8         41  
  8         355  
12 8     8   2722 use DDG::Block::Regexp;
  8         32  
  8         304  
13 8     8   3458 use DDG::Test::Location;
  8         36  
  8         64  
14 8     8   3755 use DDG::Test::Language;
  8         28  
  8         49  
15 8     8   53 use Package::Stash;
  8         52  
  8         2748  
16              
17             sub import {
18 9     9   25 my ( $class, %params ) = @_;
19 9         26 my $target = caller;
20              
21 9         81 my $stash = Package::Stash->new($target);
22              
23              
24             $stash->add_symbol('&block_test',sub {
25 7     7   27 my $result_callback = shift;
26 7         20 my $plugins_ref = shift;
27 7         20 my @plugins = @{$plugins_ref};
  7         29  
28 7         25 my @regexp; my @words;
29 7         84 foreach my $plugin (@plugins) {
30 15         105 load_class($plugin);
31 15 100       4827 if ($plugin->triggers_block_type eq 'Words') {
    50          
32 13         50 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       171 my $words_block = @words ? DDG::Block::Words->new( plugins => [@words]) : undef;
40 7 100       155 my $regexp_block = @regexp ? DDG::Block::Regexp->new( plugins => [@regexp]) : undef;
41 7         36 while (@_) {
42 19         21074 my $query = shift;
43 19         35 my $request;
44 19 100       74 if (ref $query eq 'DDG::Request') {
45 5         15 $request = $query;
46 5         48 $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         8482 my $target = shift;
55 19         37 my $answer = undef;
56 19 50       506 ( $answer ) = $words_block->request($request) if $words_block;
57 19 100 100     142 ( $answer ) = $regexp_block->request($request) if $regexp_block && !$answer;
58 19 50       59 if ( defined $target ) {
59 19         47 for ($answer) {
60 19         76 $result_callback->($query,$answer,$target);
61             }
62             } else {
63 0           is($answer,$target,'Checking for not matching on '.$query);
64             }
65             }
66 9         406 });
67              
68             }
69              
70             1;
71              
72             __END__