ishiducaの日記

■ [AnyEvent][FriendFeed]AnyEventの文脈でFriendFeedに画像とか音声とかのファイルをポストする 14:19

ポストするだけ。

feed馬鹿には FriendFeed は必須コンテンツなので、簡単になくなってもらうと困りますね。

post.pl

#!/usr/bin/env perl
use strict;
use warnings;
use MyApp::AnyEvent::FriendFeed;

my $message = "hogehoge";
my @files   = qw( path/to/image/1.jpg );

for my $file (@files) {
    die qq(! failed: "$file" not found) unless -e $file;
}

my %options = (
    file    => [ @files ],
    comment => 'comment of hogehoge',
);

my $client = MyApp::AnyEvent::FriendFeed->new(
    username => 'your username', remotekey => 'remotekey',
);

my $cv = AE::cv;

$client->post($message, %options, sub {
    my($response, $headers) = @_;

    if ($headers->{Status} ne '200') {
        warn qq(! failed $headers->{Status} $headers->{Reason}\n);
    }

    if ($response->{errorCode}) {
        warn qq(! failed $response->{errorCode}\n);
    }

    print join '\t',
        $response->{date},
        "(id: $response->{id})",
        "url: $response->{uri}",
        "$response->{body}\n";

    $cv->send;

});

$cv->recv;

今更だけど、Tatsumaki::HTTPClient をベースにしたほうが筋いいよね...orz

package MyApp::AnyEvent::FriendFeed;
use strict;
use warnings;
use Carp;
use AnyEvent;
use AnyEvent::HTTP;
use MIME::Base64;
use HTTP::Request::Common;
use HTTP::Request;
use JSON;

our $VERSION = '0.01';

my $api = 'http://friendfeed-api.com/v2/entry';

sub new {
    my $class = shift;
    my %args  = @_;

    $args{'username'}  || Carp::croak qq(! failed: "username" not found\n);
    $args{'remotekey'} || Carp::croak qq(! failed: "remotekey" not found\n);
 
    chomp(my $auth = MIME::Base64::encode( join ':', $args{username}, $args{remotekey}));

    bless {
        authorization => "Basic ${auth}",
    }, $class;
}

sub post {
    my $self = shift;
    my $body = shift || Carp::croak qq(! failed: "body" parameter not found\n);
    my $cb   = pop   || Carp::croak qq(! failed: "callback" not found\n);
    my %opts = @_;

    my $on_error  = delete $opts{on_error}  || sub { die @_; return; };
    my $on_header = delete $opts{on_header} || sub {
        my $headers = shift;
        unless ($headers->{Status} =~ /^2/) {
            $on_error->(qq(! failed: $headers->{Status} "$headers->{Reason}"\n));
            return;
        }
        return 1;
    };

    $opts{body} = $body;

    my @request_params = ($api,
        Authorization => $self->{authorization},
        Content       => \%opts
    );

    push @request_params, qw/Content_Type form-data/ if $opts{file};
    
    my $request = HTTP::Request::Common::POST(@request_params);

    my $p; $p = http_request('POST' => $api,
        headers   => $request->headers,
        body      => $request->content,
        on_header => $on_header,
        sub {
            undef $p;
            my($body, $headers) = @_;
            my $res = JSON::decode_json $body;
            $cb->($res, $headers);
        }
    );
}

1;

__END__

こっちにも https://gist.github.com/1366140