File Coverage

blib/lib/WWW/Search/Null/Count.pm
Criterion Covered Total %
statement 56 56 100.0
branch 4 4 100.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 68 68 100.0


line stmt bran cond sub pod time code
1              
2             # $Id: Count.pm,v 1.17 2010-12-02 23:45:57 Martin Exp $
3              
4             =head1 NAME
5              
6             WWW::Search::Null::Count - class for testing WWW::Search clients
7              
8             =head1 SYNOPSIS
9              
10             use WWW::Search;
11             my $iCount = 4;
12             my $oSearch = new WWW::Search('Null::Count',
13             '_null_count' => $iCount,
14             );
15             $oSearch->native_query('Makes no difference what you search for...');
16             my @aoResults = $oSearch->results;
17             # ...You get $iCount results.
18              
19             =head1 DESCRIPTION
20              
21             This class is a specialization of WWW::Search that returns some hits,
22             but no error message. The number of hits returned can be controlled
23             by adding a '_null_count' hash entry onto the call to
24             WWW::Search::new(). The default is 5.
25              
26             This module might be useful for testing a client program without
27             actually being connected to any particular search engine.
28              
29             =head1 AUTHOR
30              
31             Martin 'Kingpin' Thurn, C, L.
32              
33             =cut
34              
35             package WWW::Search::Null::Count;
36              
37 3     3   2768 use strict;
  3         17  
  3         89  
38 3     3   17 use warnings;
  3         12  
  3         94  
39              
40 3     3   20 use WWW::Search;
  3         8  
  3         136  
41 3     3   296 use WWW::Search::Result;
  3         8  
  3         106  
42              
43 3     3   20 use base 'WWW::Search';
  3         5  
  3         351  
44             our
45             $VERSION = do { my @r = (q$Revision: 1.17 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
46             our $MAINTAINER = q{Martin Thurn };
47              
48 3     3   17 use constant DEBUG_FUNC => 0;
  3         7  
  3         1149  
49              
50             sub _native_setup_search
51             {
52 5     5   16 my ($self, $native_query, $native_opt) = @_;
53             # print STDERR " FFF ::Null::Count::_native_setup_search()\n" if (DEBUG_FUNC || $self->{_debug});
54 5 100       16 if (! defined $self->{_null_count})
55             {
56             # print STDERR " + setting default _null_count to 5\n";
57 1         3 $self->{_null_count} = 5;
58             } # if
59 5         15 $self->{_allow_empty_query} = 1;
60             } # _native_setup_search
61              
62              
63             sub _native_retrieve_some
64             {
65 3     3   6 my $self = shift;
66             # print STDERR " FFF ::Null::Count::_n_r_s()\n" if (DEBUG_FUNC || $self->{_debug});
67 3         26 my $response = new HTTP::Response(200,
68             "This is a test of WWW::Search");
69 3         184 $self->{response} = $response;
70 3         6 my $iCount = $self->{_null_count};
71             # print STDERR " + iCount is $iCount\n";
72 3         23 $self->_elem('approx_count', $iCount);
73 3         33 for my $i (1..$iCount)
74             {
75 53         144 my $oResult = new WWW::Search::Result;
76 53         208 $oResult->url(qq{url$i});
77 53         187 $oResult->title(qq{title$i});
78 53         544 $oResult->description("description$i");
79 53         456 $oResult->change_date("yesterday");
80 53         447 $oResult->index_date("today");
81 53         463 $oResult->raw(qq{});
82 53         454 $oResult->score(100-$i*2);
83 53         442 $oResult->normalized_score(1000-$i*20);
84 53         487 $oResult->size($i*2*1024);
85 53         429 $oResult->source('WWW::Search::Null::Count');
86 53         436 $oResult->company('Dub Dub Dub Search, Inc.');
87 53         431 $oResult->location('Ashburn, VA');
88 53 100       440 if ($i % 2)
89             {
90 27         131 $oResult->urls("url$i", map { "url$i.$_" } (1..$iCount));
  991         1905  
91 27         109 $oResult->related_urls(map { "url-r$i.$_" } (1..$iCount));
  991         1825  
92 27         109 my @aoTitles = map { "title-r$i.$_" } (1..$iCount);
  991         1858  
93 27         144 $oResult->related_titles(\@aoTitles);
94             }
95             else
96             {
97 26         59 for my $j (1..$iCount)
98             {
99 986         2815 $oResult->add_url(qq{url$i.$j});
100 986         2645 $oResult->add_related_url(qq{url-r$j});
101 986         2344 $oResult->add_related_title(qq{title-r$i});
102             } # for $j
103             } # else
104 53         84 push(@{$self->{cache}}, $oResult);
  53         118  
105             } # for $i
106 3         28 return 0;
107             } # _native_retrieve_some
108              
109             1;
110              
111             __END__