Permalink
Browse files

Lot of fixes to initial code

* Really helps if you put the endpoint in correctly though!
* Several more endpoints to wire up
  • Loading branch information...
1 parent 60a10a6 commit 9377e6ac5d205ef8d7f6f4064ab0c5e22973b1a4 @mrallen1 committed Nov 30, 2011
Showing with 34 additions and 43 deletions.
  1. +9 −3 Build.PL
  2. +24 −21 lib/Net/API/Gett.pm
  3. +1 −1 lib/Net/API/Gett/User.pm
  4. +0 −18 t/pod-coverage.t
View
@@ -1,4 +1,3 @@
-use 5.006;
use strict;
use warnings;
use Module::Build;
@@ -9,10 +8,17 @@ my $builder = Module::Build->new(
dist_author => q{Mark Allen <mrallen1@yahoo.com>},
dist_version_from => 'lib/Net/API/Gett.pm',
build_requires => {
- 'Test::More' => 0,
+ 'Test::More' => 0,
+ 'Moo' => 0,
+ 'Sub::Quote' => 0,
+ 'LWP' => 0,
+ 'JSON' => 0,
+ 'File::Slurp' => 0,
+
},
requires => {
- 'perl' => 5.006,
+ 'perl' => 5.010,
+ 'LWP::Protocol::https' => 0,
},
add_to_cleanup => [ 'Net-API-Gett-*' ],
create_makefile_pl => 'traditional',
View
@@ -14,6 +14,8 @@ use Scalar::Util qw(looks_like_number);
use File::Slurp qw(read_file);
use Carp qw(croak);
+use Data::Printer;
+
use Net::API::Gett::User;
use Net::API::Gett::Share;
use Net::API::Gett::File;
@@ -60,56 +62,56 @@ our $VERSION = '0.01';
has 'api_key' => (
is => 'ro',
required => 1,
- isa => quote_sub q{ die "$_[0] is not alphanumeric" unless /[a-z0-9]+/ }
+ isa => quote_sub q{ die "$_[0] is not alphanumeric" unless $_[0] =~ /[a-z0-9]+/ }
);
has 'email' => (
is => 'ro',
required => 1,
- isa => quote_sub q{ die "$_[0] is not email" unless /.+@.+/ }
+ isa => quote_sub q{ die "$_[0] is not email" unless $_[0] =~ /.+@.+/ }
);
has 'password' => (
is => 'ro',
required => 1,
- isa => quote_sub q{ die "$_[0] is not alphanumeric" unless /\w+/ }
+ isa => quote_sub q{ die "$_[0] is not alphanumeric" unless $_[0] =~ /\w+/ }
);
has 'access_token' => (
is => 'rw',
predicate => 'has_access_token',
- isa => quote_sub q{ die "$_[0] is not alphanumeric" unless /[\w\.-]+/ }
+ isa => quote_sub q{ die "$_[0] is not alphanumeric" unless $_[0] =~ /[\w\.-]+/ }
);
has 'access_token_expiration' => (
is => 'rw',
- isa => quote_sub q{ die "$_[0] is not a number" unless looks_like_number($_[0]) }
+ isa => sub { die "$_[0] is not a number" unless looks_like_number $_[0] }
);
has 'refresh_token' => (
is => 'rw',
predicate => 'has_refresh_token',
- isa => quote_sub q{ die "$_[0] is not alphanumeric" unless /[\w\.-]+/ }
+ isa => sub { die "$_[0] is not alphanumeric" unless $_[0] =~ /[\w\.-]+/ }
);
has 'base_url' => (
is => 'rw',
- default => 'https://open.ge.tt/1',
+ default => sub { 'https://open.ge.tt/1' },
);
has 'ua' => (
is => 'rw',
- isa => quote_sub q{ die "$_[0] is not LWP::UserAgent unless ref($_[0]) =~ /LWP::UserAgent/ },
- default => quote_sub q{
+ default => sub {
my $ua = LWP::UserAgent->new();
- $ua->user_agent("Net-API-Gett/$VERSION/(Perl)");
+ $ua->agent("Net-API-Gett/$VERSION/(Perl)");
return $ua;
},
+ isa => sub { die "$_[0] is not LWP::UserAgent" unless ref($_[0])=~/UserAgent/ },
);
has 'user' => (
is => 'rw',
- isa => quote_sub q{ die "$_[0] is not Net::API::Gett::User unless ref($_[0]) =~ /User/ },
+ isa => quote_sub q{ die "$_[0] is not Net::API::Gett::User" unless ref($_[0]) =~ /User/ },
);
sub _encode {
@@ -131,29 +133,30 @@ sub _send {
my $method = uc shift;
my $endpoint = shift;
my $data = shift;
- my $headers = shift;
my $url = $self->base_url . $endpoint;
- my $response;
+ my $req;
if ( $method eq "POST" ) {
- $response = $self->ua->request("POST $url", $headers, $data);
- }
- elsif ( $method eq "GET" ) {
- $response = $self->ua->request("GET $url", $headers);
+ $req = POST $url, Content => $data;
}
elsif ( $method eq "PUT" ) {
- $response = $self->ua->request("PUT $url", $headers, $data);
+ $req = PUT $url, Content => $data;
+ }
+ elsif ( $method eq "GET" ) {
+ $req = GET $url;
}
else {
croak "$method is not supported.";
}
+ my $response = $self->ua->request($req);
+
if ( $response->is_success ) {
return $self->_decode($response->content());
}
else {
- croak "$method $url said " . $response->status_line . "\n";
+ croak "$method $url said " . $response->status_line;
}
}
@@ -183,15 +186,15 @@ sub login {
$self->password);
- my $response = $self->_send('POST', '/user/login', $self->_encode(\%hr));
+ my $response = $self->_send('POST', '/users/login', $self->_encode(\%hr));
# $response is a hashref
# see https://open.ge.tt/1/doc/rest#users/login for response keys
if ( $response ) {
$self->access_token( $response->{'accesstoken'} );
$self->access_token_expiration( time + $response->{'expires'} );
- $self->refreshtoken( $response->{'refreshtoken'} );
+ $self->refresh_token( $response->{'refreshtoken'} );
$self->user( $self->_build_user( $response->{'user'} ) );
return $response;
}
View
@@ -6,7 +6,7 @@ use Carp qw(croak);
has 'userid' => (
is => 'ro',
- isa => quote_sub q{ croak "$_[0] isn't alphanumeric\n" unless $_[0] =~ /[\w-]+/ },
+ isa => sub { croak "$_[0] isn't alphanumeric\n" unless $_[0] =~ /[\w-]+/ },
);
has 'fullname' => (
View
@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
- if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
- if $@;
-
-all_pod_coverage_ok();

0 comments on commit 9377e6a

Please sign in to comment.