From 45e4fda71945954b4723ee97cbe409215abff7fc Mon Sep 17 00:00:00 2001 From: franck cuny Date: Tue, 24 Nov 2009 11:47:05 +0100 Subject: basic ideas --- lib/MooseX/Net/API.pm | 151 ++++++++++++++++++++++++++++++++++++++++++++- lib/MooseX/Net/API/Test.pm | 13 ++++ t/01_basic.t | 73 ++++++++++++++++++++++ 3 files changed, 234 insertions(+), 3 deletions(-) create mode 100644 lib/MooseX/Net/API/Test.pm create mode 100644 t/01_basic.t diff --git a/lib/MooseX/Net/API.pm b/lib/MooseX/Net/API.pm index b8a146a..d1f66bc 100644 --- a/lib/MooseX/Net/API.pm +++ b/lib/MooseX/Net/API.pm @@ -1,20 +1,165 @@ package MooseX::Net::API; -use strict; -use warnings; +use Moose::Exporter; +use Carp; +use Try::Tiny; + our $VERSION = '0.01'; +our $content_type = { + 'json' => 'application/json', + 'yaml' => 'text/x-yaml', + 'xml' => 'text/xml', +}; + +Moose::Exporter->setup_import_methods( + with_caller => [qw/net_api_method format_query require_authentication/], ); + +sub format_query { + my ( $caller, $name, %options ) = @_; + + Moose::Meta::Class->initialize($caller)->add_method( + _format => sub { + { format => $_[1]->$name, mode => $options{mode} } + } + ); +} + +my $do_authentication; +sub require_authentication { $do_authentication = $_[1] } + +sub net_api_method { + my $caller = shift; + my $name = shift; + my %options = @_; + + my $class = Moose::Meta::Class->initialize($caller); + + for (qw/api_base_url format/) { + if ( !$caller->meta->has_attribute($_) ) { + croak "attribut $_ is missing"; + } + } + + if ( !$class->meta->has_attribute('useragent') ) { + _init_useragent($class); + } + + my $code; + if ( !$options{code} ) { + $code = sub { + my $self = shift; + my %args = @_; + + if ($options{path} =~ /\$(\w+)/) { + my $match = $1; + if (my $value = delete $args{$match}) { + $options{path} =~ s/\$$match/$value/; + } + } + my $url = $self->api_base_url.$options{path}; + + my $format = $caller->_format($self); + $url .= "." . $self->format if ( $format->{mode} eq 'append' ); + + my $req; + my $uri = URI->new($url); + + my $method = $options{method}; + if ( $method =~ /^(?:GET|DELETE)$/ ) { + $uri->query_form(%args); + $req = HTTP::Request->new($method => $uri); + } + elsif ( $method =~ /^(?:POST|PUT)$/ ) { + $req = HTTP::Request->new($method => $uri); + } + else { + croak "$method is not defined"; + } + + $req->header( + 'Content-Type' => $content_type->{ $format->{format} } ) + if $format->{mode} eq 'content-type'; + #return 1; + my $res = $self->useragent->request($req); + return $res->content; + }; + } + else { + $code = delete $options{code}; + } + $class->add_method( + $name, + MooseX::Net::API::Meta::Method->new( + name => $name, + package_name => $caller, + body => $code, + %options, + ), + ); +} + +sub _request { + my $class = shift; +} + +sub _init_useragent { + my $class = shift; + try { + require LWP::UserAgent; + } + catch { + croak "no useragent defined and LWP::UserAgent is not available"; + }; + my $ua = LWP::UserAgent->new(); + $ua->env_proxy; + + $class->add_attribute( + 'useragent', + is => 'rw', + isa => 'LWP::UserAgent', + lazy => 1, + default => sub {$ua}, + ); +} + +package MooseX::Net::API::Meta::Method; + +use Moose; +extends 'Moose::Meta::Method'; +use Carp; + +has description => ( is => 'ro', isa => 'Str' ); +has path => ( is => 'ro', isa => 'Str', required => 1 ); +has method => ( is => 'ro', isa => 'Str', required => 1 ); +has params => ( is => 'ro', isa => 'ArrayRef', required => 0 ); +has required => ( is => 'ro', isa => 'ArrayRef', required => 0 ); + +sub new { + my $class = shift; + my %args = @_; + $class->SUPER::wrap(@_); + +} + 1; __END__ =head1 NAME -MooseX::Net::API - +MooseX::Net::API - Easily create client for net API =head1 SYNOPSIS use MooseX::Net::API; + net_api_method => ( + description => 'this get foo', + method => 'GET', + path => '/foo/', + arguments => qw[/user group/], + ); + =head1 DESCRIPTION MooseX::Net::API is diff --git a/lib/MooseX/Net/API/Test.pm b/lib/MooseX/Net/API/Test.pm new file mode 100644 index 0000000..2f2e428 --- /dev/null +++ b/lib/MooseX/Net/API/Test.pm @@ -0,0 +1,13 @@ +package MooseX::Net::API::Test; + +use Moose::Exporter; + +Moose::Exporter->setup_import_methods( with_caller => [qw/test_api_method/] ); + +sub test_api_method { + my $caller = shift; + my $name = shift; + my %options = @_; +} + +1; diff --git a/t/01_basic.t b/t/01_basic.t new file mode 100644 index 0000000..cc6c606 --- /dev/null +++ b/t/01_basic.t @@ -0,0 +1,73 @@ +use strict; +use warnings; +use Test::More; +use YAML::Syck; + +{ + + package fake::api; + use Moose; + use MooseX::Net::API; + + has api_base_url => ( + is => 'ro', + isa => 'Str', + default => 'http://identi.ca/api', + ); + has format => ( is => 'ro', isa => 'Str', default => 'json', ); + has api_username => ( is => 'rw', isa => 'Str', ); + has api_password => ( is => 'rw', isa => 'Str', ); + has api_key => ( is => 'rw', isa => 'Str', ); + + format_query 'format' => ( mode => 'content-type' ); + + net_api_method foo => ( + description => 'this does foo', + method => 'GET', + path => '/foo/', + code => sub { my $self = shift; $self->get_foo }, + ); + + net_api_method public => ( + description => 'this does bar', + method => 'GET', + path => '/statuses/public_timeline', + ); + + sub get_foo { return 1; } +} + +{ + + package test::fake::api; + use Moose; + use MooseX::Net::API::Test; + extends 'fake::api'; + + test_api_method foo => ( + arguments => [qw//], + expect => sub { + my $self = shift; + warn Dump \@_; + } + ); +} + +my $obj = fake::api->new(); +ok $obj, '... object created'; +is $obj->foo, 1, '... get foo returns 1'; +ok my $res = $obj->public, '... get public'; + +my $test_obj = test::fake::api->new(); + +#my @methods = $obj->meta->get_all_methods; +#foreach (@methods) { + #if ( $_->name =~ /foo/ ) { + #my @foo = $_->meta->get_attribute_list; + #warn $_->name . " : " . Dump \@foo; + #} +#} + +#is $res->code, 200, '... request ok'; +#warn $res->content; +done_testing; -- cgit 1.4.1