root/lang/perl/misc/WassrPod/wassrpod.pl @ 15513

#!/usr/bin/env perl
package WassrPod;
use Moose;
use HTTP::Engine;
use HTTP::Headers;
use LWP::UserAgent;
use JSON 2.11;
use DateTime;
use XML::Simple;
use Encode;

our $VERSION = '0.0.1';

use Data::Dumper;

with 'MooseX::Getopt';

has port => 
    is      => 'ro',
    isa     => 'Int',
    default => 9277; # 9277 = wassr

sub run {
    my $self = shift;
    my $engine = HTTP::Engine->new(
        interface => {
            module => 'ServerSimple',
            args   => {
                host => '127.0.0.1',
                port => $self->port,
            },
            request_handler => sub { $self->handler(@_) },
        },
    );
    $engine->run;
}

sub handler {
    my($self, $c) = @_;
    my $req = $c->req;

    my $body = '';
    if ($req->path eq 'http://twitter.com/statuses/friends_timeline.xml') {
        $body = $self->friends_timeline($req);
        $c->res->header('Content-Type' => 'application/xml');
    } elsif ($req->path eq 'http://twitter.com/statuses/update.xml') {
        $body = $self->update($req);
        $c->res->header('Content-Type' => 'application/xml');
    } elsif ($req->path =~ '^http://wassr.jp/.*$') {
        my $ua = ua($req, 'wassr.jp');
        my $res = $ua->get($req->path);
        $c->res->header('Content-Type' => $res->header('Content-Type'));
        $body = $res->content;
    } else {
        warn $req->path;
    }
    $c->res->body($body);
};

sub ua {
    my $req = shift;
    my $host = shift || 'api.wassr.jp';

    my $headers = $req->headers->clone;
    $headers->remove_header('host');
    $headers->header( Host => $host );
    $headers->remove_header('user-agent');
    $headers->header( 'User-Agent' => sprintf('%s/%s', __PACKAGE__, $VERSION) );

    my $ua = LWP::UserAgent->new(
        default_headers => $headers,
    );
    $ua->default_headers($headers);
    $ua;
}

sub friends_timeline {
    my($self, $req) = @_;

    my $ua = ua $req;

    my $ret = $ua->get('http://api.wassr.jp/statuses/friends_timeline.json');
    my $json = eval { decode_json($ret->content) };
    return '<statuses></statuses>' if $@ || !ref($json);

    my $data = {
        statuses => {
            status => [
            ]
        }
    };

    for my $status (@{ $json }) {
        my $dt = DateTime->from_epoch( epoch => $status->{epoch} );
        # $dt->set_time_zone( 'Asia/Tokyo' );
        my $user = $status->{user_login_id};
        my $tmp = {
            created_at => $dt->strftime('%a %b %d %T %z %Y'),
            id => $status->{rid},
            text => $status->{text},
            source => 'web',
            truncated => 'false',
            in_reply_to_status_id => undef,
            in_reply_to_user_id => undef,
            favorited => undef,

            user => {
                id => $user,
                name => $user,
                screen_name => $status->{user}->{screen_name},
                location => undef,
                description => undef,
                profile_image_url => $status->{user}->{profile_image_url},
                url => undef,
                protected => ''.$status->{user}->{protected},
                followers_count => 1,
            },
        };
        push @{ $data->{statuses}->{status} }, $tmp;
    }

    my $xml = XMLout($data, NoAttr => 1, KeepRoot => 1, NumericEscape => 3 );
    $xml =~ s/<statuses>/<statuses type="array">/;
    $xml = qq{<?xml version="1.0" encoding="UTF-8"?>\n$xml};
    $xml;
}

sub update {
    my($self, $req) = @_;

    my $status = $req->param('status');
    my $source = "WassrPod(@{[ $req->param('source') ]})";

    my $ua = ua $req;
    my $ret = $ua->post('http://api.wassr.jp/statuses/update.json', {
        status => $status,
        source => $source,
    });
    $ret->content;
}

package main;
WassrPod->new_with_options->run;