Changeset 9686

Show
Ignore:
Timestamp:
04/18/08 16:49:15 (5 months ago)
Author:
daisuke
Message:

lang/perl/WebService-Simple; Refactor a bunch of things

Location:
lang/perl/WebService-Simple/branch/lwp-base/lib/WebService
Files:
4 added
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/WebService-Simple/branch/lwp-base/lib/WebService/Simple.pm

    r8953 r9686  
     1# $Id$ 
     2 
    13package WebService::Simple; 
     4use strict; 
     5use warnings; 
     6use base qw(LWP::UserAgent Class::Data::ConfigHash); 
     7use UNIVERSAL::require; 
    28 
    3 use warnings; 
    4 use strict; 
    5 use Carp; 
    6 use URI::Escape; 
    7 use LWP::UserAgent; 
    8 use WebService::Simple::Response; 
     9our $VERSION = '0.00001'; 
    910 
    10 our $VERSION = '0.03'; 
     11__PACKAGE__->config( 
     12    base_url => '', 
     13    response_parser => { 
     14        module => "XML::Simple" 
     15    }, 
     16); 
    1117 
    12 sub new { 
     18sub new 
     19{ 
    1320    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    my %args  = @_; 
     22    my $base_url     = delete $args{base_url} || 
     23        $class->config->{base_url} || 
     24        Carp::croak("base_url is required"); 
     25    my $basic_params = delete $args{params} || {}; 
     26    my $response_parser = delete $args{response_parser}; 
     27    if (! $response_parser) { 
     28        my $config = $class->config->{response_parser}; 
     29        if (! ref $config) { 
     30            $config = { module => $config }; 
     31        } 
     32        my $module = $config->{module}; 
     33        if ($module !~ s/^\+//) { 
     34            $module = __PACKAGE__ . "::Parser::$module"; 
     35        } 
     36        $module->require or die; 
     37        $response_parser = $module->new( %{ $config->{args} || {} } ); 
     38    }; 
     39    die if $@; 
     40 
     41    my $self = $class->SUPER::new(%args); 
     42    $self->{base_url} = URI->new($base_url); 
     43    $self->{basic_params} = $basic_params; 
     44    $self->{response_parser} = $response_parser; 
     45    return $self; 
    2146} 
    2247 
    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); 
     48sub base_url { $_[0]->{base_url} } 
     49sub basic_params { $_[0]->{basic_params} } 
     50sub response_parser { $_[0]->{response_parser} } 
     51 
     52sub get 
     53{ 
     54    my $self = shift; 
     55    my ($url, %extra, @headers); 
     56    if (ref $_[0] eq 'HASH') { 
     57        %extra = %{shift @_}; 
     58    } else { 
     59        $url = shift @_; 
     60        if (ref $_[0] eq 'HASH') { 
     61            %extra = %{ shift @_ } 
     62        } 
     63    } 
     64 
     65    @headers = @_; 
     66 
     67    my $uri = URI->new($self->base_url); 
     68    $uri->path( $uri->path . $url) if $url; 
     69 
     70    # The url must be initialized with default parameters. 
     71 
     72    $uri->query_form( %{$self->basic_params}, %extra ); 
     73    my $response = $self->SUPER::get($uri, @headers); 
     74    if (! $response->is_success) { 
     75        Carp::croak("request to $url failed"); 
     76    } 
     77    # まだできてない 
     78    # WebService::Simple::Response->new_from_response( 
     79    #   response => $response, 
     80    #   parser   => $self->reponse_parser 
     81    # ); 
    2782    return $response; 
    2883} 
    2984 
    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); 
     85# まだできてない。 
     86sub post 
     87{ 
     88    my ($self, $url, @params) = @_; 
     89 
     90    # default parameters must come *before* @params, so unshift instead 
     91    # of push 
     92    unshift @params, %{ $self->basic_params }; 
     93    my $response = $self->SUPER::post($url, @params ); 
     94 
     95    if (! $response->is_success) { 
     96        Carp::croak("request to $url failed"); 
    4397    } 
    4498    return $response; 
    4599} 
    46100 
    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 } 
     1011; 
    61102 
    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  
    75 1; 
    76103__END__ 
    77104 
    78105=head1 NAME 
    79106 
    80 WebService::Simple - Simple interface to Web Services APIs 
    81  
    82 =head1 VERSION 
    83  
    84 This document describes WebService::Simple version 0.03 
     107WebService::Simple - Simple Interface To Web Services APIs 
    85108 
    86109=head1 SYNOPSIS 
    87110 
    88     use WebService::Simple; 
     111  use WebService::Simple; 
    89112 
    90     my $flickr = WebService::Simple->new( 
    91         base_url => "http://api.flickr.com/services/rest/", 
    92         param    => { api_key => "your_api_key", } 
     113  # Simple use case 
     114  my $flickr = WebService::Simple->new( 
     115    base_url => "http://api.flickr.com/services/rest/", 
     116    param    => { api_key => "your_api_key", } 
     117  ); 
     118 
     119  # send GET request to  
     120  # http://api.flickr.com/service/rest/?api_key=your_api_key&method=flickr.test.echo&name=value 
     121  $flickr->get( { method => "flickr.test.echo", name => "value" } ); 
     122 
     123  # send GET request to  
     124  # http://api.flickr.com/service/rest/extra/path?api_key=your_api_key&method=flickr.test.echo&name=value 
     125  $flickr->get( "extra/path", 
     126    { method => "flickr.test.echo", name => "value" }); 
     127 
     128  # Create a subclass - Encapsulates things better 
     129  package WebService::Simple::Flickr; 
     130  use base qw(WebService::Simple); 
     131  __PACKAGE__->config( 
     132    base_url => "http://api.flickr.com/services/rest/", 
     133    upload_url => "http://api.flickr.com/services/upload/", 
     134  ); 
     135 
     136  sub test_echo 
     137  { 
     138    my $self = shift; 
     139    $self->get( { method => "flickr.test.echo", name => "value" } ); 
     140  } 
     141 
     142  sub upload 
     143  { 
     144    my $self = shift; 
     145    local $self->{base_url} = $self->config->{upload_url}; 
     146    $self->post(  
     147      Content_Type => "form-data", 
     148      Content => { title => "title", description => "...", photo => ... }, 
    93149    ); 
    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"; 
     150  } 
    98151 
    99 =head1 DESCRIPTION 
     152  # Using response objects 
     153  my $service = WebService::Simple->new( 
     154    response_parser => MyParser->new 
     155  ); 
     156  my $resp = $service->get(...); 
     157  my $blob = $resp->parse_response; # Parsed with MyParser 
    100158 
    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  
    150  
    151 =head1 AUTHOR 
    152  
    153 Yusuke Wada  C<< <yusuke@kamawada.com> >> 
    154  
    155 =head1 COPYRIGHT AND LICENSE 
    156  
    157 Copyright (c) 2008 Yusuke Wada, All rights reserved. 
    158  
    159 This module is free software; you can redistribute it 
    160 and/or modify it under the same terms as Perl itself. 
    161 See L<perlartistic>. 
    162  
     159=cut