commit:01ebafb74d9ed2a5bfb8a093801e004133a64dc9
author:Chip Black
committer:Chip Black
date:Sun Jul 19 02:54:27 2015 -0500
parents:
Something like a working prototype
diff --git a/server/ChatNoir/Client.pm b/server/ChatNoir/Client.pm
line changes: +119/-0
index 0000000..3d8138f
--- /dev/null
+++ b/server/ChatNoir/Client.pm
@@ -0,0 +1,119 @@
+package ChatNoir::Client;
+use Class::Accessor 'moose-like';
+use AnyEvent::XMPP::IM::Connection;
+
+use ChatNoir::Util qw/pretty_presence/;
+
+use strict;
+use v5.10;
+
+has controller => ( is => 'ro' );
+has jid        => ( is => 'ro' );
+has password   => ( is => 'rw' );
+has xmpp       => ( is => 'ro' );
+
+sub attach {
+    my ($self, %params) = @_;
+
+    if ($self->xmpp && $self->xmpp->is_connected) {
+        # If we're reattaching, check that the new password matches the original
+        if ($params{password} ne $self->password) {
+            return;
+        }
+        say "Attaching to existing XMPP connection for ", $self->jid;
+    } else {
+        # Otherwise, attempt a new connection with the given password
+        say "Creating new XMPP connection for ", $self->jid;
+        $self->{password} = $params{password};
+        $self->{xmpp} = AnyEvent::XMPP::IM::Connection->new(
+            jid => $self->jid,
+            password => $self->password,
+        );
+        $self->xmpp->connect;
+    }
+
+    if ($self->controller) {
+        $self->controller->finish(1000 => "Reconnected");
+    }
+    $self->{controller} = $params{controller};
+
+    $self->set_up_events;
+}
+
+sub set_up_events {
+    my ($self) = @_;
+
+    $self->controller->tx->on(json => sub {
+        my ($tx, $msg) = @_;
+        given ($msg->{type}) {
+            when ('message') {
+                $self->xmpp->send_message($msg->to, 'chat', undef, {
+                    body => $msg->{body}
+                });
+            }
+            when ('logout') {
+                $self->xmpp->disconnect;
+                delete $self->{xmpp};
+                $self->ws_send('logged-out');
+                say "Logged out of ", $self->jid;
+            }
+            default {
+                say "Unknown message type $msg->{type}";
+            }
+        }
+    });
+
+    $self->controller->tx->on(finish => sub {
+        delete $self->{controller};
+        say $self->jid, " detached";
+    });
+
+    $self->xmpp->reg_cb(
+        session_ready => sub {
+            $self->ws_send('logged-in');
+            say "Session ready for ", $self->xmpp->jid;
+        },
+        session_error => sub {
+            my ($err) = @_;
+            $self->ws_send('logged-out');
+            say "Session error: ", $err->string;
+        },
+        presence_update => sub {
+            my ($connection, $roster, $contact, $old_presence, $new_presence) = @_;
+            say $contact->jid, ": ", pretty_presence($old_presence),
+                               " => ", pretty_presence($new_presence);
+            $self->ws_send('presence',
+                jid => $contact->jid,
+                status => pretty_presence($new_presence),
+            );
+        },
+        message => sub {
+            my ($connection, $msg) = @_;
+            say "Message from ", $msg->from, ": ", $msg->body;
+
+            AnyEvent::XMPP::IM::Message->new(
+                from => $self->jid,
+                to => $msg->from,
+                body => $msg->body,
+            )->send($self->xmpp);
+
+            $self->ws_send('message',
+                from => $msg->from,
+                body => $msg->body,
+            );
+        }
+    );
+}
+
+sub ws_send {
+    my ($self, $type, %params) = @_;
+
+    if ($self->controller) {
+        $self->controller->send({json => {
+            type => $type,
+            %params
+        }});
+    }
+}
+
+1;

diff --git a/server/ChatNoir/Util.pm b/server/ChatNoir/Util.pm
line changes: +12/-0
index 0000000..8da814b
--- /dev/null
+++ b/server/ChatNoir/Util.pm
@@ -0,0 +1,12 @@
+package ChatNoir::Util;
+use Exporter 'import';
+@EXPORT_OK = qw/pretty_presence/;
+
+sub pretty_presence {
+    my ($presence) = @_;
+    return ($presence ?
+            ($presence->show ? $presence->show : "online") :
+            "offline");
+}
+
+1;

diff --git a/server/server.pl b/server/server.pl
line changes: +43/-0
index 0000000..e3d8e46
--- /dev/null
+++ b/server/server.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use Mojolicious::Lite;
+use AnyEvent;
+use AnyEvent::XMPP;
+use JSON;
+
+use ChatNoir::Client;
+
+use strict;
+use v5.10;
+
+my $json = JSON->new->utf8;
+my %clients;
+
+websocket '/ws' => sub {
+    my $c = shift;
+
+    $c->inactivity_timeout(300);
+    $c->rendered(101);
+
+    $c->tx->once(json => sub {
+        my ($tx, $msg) = @_;
+        
+        if ($msg->{type} ne 'login') {
+            $c->finish(1015 => "Incorrect handshake message\n");
+            return;
+        }
+        my $jid = $msg->{jid};
+        my $password = $msg->{password};
+
+        if (!(defined $jid && defined $password)) {
+            $c->finish(1015 => "Handshake must have jid and password\n");
+            return;
+        }
+
+        if (!$clients{$jid}) {
+            $clients{$jid} = ChatNoir::Client->new({jid => $jid});
+        }
+        $clients{$jid}->attach(controller => $c, password => $password);
+    });
+};
+
+app->start;