root/lang/perl/WebService-Simple/trunk/lib/WebService/Simple.pm @ 13005

Revision 13005, 9.1 kB (checked in by yusukebe, 6 years ago)
Line 
1# $Id$
2
3package WebService::Simple;
4use strict;
5use warnings;
6use base qw(LWP::UserAgent Class::Data::ConfigHash);
7use Class::Inspector;
8use Data::Dumper ();
9use Digest::MD5  ();
10use URI::Escape;
11use WebService::Simple::Response;
12use UNIVERSAL::require;
13
14our $VERSION = '0.12';
15
16__PACKAGE__->config(
17    base_url        => '',
18    response_parser => { module => "XML::Simple" },
19);
20
21sub new {
22    my $class    = shift;
23    my %args     = @_;
24    my $base_url = delete $args{base_url}
25      || $class->config->{base_url}
26      || Carp::croak("base_url is required");
27    my $basic_params = delete $args{params} || delete $args{param} || {};
28    my $debug = delete $args{debug} || 0;
29
30    my $response_parser = delete $args{response_parser}
31      || $class->config->{response_parser};
32    if (   !$response_parser
33        || !eval { $response_parser->isa('WebService::Simple::Parser') } )
34    {
35        my $config = $response_parser || $class->config->{response_parser};
36        if ( !ref $config ) {
37            $config = { module => $config };
38        }
39        my $module = $config->{module};
40        if ( $module !~ s/^\+// ) {
41            $module = __PACKAGE__ . "::Parser::$module";
42        }
43        if ( !Class::Inspector->loaded($module) ) {
44            $module->require or die;
45        }
46        $response_parser = $module->new( %{ $config->{args} || {} } );
47    }
48
49    my $cache = delete $args{cache};
50    if ( !$cache || ref $cache eq 'HASH' ) {
51        my $config = ref $cache eq 'HASH' ? $cache : $class->config->{cache};
52        if ($config) {
53            if ( !ref $config ) {
54                $config = { module => $config };
55            }
56
57            my $module = $config->{module};
58            if ( !Class::Inspector->loaded($module) ) {
59                $module->require or die;
60            }
61            $cache =
62              $module->new( $config->{hashref_args}
63                ? $config->{args}
64                : %{ $config->{args} } );
65        }
66    }
67
68    my $self = $class->SUPER::new(%args);
69    $self->{base_url}        = URI->new($base_url);
70    $self->{basic_params}    = $basic_params;
71    $self->{response_parser} = $response_parser;
72    $self->{cache}           = $cache;
73    $self->{debug}           = $debug;
74    return $self;
75}
76
77sub base_url        { $_[0]->{base_url} }
78sub basic_params    { $_[0]->{basic_params} }
79sub response_parser { $_[0]->{response_parser} }
80sub cache           { $_[0]->{cache} }
81
82sub __cache_get {
83    my $self  = shift;
84    my $cache = $self->cache;
85    return unless $cache;
86
87    my $key = $self->__cache_key(shift);
88    return $cache->get( $key, @_ );
89}
90
91sub __cache_set {
92    my $self  = shift;
93    my $cache = $self->cache;
94    return unless $cache;
95
96    my $key = $self->__cache_key(shift);
97    return $cache->set( $key, @_ );
98}
99
100sub __cache_remove {
101    my $self  = shift;
102    my $cache = $self->cache;
103    return unless $cache;
104
105    my $key = $self->__cache_key(shift);
106    return $cache->remove( $key, @_ );
107}
108
109sub __cache_key {
110    my $self = shift;
111    local $Data::Dumper::Indent   = 1;
112    local $Data::Dumper::Terse    = 1;
113    local $Data::Dumper::Sortkeys = 1;
114    return Digest::MD5::md5_hex( Data::Dumper::Dumper( $_[0] ) );
115}
116
117sub request_url {
118    my $self = shift;
119    my %args = @_;
120
121    my $uri = URI->new( $args{url} );
122    if ( my $extra_path = $args{extra_path} ) {
123        $extra_path =~ s!^/!!;
124        $uri->path( $uri->path . $extra_path );
125    }
126
127    my $params = $args{params};
128    if ($params) {
129        foreach my $key ( keys %$params ) {
130            if ( utf8::is_utf8( $params->{$key} ) ) {
131                $params->{$key} = utf8::encode( $params->{$key} );
132            }
133        }
134        $uri->query_form(%$params);
135    }
136
137    return $uri;
138}
139
140sub get {
141    my $self = shift;
142    my ( $url, %extra );
143
144    if ( ref $_[0] eq 'HASH' ) {
145        $url   = "";
146        %extra = %{ shift @_ };
147    }
148    else {
149        $url = shift @_;
150        if ( ref $_[0] eq 'HASH' ) {
151            %extra = %{ shift @_ };
152        }
153    }
154
155    my $uri = $self->request_url(
156        url        => $self->base_url,
157        extra_path => $url,
158        params     => { %{ $self->basic_params }, %extra }
159    );
160    print "Request URL is $uri\n" if $self->{debug};
161
162    my @headers = @_;
163
164    my $response;
165    $response = $self->__cache_get( [ $uri, @headers ] );
166    if ($response) {
167        return $response;
168    }
169
170    $response = $self->SUPER::get( $uri, @headers );
171    if ( !$response->is_success ) {
172        Carp::croak("request to $uri failed");
173    }
174
175    $response = WebService::Simple::Response->new_from_response(
176        response => $response,
177        parser   => $self->response_parser
178    );
179    $self->__cache_set( [ $uri, @headers ], $response );
180    return $response;
181}
182
183sub post {
184    my ( $self, $url, @params ) = @_;
185
186    # XXX - do not include params
187    my $uri = $self->request_url(
188        url        => $self->base_url,
189        extra_path => $url
190    );
191
192    # default parameters must come *before* @params, so unshift instead
193    # of push
194    unshift @params, %{ $self->basic_params };
195    my $response = $self->SUPER::post( $uri, @params );
196
197    if ( !$response->is_success ) {
198        Carp::croak( "request to $url failed: " . $response->status_line );
199    }
200    $response = WebService::Simple::Response->new_from_response(
201        response => $response,
202        parser   => $self->response_parser
203    );
204    return $response;
205}
206
2071;
208
209__END__
210
211=head1 NAME
212
213WebService::Simple - Simple Interface To Web Services APIs
214
215=head1 SYNOPSIS
216
217  use WebService::Simple;
218
219  # Simple use case
220  my $flickr = WebService::Simple->new(
221    base_url => "http://api.flickr.com/services/rest/",
222    param    => { api_key => "your_api_key", }
223  );
224
225  # send GET request to
226  # http://api.flickr.com/service/rest/?api_key=your_api_key&method=flickr.test.echo&name=value
227  $flickr->get( { method => "flickr.test.echo", name => "value" } );
228
229  # send GET request to
230  # http://api.flickr.com/service/rest/extra/path?api_key=your_api_key&method=flickr.test.echo&name=value
231  $flickr->get( "extra/path",
232    { method => "flickr.test.echo", name => "value" });
233
234=head1 DESCRIPTION
235
236WebService::Simple is a simple class to interact with web services.
237
238It's basically an LWP::UserAgent that remembers recurring api URLs and
239parameters, plus sugar to parse the results.
240
241=head1 METHODS
242
243=over 4
244
245=item new(I<%args>)
246
247    my $flickr = WebService::Simple->new(
248        base_url => "http://api.flickr.com/services/rest/",
249        param    => { api_key => "your_api_key", },
250        # debug    => 1
251    );
252
253Create and return a new WebService::Simple object.
254"new" Method requires a base_url of Web Service API.
255If debug is set, dump a request URL in get or post method.
256
257=item get(I<[$extra_path,] $args>)
258
259    my $response =
260      $flickr->get( { method => "flickr.test.echo", name => "value" } );
261
262Send GET request, and you can get  the WebService::Simple::Response object.
263If you want to add a path to base URL, use an option parameter.
264
265    my $lingr = WebService::Simple->new(
266        base_url => "http://www.lingr.com/",
267        param    => { api_key => "your_api_key", format => "xml" }
268    );
269    my $response = $lingr->get( 'api/session/create', {} );
270
271=item post(I<[$extra_path,] $args>)
272
273Send POST request.
274
275=item request_url(I<$extra_path, $args>)
276
277Return reequest URL.
278
279=item base_url
280
281=item basic_params
282
283=item cache
284
285=item response_parser
286
287=back
288
289=head1 SUBCLASSING
290
291For better encapsulation, you can create subclass of WebService::Simple to
292customize the behavior
293
294  package WebService::Simple::Flickr;
295  use base qw(WebService::Simple);
296  __PACKAGE__->config(
297    base_url => "http://api.flickr.com/services/rest/",
298    upload_url => "http://api.flickr.com/services/upload/",
299  );
300
301  sub test_echo
302  {
303    my $self = shift;
304    $self->get( { method => "flickr.test.echo", name => "value" } );
305  }
306
307  sub upload
308  {
309    my $self = shift;
310    local $self->{base_url} = $self->config->{upload_url};
311    $self->post(
312      Content_Type => "form-data",
313      Content => { title => "title", description => "...", photo => ... },
314    );
315  }
316
317
318=head1 PARSERS
319
320Web services return their results in various different formats. Or perhaps
321you require more sophisticated results parsing than what WebService::Simple
322provides.
323
324WebService::Simple by default uses XML::Simple, but you can easily override
325that by providing a parser object to the constructor:
326
327  my $service = WebService::Simple->new(
328    response_parser => AVeryComplexParser->new,
329    ...
330  );
331  my $response = $service->get( ... );
332  my $thing = $response->parse_response;
333
334This allows great flexibility in handling different webservices
335
336=head1 CACHING
337
338You can cache the response of Web Service by using Cache object.
339
340  my $cache   = Cache::File->new(
341      cache_root      => '/tmp/mycache',
342      default_expires => '30 min',
343  );
344 
345  my $flickr = WebService::Simple->new(
346      base_url => "http://api.flickr.com/services/rest/",
347      cache    => $cache,
348      param    => { api_key => "your_api_key, }
349  );
350
351
352=head1 AUTHOR
353
354Yusuke Wada  C<< <yusuke@kamawada.com> >>
355
356Daisuke Maki C<< <daisuke@endeworks.jp> >>
357
358Matsuno Tokuhiro
359
360=head1 COPYRIGHT AND LICENSE
361
362This module is free software; you can redistribute it
363and/or modify it under the same terms as Perl itself.
364See L<perlartistic>.
365
366=cut
Note: See TracBrowser for help on using the browser.