File: Web.pm

package info (click to toggle)
libwebservice-cia-perl 1.4-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 680 kB
  • ctags: 46
  • sloc: perl: 3,707; makefile: 5
file content (284 lines) | stat: -rw-r--r-- 6,066 bytes parent folder | download | duplicates (4)
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
package WebService::CIA::Source::Web;

require 5.005_62;
use strict;
use warnings;
use Carp;
use LWP::UserAgent;
use Crypt::SSLeay;
use WebService::CIA;
use WebService::CIA::Parser;
use WebService::CIA::Source;

@WebService::CIA::Source::Web::ISA = ("WebService::CIA::Source");

our $VERSION = '1.4';

# Preloaded methods go here.

sub new {

    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $args = shift || {};
    if ( ! ref $args || ref $args ne "HASH" ) {
        croak "Arguments to new() must be a hashref";
    }
    my $self = {};
    $self->{CACHED} = "";
    $self->{CACHE} = {};
    $self->{PARSER} = WebService::CIA::Parser->new;
    bless ($self, $class);
    if ( exists $args->{ user_agent } ) {
        $self->ua( $args->{ user_agent } );
    }
    return $self;

}

sub value {

    my $self = shift;
    my ($cc, $f) = @_;

    unless ($self->cached eq $cc) {
        unless ($self->get($cc)) {
            return;
        }
    }

    if (exists $self->cache->{$f}) {
        return $self->cache->{$f};
    } else {
        return;
    }

}

sub all {

    my $self = shift;
    my $cc = shift;

    unless ($self->cached eq $cc) {
        unless ($self->get($cc)) {
            return {};
        }
    }

    return $self->cache;

}

sub get {

    my $self = shift;
    my $cc = shift;
    my $response = $self->ua->get($WebService::CIA::base_url . "geos/countrytemplate_$cc.html");
    $self->last_response( $response );
    if ($response->is_success) {
        my $data = $self->parser->parse($cc, $response->content);
        $self->cache($data);
        $self->cached($cc);
        return 1;
    } else {
        return 0;
    }

}

sub ua {

    my ( $self, $ua ) = @_;
    if ( defined $ua ) {
        $self->{ UA } = $ua;
    }
    if ( ! defined $self->{ UA } ) {
        $self->{ UA } = LWP::UserAgent->new;
        $self->{ UA }->env_proxy;
    }
    return $self->{UA};

}

sub parser {

    my $self = shift;
    return $self->{PARSER};

}

sub cached {

    my $self = shift;
    if (@_) {
        $self->{CACHED} = shift;
    }
    return $self->{CACHED};

}

sub cache {

    my $self = shift;
    if (@_) {
        $self->{CACHE} = shift;
    }
    return $self->{CACHE};

}

sub last_response {
    my ( $self, $response ) = @_;
    if ( defined $response ) {
        $self->{ LAST_RESPONSE } = $response;
    }
    return $self->{ LAST_RESPONSE };
}

1;

__END__


=head1 NAME

WebService::CIA::Source::Web - An interface to the online CIA World Factbook


=head1 SYNOPSIS

  use WebService::CIA::Source::Web;
  my $source = WebService::CIA::Source::DBM->new();


=head1 DESCRIPTION

WebService::CIA::Source::Web is an interface to the live, online version of the CIA
World Factbook.

It's a very slow way of doing things, but requires no pre-compiled DBM. It's
more likely to be useful for proving concepts or testing.


=head1 METHODS

Apart from C<new>, these methods are normally accessed via a WebService::CIA object.

=over 4

=item C<new( \%opts )>

    my $source = WebService::CIA::Source::Web->new();
    $source = WebService::CIA::Source::Web->new( { user_agent => $ua } );


This method creates a new WebService::CIA::Source::Web object. It takes an optional hashref of arguments.

=over 4

=item C<user_agent>

A user agent object to use. This must implement the same user interface
as C<LWP::UserAgent> (or, at least, a C<get()> method).

=back

=item C<value($country_code, $field)>

Retrieve a value from the web.

C<$country_code> should be the FIPS 10-4 country code as defined in
L<https://www.cia.gov/library/publications/the-world-factbook/appendix/appendix-d.html>.

C<$field> should be the name of the field whose value you want to
retrieve, as defined in
L<https://www.cia.gov/library/publications/the-world-factbook/docs/notesanddefs.html>.
(WebService::CIA::Parser also creates four extra fields: "URL", "URL - Print",
"URL - Flag", and "URL - Map" which are the URLs of the country's Factbook
page, the printable version of that page, a GIF map of the country, and a
GIF flag of the country respectively.)

C<value> will return C<undef> if the country or field cannot be found, or if
there is an error GETing the page. This isn't ideal, but I can't think of the
best way around it right now.

=item C<all($country_code)>

Returns a hashref of field-value pairs for C<$country_code> or an empty
hashref if C<$country_code> isn't available from the Factbook.

=item C<get($country_code)>

Retrieve and cache the data for a country.

Returns 1 if successful, 0 if not.

=item C<cached($country_code)>

Get/set the country code whose data is cached.

=item C<cache($hashref)>

Get/set a hashref of data for the current country.

=item C<parser()>

Returns a reference to the WebService::CIA::Parser object being used.

=item C<ua( $userAgent )>

Returns a reference to the user agent object being used. By default
this is an C<LWP::UserAgent> object, but you can pass a different object
in if you wish.

=item C<last_response()>

Returns the C<HTTP::Response> object from the last request.

=back

=head1 CACHING

In order to make some small improvement in efficiency, WebService::CIA::Source::Web
keeps a copy of the data for the last country downloaded in memory.


=head1 TO DO

=over 4

=item File system based caching of pages.

=item User-definable stack of cached countries, rather than just one.

=item Caching of last-modified headers; conditional GET.


=back

=head1 AUTHOR

Ian Malpass (ian-cpan@indecorous.com)


=head1 COPYRIGHT

Copyright 2003-2007, Ian Malpass

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

The CIA World Factbook's copyright information page
(L<https://www.cia.gov/library/publications/the-world-factbook/docs/contributor_copyright.html>)
states:

  The Factbook is in the public domain. Accordingly, it may be copied
  freely without permission of the Central Intelligence Agency (CIA).


=head1 SEE ALSO

WebService::CIA, WebService::CIA::Parser, WebService::CIA::Source::DBM

=cut