Show
Ignore:
Timestamp:
06/01/08 22:34:52 (6 months ago)
Author:
yusukebe
Message:
 
Files:
1 modified

Legend:

Unmodified
Added
Removed

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

    r12993 r13005  
    77use Class::Inspector; 
    88use Data::Dumper (); 
    9 use Digest::MD5 (); 
     9use Digest::MD5  (); 
    1010use URI::Escape; 
    1111use WebService::Simple::Response; 
    … …  
    1515 
    1616__PACKAGE__->config( 
    17     base_url => '', 
    18     response_parser => { 
    19         module => "XML::Simple" 
    20     }, 
     17    base_url        => '', 
     18    response_parser => { module => "XML::Simple" }, 
    2119); 
    2220 
    23 sub new 
    24 { 
    25     my $class = shift; 
    26     my %args  = @_; 
    27     my $base_url     = delete $args{base_url} || 
    28         $class->config->{base_url} || 
    29         Carp::croak("base_url is required"); 
     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"); 
    3027    my $basic_params = delete $args{params} || delete $args{param} || {}; 
    31     my $debug  = delete $args{debug} || 0; 
    32  
    33     my $response_parser = delete $args{response_parser} || 
    34         $class->config->{response_parser}; 
    35     if (! $response_parser || ! eval { $response_parser->isa('WebService::Simple::Parser') }) { 
     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    { 
    3635        my $config = $response_parser || $class->config->{response_parser}; 
    37         if (! ref $config) { 
     36        if ( !ref $config ) { 
    3837            $config = { module => $config }; 
    3938        } 
    4039        my $module = $config->{module}; 
    41         if ($module !~ s/^\+//) { 
     40        if ( $module !~ s/^\+// ) { 
    4241            $module = __PACKAGE__ . "::Parser::$module"; 
    4342        } 
    44         if (! Class::Inspector->loaded($module)) { 
     43        if ( !Class::Inspector->loaded($module) ) { 
    4544            $module->require or die; 
    4645        } 
    4746        $response_parser = $module->new( %{ $config->{args} || {} } ); 
    48     }; 
     47    } 
    4948 
    5049    my $cache = delete $args{cache}; 
    51     if (! $cache || ref $cache eq 'HASH') { 
     50    if ( !$cache || ref $cache eq 'HASH' ) { 
    5251        my $config = ref $cache eq 'HASH' ? $cache : $class->config->{cache}; 
    5352        if ($config) { 
    54             if (! ref $config) { 
     53            if ( !ref $config ) { 
    5554                $config = { module => $config }; 
    5655            } 
    5756 
    5857            my $module = $config->{module}; 
    59             if (! Class::Inspector->loaded($module)) { 
     58            if ( !Class::Inspector->loaded($module) ) { 
    6059                $module->require or die; 
    6160            } 
    62             $cache = $module->new( $config->{hashref_args} ? $config->{args} : %{ $config->{args} } ); 
     61            $cache = 
     62              $module->new( $config->{hashref_args} 
     63                ? $config->{args} 
     64                : %{ $config->{args} } ); 
    6365        } 
    6466    } 
    6567 
    6668    my $self = $class->SUPER::new(%args); 
    67     $self->{base_url} = URI->new($base_url); 
    68     $self->{basic_params} = $basic_params; 
     69    $self->{base_url}        = URI->new($base_url); 
     70    $self->{basic_params}    = $basic_params; 
    6971    $self->{response_parser} = $response_parser; 
    70     $self->{cache} = $cache; 
    71     $self->{debug} = $debug; 
     72    $self->{cache}           = $cache; 
     73    $self->{debug}           = $debug; 
    7274    return $self; 
    7375} 
    7476 
    75 sub base_url { $_[0]->{base_url} } 
    76 sub basic_params { $_[0]->{basic_params} } 
     77sub base_url        { $_[0]->{base_url} } 
     78sub basic_params    { $_[0]->{basic_params} } 
    7779sub response_parser { $_[0]->{response_parser} } 
    78 sub cache { $_[0]->{cache} } 
    79  
    80 sub __cache_get 
    81 { 
     80sub cache           { $_[0]->{cache} } 
     81 
     82sub __cache_get { 
    8283    my $self  = shift; 
    8384    my $cache = $self->cache; 
    8485    return unless $cache; 
    8586 
    86     my $key   = $self->__cache_key( shift ); 
     87    my $key = $self->__cache_key(shift); 
    8788    return $cache->get( $key, @_ ); 
    8889} 
    8990 
    90 sub __cache_set 
    91 { 
     91sub __cache_set { 
    9292    my $self  = shift; 
    9393    my $cache = $self->cache; 
    9494    return unless $cache; 
    9595 
    96     my $key   = $self->__cache_key( shift ); 
     96    my $key = $self->__cache_key(shift); 
    9797    return $cache->set( $key, @_ ); 
    9898} 
    9999 
    100 sub __cache_remove 
    101 { 
     100sub __cache_remove { 
    102101    my $self  = shift; 
    103102    my $cache = $self->cache; 
    104103    return unless $cache; 
    105104 
    106     my $key   = $self->__cache_key( shift ); 
     105    my $key = $self->__cache_key(shift); 
    107106    return $cache->remove( $key, @_ ); 
    108107} 
    109108 
    110 sub __cache_key 
    111 { 
    112     my $self  = shift; 
     109sub __cache_key { 
     110    my $self = shift; 
    113111    local $Data::Dumper::Indent   = 1; 
    114112    local $Data::Dumper::Terse    = 1; 
    … …  
    121119    my %args = @_; 
    122120 
    123     my $uri = URI->new($args{url}); 
    124     if(my $extra_path = $args{extra_path}){ 
     121    my $uri = URI->new( $args{url} ); 
     122    if ( my $extra_path = $args{extra_path} ) { 
    125123        $extra_path =~ s!^/!!; 
    126         $uri->path( $uri->path . $extra_path); 
     124        $uri->path( $uri->path . $extra_path ); 
    127125    } 
    128126 
    129127    my $params = $args{params}; 
    130128    if ($params) { 
    131         foreach my $key (keys %$params) { 
    132             if (utf8::is_utf8($params->{$key})) { 
     129        foreach my $key ( keys %$params ) { 
     130            if ( utf8::is_utf8( $params->{$key} ) ) { 
    133131                $params->{$key} = utf8::encode( $params->{$key} ); 
    134132            } 
    135133        } 
    136         $uri->query_form( %$params ); 
     134        $uri->query_form(%$params); 
    137135    } 
    138136 
    … …  
    142140sub get { 
    143141    my $self = shift; 
    144     my ($url, %extra); 
    145  
    146     if (ref $_[0] eq 'HASH') { 
    147         $url = ""; 
    148         %extra = %{shift @_}; 
    149     } else { 
     142    my ( $url, %extra ); 
     143 
     144    if ( ref $_[0] eq 'HASH' ) { 
     145        $url   = ""; 
     146        %extra = %{ shift @_ }; 
     147    } 
     148    else { 
    150149        $url = shift @_; 
    151         if (ref $_[0] eq 'HASH') { 
    152             %extra = %{ shift @_ } 
     150        if ( ref $_[0] eq 'HASH' ) { 
     151            %extra = %{ shift @_ }; 
    153152        } 
    154153    } 
    … …  
    157156        url        => $self->base_url, 
    158157        extra_path => $url, 
    159         params     => { %{$self->basic_params}, %extra } 
    160     ); 
    161     print  "Request URL is $uri\n" if $self->{debug}; 
     158        params     => { %{ $self->basic_params }, %extra } 
     159    ); 
     160    print "Request URL is $uri\n" if $self->{debug}; 
    162161 
    163162    my @headers = @_; 
    164163 
    165164    my $response; 
    166     $response = $self->__cache_get([$uri, @headers]); 
     165    $response = $self->__cache_get( [ $uri, @headers ] ); 
    167166    if ($response) { 
    168167        return $response; 
    169168    } 
    170169 
    171     $response = $self->SUPER::get($uri, @headers); 
    172     if (! $response->is_success) { 
     170    $response = $self->SUPER::get( $uri, @headers ); 
     171    if ( !$response->is_success ) { 
    173172        Carp::croak("request to $uri failed"); 
    174173    } 
    … …  
    178177        parser   => $self->response_parser 
    179178    ); 
    180     $self->__cache_set([$uri, @headers], $response); 
     179    $self->__cache_set( [ $uri, @headers ], $response ); 
    181180    return $response; 
    182181} 
    183182 
    184 sub post 
    185 { 
    186     my ($self, $url, @params) = @_; 
     183sub post { 
     184    my ( $self, $url, @params ) = @_; 
    187185 
    188186    # XXX - do not include params 
    189187    my $uri = $self->request_url( 
    190         url => $self->base_url, 
     188        url        => $self->base_url, 
    191189        extra_path => $url 
    192190    ); 
    … …  
    195193    # of push 
    196194    unshift @params, %{ $self->basic_params }; 
    197     my $response = $self->SUPER::post($uri, @params ); 
    198  
    199     if (! $response->is_success) { 
    200         Carp::croak("request to $url failed: " . $response->status_line); 
     195    my $response = $self->SUPER::post( $uri, @params ); 
     196 
     197    if ( !$response->is_success ) { 
     198        Carp::croak( "request to $url failed: " . $response->status_line ); 
    201199    } 
    202200    $response = WebService::Simple::Response->new_from_response(