Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added XMPP service like GAE!

  • Loading branch information...
commit 23e557b58ffd50fc4625ac7d4a1d2eab41237372 1 parent d4be707
Tatsuhiko Miyagawa authored
48 eg/xmppbot/app.psgi
View
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Tatsumaki::Error;
+use Tatsumaki::Application;
+use Tatsumaki::HTTPClient;
+use JSON;
+
+package XMPPHandler;
+use base qw(Tatsumaki::Handler::XMPP);
+__PACKAGE__->asynchronous(1);
+
+use JSON;
+use URI;
+
+sub post {
+ my $self = shift;
+
+ my $message = $self->xmpp_message;
+
+ my $uri = URI->new("http://ajax.googleapis.com/ajax/services/language/translate");
+ $uri->query_form(v => "1.0", langpair => "en|ja", q => $message->body);
+
+ my $client = Tatsumaki::HTTPClient->new;
+ $client->get($uri, $self->async_cb(sub { $self->on_response($message, @_) }));
+}
+
+sub on_response {
+ my($self, $message, $res) = @_;
+ my $result = JSON::decode_json($res->content);
+ my $text = $result->{responseData}{translatedText};
+
+ $message->reply($text);
+}
+
+package main;
+use Tatsumaki::Service::XMPP;
+
+my $svc = Tatsumaki::Service::XMPP->new(
+ $ENV{XMPP_JID}, $ENV{XMPP_PASSWORD},
+);
+
+my $app = Tatsumaki::Application->new([
+ '/_services/xmpp/chat' => 'XMPPHandler',
+]);
+
+$app->add_service($svc);
+$app;
18 lib/Tatsumaki/Application.pm
View
@@ -11,10 +11,11 @@ use Tatsumaki::Middleware::BlockingFallback;
use overload q(&{}) => sub { shift->psgi_app }, fallback => 1;
-has _rules => (is => 'rw', isa => 'ArrayRef');
+has _rules => (is => 'rw', isa => 'ArrayRef');
has template => (is => 'rw', isa => 'Text::MicroTemplate::File', lazy_build => 1, handles => [ 'render_file' ]);
-has static_path => (is => 'rw', isa => 'Str', default => 'static');
+has static_path => (is => 'rw', isa => 'Str', default => 'static');
+has services => (is => 'rw', isa => 'ArrayRef[Tatsumaki::Service]', default => sub { [] });
around BUILDARGS => sub {
my $orig = shift;
@@ -98,6 +99,19 @@ sub template_path {
$self->template->{include_path};
}
+sub add_service {
+ my($self, $service) = @_;
+
+ my $application = $self;
+ Scalar::Util::weaken($application);
+ $service->start($application);
+
+ push @{$self->services}, $service;
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
1;
47 lib/Tatsumaki/Handler/XMPP.pm
View
@@ -0,0 +1,47 @@
+package Tatsumaki::Handler::XMPP;
+use Moose;
+extends 'Tatsumaki::Handler';
+
+use Tatsumaki::Service::XMPP::Message;
+
+sub xmpp_message {
+ my $self = shift;
+
+ my $params = $self->request->parameters;
+ my $env = $self->request->env->{'tatsumaki.xmpp'};
+
+ Tatsumaki::Service::XMPP::Message->new(
+ from => $params->{from},
+ to => $params->{to},
+ body => $params->{body},
+ xmpp_message => $env->{message},
+ );
+}
+
+sub post {
+ my $self = shift;
+
+ my $msg = $self->xmpp_message;
+ if ($msg->body =~ s!^/(\w+)\s+!!) {
+ my $cmd = $1;
+ my $arg = $msg->body;
+
+ my $handler = $cmd . "_command";
+ if (my $method = $self->can($handler)) {
+ $msg->command($1);
+ $msg->arg($msg->body);
+ $self->$method($msg);
+ } else {
+ $self->unhandled_command($msg, $cmd);
+ }
+ } else {
+ # what to do?
+ }
+}
+
+sub unhandled_command {
+ my($self, $msg, $cmd) = @_;
+ $msg->reply("Command /$cmd not found");
+}
+
+1;
6 lib/Tatsumaki/Service.pm
View
@@ -0,0 +1,6 @@
+package Tatsumaki::Service;
+use Moose;
+
+has application => (is => 'rw', isa => 'Tatsumaki::Application');
+
+1;
80 lib/Tatsumaki/Service/XMPP.pm
View
@@ -0,0 +1,80 @@
+package Tatsumaki::Service::XMPP;
+use Moose;
+extends 'Tatsumaki::Service';
+
+use constant DEBUG => $ENV{TATSUMAKI_XMPP_DEBUG};
+
+use AnyEvent::XMPP::Client;
+use Carp ();
+use HTTP::Request::Common;
+use HTTP::Message::PSGI;
+use namespace::clean -except => 'meta';
+
+has jid => (is => 'rw', isa => 'Str');
+has password => (is => 'rw', isa => 'Str');
+has xmpp => (is => 'rw', isa => 'AnyEvent::XMPP::Client', lazy_build => 1);
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+
+ if (@_ == 2) {
+ $class->$orig(jid => $_[0], password => $_[1]);
+ } else {
+ $class->$orig(@_);
+ }
+};
+
+sub _build_xmpp {
+ my $self = shift;
+ my $xmpp = AnyEvent::XMPP::Client->new(debug => DEBUG);
+ $xmpp->add_account($self->jid, $self->password);
+ $xmpp->reg_cb(
+ error => sub { Carp::croak @_ },
+ message => sub {
+ my($client, $acct, $msg) = @_;
+
+ return unless $msg->any_body;
+
+ my $req = POST "/_services/xmpp/chat", [ from => $msg->from, to => $acct->jid, body => $msg->body ];
+ my $env = $req->to_psgi;
+ $env->{'tatsumaki.xmpp'} = {
+ client => $client,
+ account => $acct,
+ message => $msg,
+ };
+ $env->{'psgi.streaming'} = 1;
+
+ my $res = $self->application->($env);
+ $res->(sub { my $res = shift }) if ref $res eq 'CODE';
+ },
+ contact_request_subscribe => sub {
+ my($client, $acct, $roster, $contact) = @_;
+ $contact->send_subscribed;
+
+ my $req = POST "/_services/xmpp/subscribe", [ from => $contact->jid, to => $acct->jid ];
+ my $env = $req->to_psgi;
+ $env->{'tatsumaki.xmpp'} = {
+ client => $client,
+ account => $acct,
+ contact => $contact,
+ };
+ $env->{'psgi.streaming'} = 1;
+
+ my $res = $self->application->($env);
+ $res->(sub { my $res = shift }) if ref $res eq 'CODE';
+ },
+ );
+ $xmpp;
+}
+
+sub start {
+ my($self, $application) = @_;
+ $self->application($application);
+ $self->xmpp->start;
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
+1;
21 lib/Tatsumaki/Service/XMPP/Message.pm
View
@@ -0,0 +1,21 @@
+package Tatsumaki::Service::XMPP::Message;
+use Moose;
+
+has from => (is => 'rw', isa => 'Str');
+has to => (is => 'rw', isa => 'Str');
+has body => (is => 'rw', isa => 'Str');
+has command => (is => 'rw', isa => 'Str');
+has arg => (is => 'rw', isa => 'Str');
+
+has xmpp_message => (is => 'ro', isa => 'AnyEvent::XMPP::IM::Message');
+
+sub reply {
+ my $self = shift;
+ my($body) = @_;
+
+ my $reply = $self->xmpp_message->make_reply;
+ $reply->add_body($body);
+ $reply->send;
+}
+
+1;
Please sign in to comment.
Something went wrong with that request. Please try again.