Show
Ignore:
Timestamp:
04/21/08 18:54:08 (7 months ago)
Author:
daisuke
Message:

merge lwp-base branch

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/WebService-Simple/trunk/lib/WebService/Simple.pm

    r8953 r10071  
     1# $Id$ 
     2 
    13package WebService::Simple; 
    2  
     4use strict; 
    35use warnings; 
    4 use strict; 
    5 use Carp; 
    6 use URI::Escape; 
    7 use LWP::UserAgent; 
     6use base qw(LWP::UserAgent Class::Data::ConfigHash); 
     7use Class::Inspector; 
     8use Data::Dumper (); 
     9use Digest::MD5 (); 
    810use WebService::Simple::Response; 
    9  
    10 our $VERSION = '0.03'; 
    11  
    12 sub new { 
     11use UNIVERSAL::require; 
     12 
     13our $VERSION = '0.00001'; 
     14 
     15__PACKAGE__->config( 
     16    base_url => '', 
     17    cache => { 
     18        module => "Cache::FileCache", 
     19        args   => { 
     20        } 
     21    }, 
     22    response_parser => { 
     23        module => "XML::Simple" 
     24    }, 
     25); 
     26 
     27sub new 
     28{ 
    1329    my $class = shift; 
    14     my $opt = ref $_[0] eq 'HASH' ? shift: {@_}; 
    15     croak "paramater base_url is required" unless $opt->{base_url}; 
    16     my $self = bless { 
    17         ua => LWP::UserAgent->new, 
    18         %$opt, 
    19     }, $class; 
    20     $self; 
    21 } 
    22  
    23 sub get { 
    24     my ($self, $request_param, $opt) = @_; 
    25     my $url = $self->_make_url($request_param, $opt->{path}); 
    26     my $response = $self->_fetch_url($url); 
     30    my %args  = @_; 
     31    my $base_url     = delete $args{base_url} || 
     32        $class->config->{base_url} || 
     33        Carp::croak("base_url is required"); 
     34    my $basic_params = delete $args{params} || delete $args{param} || {}; 
     35    my $response_parser = delete $args{response_parser} || 
     36        $class->config->{response_parser}; 
     37    if (! $response_parser || ! eval { $response_parser->isa('WebService::Simple::Parser') }) { 
     38        my $config = $response_parser || $class->config->{response_parser}; 
     39        if (! ref $config) { 
     40            $config = { module => $config }; 
     41        } 
     42        my $module = $config->{module}; 
     43        if ($module !~ s/^\+//) { 
     44            $module = __PACKAGE__ . "::Parser::$module"; 
     45        } 
     46        if (! Class::Inspector->loaded($module)) { 
     47            $module->require or die; 
     48        } 
     49        $response_parser = $module->new( %{ $config->{args} || {} } ); 
     50    }; 
     51 
     52    my $cache = delete $args{cache}; 
     53    if (! $cache || ref $cache eq 'HASH') { 
     54        my $config = ref $cache eq 'HASH' ? $cache : $class->config->{cache}; 
     55        if ($config) { 
     56            if (! ref $config) { 
     57                $config = { module => $config }; 
     58            } 
     59 
     60            my $module = $config->{module}; 
     61            if (! Class::Inspector->loaded($module)) { 
     62                $module->require or die; 
     63            } 
     64            $cache = $module->new( $config->{hashref_args} ? $config->{args} : %{ $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    return $self; 
     74} 
     75 
     76sub base_url { $_[0]->{base_url} } 
     77sub basic_params { $_[0]->{basic_params} } 
     78sub response_parser { $_[0]->{response_parser} } 
     79sub cache { $_[0]->{cache} } 
     80 
     81sub __cache_get 
     82{ 
     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{ 
     93    my $self  = shift; 
     94    my $cache = $self->cache; 
     95    return unless $cache; 
     96 
     97    my $key   = $self->__cache_key( shift ); 
     98    return $cache->set( $key, @_ ); 
     99} 
     100 
     101sub __cache_remove 
     102{ 
     103    my $self  = shift; 
     104    my $cache = $self->cache; 
     105    return unless $cache; 
     106 
     107    my $key   = $self->__cache_key( shift ); 
     108    return $cache->remove( $key, @_ ); 
     109} 
     110 
     111sub __cache_key 
     112{ 
     113    my $self  = shift; 
     114    local $Data::Dumper::Indent   = 1; 
     115    local $Data::Dumper::Terse    = 1; 
     116    local $Data::Dumper::Sortkeys = 1; 
     117    return Digest::MD5::md5_hex( Data::Dumper::Dumper( $_[0] ) ); 
     118} 
     119 
     120sub get 
     121{ 
     122    my $self = shift; 
     123    my ($url, %extra, @headers); 
     124    if (ref $_[0] eq 'HASH') { 
     125        %extra = %{shift @_}; 
     126    } else { 
     127        $url = shift @_; 
     128        if (ref $_[0] eq 'HASH') { 
     129            %extra = %{ shift @_ } 
     130        } 
     131    } 
     132 
     133    @headers = @_; 
     134 
     135    my $uri = URI->new($self->base_url); 
     136    $uri->path( $uri->path . $url) if $url; 
     137 
     138    # The url must be initialized with default parameters. 
     139 
     140    $uri->query_form( %{$self->basic_params}, %extra ); 
     141 
     142    my $response; 
     143 
     144    $response = $self->__cache_get([$uri, @headers]); 
     145    if ($response) { 
     146        return $response; 
     147    } 
     148 
     149    $response = $self->SUPER::get($uri, @headers); 
     150    if (! $response->is_success) { 
     151        Carp::croak("request to $url failed"); 
     152    } 
     153 
     154    $response = WebService::Simple::Response->new_from_response( 
     155        response => $response, 
     156        parser   => $self->response_parser 
     157    ); 
     158    $self->__cache_set([$uri, @headers], $response); 
    27159    return $response; 
    28 } 
    29  
    30 sub _fetch_url{ 
    31     my ($self, $url) = @_; 
    32     my $response; 
    33     if(exists $self->{cache}){ 
    34         $response = $self->{cache}->thaw($url); 
    35         if(defined $response){ 
    36             return $response; 
    37         } 
    38     } 
    39     $response = $self->{ua}->get($url); 
    40     croak "can't get the request" unless $response->is_success; 
    41     if(exists $self->{cache}) { 
    42         $self->{cache}->freeze($url, $response); 
    43     } 
     160 
     161} 
     162 
     163# まだできてない。 
     164sub post 
     165{ 
     166    my ($self, $url, @params) = @_; 
     167 
     168    my $uri = URI->new($self->base_url); 
     169    $uri->path( $uri->path . $url) if $url; 
     170 
     171    # default parameters must come *before* @params, so unshift instead 
     172    # of push 
     173    unshift @params, %{ $self->basic_params }; 
     174    my $response = $self->SUPER::post($uri, @params ); 
     175 
     176    if (! $response->is_success) { 
     177        Carp::croak("request to $url failed: " . $response->status_line); 
     178    } 
     179    $response = WebService::Simple::Response->new_from_response( 
     180        response => $response, 
     181        parser   => $self->response_parser 
     182    ); 
    44183    return $response; 
    45184} 
    46185 
    47 sub _make_url{ 
    48     my ($self, $request_param, $path) = @_; 
    49     my $base_url = $self->{base_url}; 
    50     if($path){ 
    51         $path =~ s!^/+!! if $base_url =~ m{/$}; 
    52         $base_url = $base_url . $path; 
    53     } 
    54     my $url = $base_url =~ /\?$/ ? $base_url : $base_url . "?"; 
    55     my @params; 
    56     push(@params, $self->_hashref_to_str($self->{param})); 
    57     push(@params, $self->_hashref_to_str($request_param)); 
    58     my $str = join("&", @params); 
    59     return $url . $str; 
    60 } 
    61  
    62 sub _hashref_to_str { 
    63     my ($self, $ref) = @_; 
    64     my @strs; 
    65     foreach my $key ( keys %$ref ){ 
    66         my $value = $ref->{$key}; 
    67         utf8::decode($value) unless utf8::is_utf8($value); 
    68         my $str = "$key=" . URI::Escape::uri_escape_utf8($value); 
    69         push(@strs, $str); 
    70     } 
    71     return @strs; 
    72 } 
    73  
    74  
    751861; 
     187 
    76188__END__ 
    77189 
    78190=head1 NAME 
    79191 
    80 WebService::Simple - Simple interface to Web Services APIs 
    81  
    82 =head1 VERSION 
    83  
    84 This document describes WebService::Simple version 0.03 
     192WebService::Simple - Simple Interface To Web Services APIs 
    85193 
    86194=head1 SYNOPSIS 
    87195 
    88     use WebService::Simple; 
    89  
    90     my $flickr = WebService::Simple->new( 
    91         base_url => "http://api.flickr.com/services/rest/", 
    92         param    => { api_key => "your_api_key", } 
     196  use WebService::Simple; 
     197 
     198  # Simple use case 
     199  my $flickr = WebService::Simple->new( 
     200    base_url => "http://api.flickr.com/services/rest/", 
     201    param    => { api_key => "your_api_key", } 
     202  ); 
     203 
     204  # send GET request to  
     205  # http://api.flickr.com/service/rest/?api_key=your_api_key&method=flickr.test.echo&name=value 
     206  $flickr->get( { method => "flickr.test.echo", name => "value" } ); 
     207 
     208  # send GET request to  
     209  # http://api.flickr.com/service/rest/extra/path?api_key=your_api_key&method=flickr.test.echo&name=value 
     210  $flickr->get( "extra/path", 
     211    { method => "flickr.test.echo", name => "value" }); 
     212 
     213=head1 DESCRIPTION 
     214 
     215WebService::Simple is a simple class to interact with web services. 
     216 
     217It's basically an LWP::UserAgent that remembers recurring api URLs and 
     218parameters, plus sugar to parse the results. 
     219 
     220 
     221=head1 SUBCLASSING 
     222 
     223For better encapsulation, you can create subclass of WebService::Simple to 
     224customize the behavior 
     225 
     226  package WebService::Simple::Flickr; 
     227  use base qw(WebService::Simple); 
     228  __PACKAGE__->config( 
     229    base_url => "http://api.flickr.com/services/rest/", 
     230    upload_url => "http://api.flickr.com/services/upload/", 
     231  ); 
     232 
     233  sub test_echo 
     234  { 
     235    my $self = shift; 
     236    $self->get( { method => "flickr.test.echo", name => "value" } ); 
     237  } 
     238 
     239  sub upload 
     240  { 
     241    my $self = shift; 
     242    local $self->{base_url} = $self->config->{upload_url}; 
     243    $self->post(  
     244      Content_Type => "form-data", 
     245      Content => { title => "title", description => "...", photo => ... }, 
    93246    ); 
    94     my $response = 
    95       $flickr->get( { method => "flickr.test.echo", name => "value" } ); 
    96     my $ref = $response->parse_xml( { forcearray => [], keyattr => [] } ); 
    97     print $ref->{name} . "\n"; 
    98  
    99 =head1 DESCRIPTION 
    100  
    101 WebService::Simple provides you a simple interface to Web Services APIs 
    102  
    103 =head1 METHODS 
    104  
    105 =over 4 
    106  
    107 =item new(I<%args>) 
    108  
    109     my $flickr = WebService::Simple->new( 
    110         base_url => "http://api.flickr.com/services/rest/", 
    111         param    => { api_key => "your_api_key", } 
    112     ); 
    113  
    114 Create and return a new WebService::Simple object. 
    115 "new" Method requires a base_url of Web Service API. 
    116  
    117 =item get(I<%args>) 
    118  
    119     my $response = 
    120       $flickr->get( { method => "flickr.test.echo", name => "value" } ); 
    121  
    122 Get the WebService::Simple::Response object. 
    123  
    124 If you want to add a path to base URL, use an option parameter. 
    125  
    126     my $lingr = WebService::Simple->new( 
    127         base_url => "http://www.lingr.com/", 
    128         param    => { api_key => "your_api_key", format => "xml" } 
    129     ); 
    130     my $response = $lingr->get( {}, { path => "/api/session/create" } ); 
    131  
    132 =back 
    133  
    134 =head1 CACHING 
    135  
    136 Cache the response of Web Service APIs by using Cache object. 
    137 Here's an example. 
    138  
    139     my $cache = Cache::File->new( 
    140         cache_root      => "/tmp/mycache", 
    141         default_expires => "30 min", 
    142     ); 
    143  
    144     my $flickr = WebService::Simple->new( 
    145         base_url => "http://api.flickr.com/services/rest/", 
    146         cache    => $cache, 
    147         param    => { api_key => $api_key, } 
    148     ); 
    149  
     247  } 
     248 
     249 
     250=head1 PARSERS 
     251 
     252Web services return their results in various different formats. Or perhaps 
     253you require more sophisticated results parsing than what WebService::Simple 
     254provides. 
     255 
     256WebService::Simple by default uses XML::Simple, but you can easily override 
     257that by providing a parser object to the constructor: 
     258 
     259  my $service = WebService::Simple->new( 
     260    response_parser => AVeryComplexParser->new, 
     261    ... 
     262  ); 
     263  my $response = $service->get( ... ); 
     264  my $thing = $response->parse_response; 
     265 
     266This allows great flexibility in handling different webservices 
    150267 
    151268=head1 AUTHOR 
    152269 
    153270Yusuke Wada  C<< <yusuke@kamawada.com> >> 
     271 
     272Daisuke Maki C<< <daisuke@endeworks.jp> >> 
     273 
     274Matsuno Tokuhiro 
    154275 
    155276=head1 COPYRIGHT AND LICENSE 
    … …  
    161282See L<perlartistic>. 
    162283 
     284=cut