Skip to content

Instantly share code, notes, and snippets.

@btrott btrott/gist:346587
Created Mar 28, 2010

Embed
What would you like to do?
diff --git a/lib/WWW/TypePad.pm b/lib/WWW/TypePad.pm
index a9ca6a3..4433d7c 100644
--- a/lib/WWW/TypePad.pm
+++ b/lib/WWW/TypePad.pm
@@ -5,6 +5,9 @@ use 5.008_001;
our $VERSION = '0.009_01';
use Any::Moose;
+use Carp qw( croak );
+use HTTP::Request::Common;
+use HTTP::Status;
use JSON;
use LWP::UserAgent;
use Net::OAuth::Simple;
@@ -77,6 +80,7 @@ sub get_apikey {
sub uri_for {
my $api = shift;
my( $path ) = @_;
+ $path = '/' . $path unless $path =~ /^\//;
return 'http://' . $api->host . $path;
}
@@ -126,13 +130,90 @@ sub _call {
}
unless ( $res->is_success ) {
- WWW::TypePad::Error::HTTP->throw( $res );
+ WWW::TypePad::Error::HTTP->throw( $res->code, $res->content );
}
return 1 if $res->code == 204;
return JSON::decode_json( $res->content );
}
+sub call_upload {
+ my $api = shift;
+ my( $form ) = @_;
+
+ croak "call_upload requires an access token"
+ unless $api->access_token;
+
+ my $target_uri = delete $form->{target_url}
+ or croak "call_upload requires a target_url";
+
+ my $filename = delete $form->{filename}
+ or croak "call_upload requires a filename";
+
+ my $asset = delete $form->{asset} || {};
+ $asset = JSON::encode_json( $asset );
+
+ my $uri = URI->new( $api->uri_for( '/browser-upload.json' ) );
+ $uri->scheme( 'https' );
+
+ # Construct the OAuth parameters to get a signature.
+ my $nonce = Net::OAuth::Simple::AuthHeader->_nonce;
+ my $oauth_req = Net::OAuth::ProtectedResourceRequest->new(
+ consumer_key => $api->consumer_key,
+ consumer_secret => $api->consumer_secret,
+ token => $api->access_token,
+ token_secret => $api->access_token_secret,
+ request_url => $uri->as_string,
+ request_method => 'POST',
+ signature_method => 'HMAC-SHA1',
+ timestamp => time,
+ nonce => $nonce,
+ );
+ $oauth_req->sign;
+
+ # Send all of the OAuth parameters in the query string.
+ $uri->query_form( $oauth_req->to_hash );
+
+ # And now, construct the actual HTTP::Request object that contains
+ # all of the fields we need to send.
+ my $req = POST $uri,
+ 'Content-Type' => 'multipart/form-data',
+ Content => [
+ # Fake the redirect_to, since we just want to capture the
+ # 302 response, and not actually follow the redirect.
+ redirect_to => 'http://example.com/none',
+
+ target_url => $target_uri,
+ asset => $asset,
+ file => [ $filename ],
+ ];
+
+ # Disable the automatic following of redirects.
+ my $ua = LWP::UserAgent->new;
+ $ua->max_redirect( 0 );
+
+ # The response to an upload is always a redirect; if it's anything
+ # else, this indicates some internal error we weren't planning for,
+ # so bail early.
+ my $res = $ua->request( $req );
+ unless ( $res->code == RC_FOUND && $res->header( 'Location' ) ) {
+ WWW::TypePad::Error::HTTP->throw( $res );
+ }
+
+ # Otherwise, extract the response from the Location header. Successful
+ # uploads will result in a status=201 query string parameter...
+ my $loc = URI->new( $res->header( 'Location' ) );
+ my %form = $loc->query_form;
+ unless ( $form{status} == RC_CREATED ) {
+ WWW::TypePad::Error::HTTP->throw( $form{status}, $form{error} );
+ }
+
+ # ... and an asset_url, which we can GET to get back an asset
+ # dictionary.
+ my $asset_uri = $form{asset_url};
+ return $api->call_anon( GET => $asset_uri );
+}
+
package Net::OAuth::Simple::AuthHeader;
# we need Net::OAuth::Simple to make requests with the OAuth credentials
# in an Authorization header, as required by the API, rather than the query string
diff --git a/lib/WWW/TypePad/Error.pm b/lib/WWW/TypePad/Error.pm
index 13251bb..e7a2b92 100644
--- a/lib/WWW/TypePad/Error.pm
+++ b/lib/WWW/TypePad/Error.pm
@@ -13,20 +13,16 @@ use Any::Moose;
use HTTP::Status;
extends 'WWW::TypePad::Error';
-use overload q("") => sub { $_[0]->message }, fallback => 1;
+use overload q("") => sub { sprintf "%s (%d)", $_[0]->message, $_[0]->code }, fallback => 1;
has code => ( is => 'rw', isa => 'Int' );
has message => ( is => 'rw', isa => 'Str' );
-has content => ( is => 'rw', isa => 'Str' );
around BUILDARGS => sub {
my $orig = shift;
- my( $class, $res ) = @_;
- my $code = $res->code;
- my $msg = $res->message || HTTP::Status::status_message( $code );
+ my( $class, $code, $msg ) = @_;
$class->$orig(
code => $code,
message => $msg,
- content => $res->content,
);
};
diff --git a/lib/WWW/TypePad/Groups.pm b/lib/WWW/TypePad/Groups.pm
index 31f87a2..a552926 100644
--- a/lib/WWW/TypePad/Groups.pm
+++ b/lib/WWW/TypePad/Groups.pm
@@ -97,6 +97,16 @@ sub new_link_asset {
### END auto-generated
+sub upload_photo {
+ my $api = shift;
+ my( $id, $asset, $filename ) = @_;
+ return $api->base->call_upload( {
+ # No extension on this!
+ target_url => $api->prefix . '/' . $id . '/photo-assets',
+ asset => $asset,
+ filename => $filename,
+ } );
+}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.