File Coverage

blib/lib/LWP/UserAgent/Caching/Simple.pm
Criterion Covered Total %
statement 24 31 77.4
branch 0 4 0.0
condition n/a
subroutine 9 11 81.8
pod 2 2 100.0
total 35 48 72.9


line stmt bran cond sub pod time code
1             package LWP::UserAgent::Caching::Simple;
2              
3             =head1 NAME
4              
5             LWP::UserAgent::Caching::Simple - The first 'hard thing' made easy --- simple
6              
7             =head1 VERSION
8              
9             Version 0.02
10              
11             =cut
12              
13             our $VERSION = '0.02';
14              
15 1     1   2447 use strict;
  1         1  
  1         21  
16 1     1   3 use warnings;
  1         1  
  1         21  
17              
18 1     1   392 use parent 'LWP::UserAgent::Caching';
  1         224  
  1         4  
19 1     1   76027 use HTTP::Request;
  1         2  
  1         23  
20              
21 1     1   561 use CHI;
  1         32442  
  1         29  
22 1     1   7 use JSON;
  1         1  
  1         8  
23              
24 1     1   127 use parent 'Exporter';
  1         1  
  1         7  
25             our @EXPORT_OK = qw(get_from_json);
26              
27             =head1 SYNOPSIS
28              
29             use LWP::UserAgent::Caching::Simple;
30            
31             my $ua = LWP::UserAgent::Caching::Simple->new;
32            
33             my $resp = $ua->get( 'http://example.com/cached?' );
34              
35             and maybe even something quick:
36              
37             # use a built-in default User-Agent for quick one timers
38            
39             use LWP::UserAgent::Caching::Simple qw(get_from_json);
40            
41             my $hashref = get_from_json ( 'http://example.com/cached?' );
42              
43              
44             =head1 DESCRIPTION
45              
46             This is a simplified version of L with sensible
47             defaults and less options. For more control and more options, please use that
48             module.
49              
50             =cut
51              
52             sub _chi_cache {
53 2     2   10 return CHI->new(
54             driver => 'File',
55             root_dir => '/tmp/LWP_UserAgent_Caching',
56             file_extension => '.cache',
57             )
58             }
59              
60             sub new {
61 2     2 1 71450 my ( $class) = @_;
62            
63 2         5 my $self = $class->SUPER::new(
64             cache => _chi_cache(),
65             );
66             # $self->agent('_ ' . __PACKAGE__ . '/' . $VERSION);
67             # $self->agent('_LWP');
68 0           return $self
69             }
70              
71             {
72             my $ua;
73             sub _default_useragent {
74 0 0   0     $ua = __PACKAGE__->new() unless $ua;
75 0           return $ua
76             }
77             }
78              
79             sub get_from_json {
80 0     0 1   my $rqst = HTTP::Request->new(
81             GET => $_[0],
82             [ Accept => 'application/json' ]
83             );
84 0           my $resp = _default_useragent()->request($rqst);
85 0 0         return unless $resp->is_success;
86 0           return from_json($resp->content());
87             }
88              
89             =head1 METHODS
90              
91             Since this is a subclass of L it has it's methods, like
92             the following object methods:
93              
94             =over
95              
96             =item request
97              
98             =item get
99              
100             =item post
101              
102             =item put
103              
104             =item delete
105              
106             =back
107              
108             And to make life realy simpel, when imported, one function
109              
110             =over
111              
112             =item get_from_json
113              
114             this will simply make a GET request to a server, with the C Header set
115             to C. On succes, it will turn the returned json (as requested)
116             into a perl data structure. Otherwise it will be C
117              
118             =back
119              
120             =head1 CAVEATS
121              
122             This is a super simplified way of making straightforward request. It can handle
123             mnore complex requests as well, using
124              
125             my $resp = $ua->request($http_rqst);
126              
127             which will give a full C object back. The UserAgent is a full
128             subclass of the standard L, and one can still change the setting
129             of that, like e.g. the C<<$ua->agent('SecretAgent/007')>>. But if you need more
130             control over your cache, you definitly need to fall back to
131             L
132              
133             =head1 AUTHOR
134              
135             Theo van Hoesel, C<< >>
136              
137             =head1 LICENSE AND COPYRIGHT
138              
139             Copyright 2016 Theo van Hoesel.
140              
141             =cut
142              
143             1;