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
104
105
106
107
108
109
110
|
package Test::MooseX::UserAgent;
use strict;
use warnings;
use base 'Test::Class';
use Test::Exception;
use Test::More;
use Cache::MemoryCache;
{
package Test::UserAgent;
use Moose;
with qw/MooseX::UserAgent/;
has useragent_conf => (
isa => 'HashRef',
is => 'rw',
default => sub {
return {
name => 'Mozilla/5.0 (compatible; LWP; RTGI; http://rtgi.fr/)',
mail => 'bot@rtgi.fr',
timeout => 30,
cache => { use_cache => 0, },
max_size => 3000000,
};
}
);
1;
}
{
package Test::UserAgent::Async;
use Moose;
with qw/MooseX::UserAgent::Async/;
has useragent_conf => (
isa => 'HashRef',
is => 'rw',
default => sub {
return {
name => 'Mozilla/5.0 (compatible; Async; RTGI; http://rtgi.fr/)',
mail => 'bot@rtgi.fr',
timeout => 30,
cache => { use_cache => 0, },
max_size => 3000000,
};
}
);
1;
}
sub cache {
my $cache = new Cache::MemoryCache(
{
'namespace' => 'testua',
'default_expires_in' => 600
}
);
return $cache;
}
my @ua_roles = (qw/Test::UserAgent Test::UserAgent::Async/);
sub fetch : Tests(14) {
my $test = shift;
my $url = 'http://lumberjaph.net/blog';
foreach my $ua (@ua_roles) {
can_ok $ua, 'fetch';
ok my $obj = $ua->new(), '... object is created';
ok my $res = $obj->fetch($url), '... fetch url';
is $res->code, "200", "... fetch is a success";
like $res->content, qr/lumberjaph/, "... and content is good";
# test with cache
$obj = $ua->new(
useragent_conf => {
name => 'Mozilla/5.0 (compatible; Async; RTGI; http://rtgi.fr/)',
cache => {
use_cache => 1,
namespace => 'testua',
}
},
ua_cache => $test->cache,
);
$res = $obj->fetch($url);
is $res->code, "200", "... fetch is a success";
# now data should be in cache
my $ref = $obj->ua_cache->get($url);
ok defined $ref, "... url is now in cache";
}
}
#sub get_content : Tests(8) {
#my $test = shift;
#foreach my $ua (@ua_roles) {
#can_ok $ua, 'get_content';
#ok my $obj = $ua->new(), ' ... object is created';
#my $url = 'http://google.com';
#my $res = $obj->fetch($url);
#is $res->code, "200", "... fetch is a success";
#my $content = $obj->get_content($res);
#like $content, qr/google/, "... and content is good";
#}
#}
1;
|