The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

NHORNE / CGI-Info-0.98 / t / is_search.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

              
#!perl -w
use strict;
use warnings;
use Test::Most tests => 29;
use Test::NoWarnings;
BEGIN {
        use_ok('CGI::Info');
}
SEARCH: {
        delete $ENV{'REMOTE_ADDR'};
        delete $ENV{'HTTP_USER_AGENT'};
        my $cache;
        eval {
                require CHI;
                CHI->import();
        };
        if($@) {
                diag('CHI not installed');
                $cache = undef;
        } else {
                diag("Using CHI $CHI::VERSION");
                my $hash = {};
                $cache = CHI->new(driver => 'Memory', datastore => $hash);
        }
        my $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 0);
        $ENV{'REMOTE_ADDR'} = '65.52.110.76';
        $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 0);
        $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (compatible; bingbot/2.0; +http://www.bing.com/bingbot.htm)';
        $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 1);
        ok($i->browser_type() eq 'search');
        $ENV{'REMOTE_ADDR'} = '119.63.196.107';
        $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (compatible; Baiduspider/2.0; +http://www.baidu.com/search/spider.html)';
        $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 1);
        ok($i->browser_type() eq 'search');
        $ENV{'REMOTE_ADDR'} = '207.241.237.233';
        $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (compatible; archive.org_bot +http://www.archive.org/details/archive.org_bot)';
        $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 0);
        $ENV{'REMOTE_ADDR'} = '74.92.149.57';
        $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.7; en-US; rv:1.9.2.20) Gecko/20110803 Firefox/3.6.20';
        $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 0);
        $ENV{'REMOTE_ADDR'} = '66.249.73.149';
        $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)';
        $i = new_ok('CGI::Info');
        ok($i->is_search_engine() == 1);
        ok($i->browser_type() eq 'search');
        $ENV{'REMOTE_ADDR'} = '66.249.73.149';
        $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (compatible; SeznamBot/3.2; +http://napoveda.seznam.cz/en/seznambot-intro/)';
        $i = new_ok('CGI::Info' => [{
                cache => $cache,
        }]);
        ok($i->is_search_engine() == 1);
        ok($i->browser_type() eq 'search');
        SKIP: {
                skip 'Test requires CHI access', 2 unless($cache);
                cmp_ok($cache->get("66.249.73.149/$ENV{HTTP_USER_AGENT}"), 'eq', 'search', 'cache works');
                ok(!defined($cache->get("12.159.106.42/$ENV{HTTP_USER_AGENT}")));
        }
        # Verify sub-classing works
        {
                package CGI::Info::Test;
                use base qw(CGI::Info);
        }
        $ENV{'HTTP_USER_AGENT'} = 'A nonsense user agent string';
        $ENV{'REMOTE_ADDR'} = '212.159.106.41';
        $i = new_ok('CGI::Info::Test' => [{
                cache => $cache,
        }]);
        ok($i->is_search_engine() == 0);
        ok($i->browser_type() eq 'robot');
        SKIP: {
                skip 'Test requires CHI access', 2 unless($cache);
                cmp_ok($cache->get("212.159.106.41/$ENV{HTTP_USER_AGENT}"), 'eq', 'robot', 'cache works');
                ok(!defined($cache->get("12.159.106.42/$ENV{HTTP_USER_AGENT}")));
        }
}