Skip to content
Browse files

lingr-ircd

  • Loading branch information...
1 parent f713554 commit a47a83099a2e3a92199f656e6ecdc8ea2cec876a @tokuhirom tokuhirom committed
Showing with 175 additions and 6 deletions.
  1. +25 −0 bin/lingr-ircd
  2. +3 −0 cpanfile
  3. +147 −6 lib/App/lingr2ircd.pm
View
25 bin/lingr-ircd
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../lib/";
+
+use Getopt::Long;
+use App::lingr2ircd;
+use AE;
+
+binmode *STDOUT, ':utf8';
+binmode *STDERR, ':utf8';
+
+my %opts;
+
+GetOptions(
+ 'ircd_host=s' => \$opts{ircd_host},
+ 'ircd_port=i' => \$opts{ircd_port},
+ 'lingr_user=s' => \$opts{lingr_user},
+ 'lingr_password=s' => \$opts{lingr_password},
+ 'lingr_api_key=s' => \$opts{lingr_api_key},
+);
+App::lingr2ircd->new(\%opts)->run;
+
+AE::cv()->recv;
View
3 cpanfile
@@ -1,5 +1,8 @@
# requires 'Exporter' => '0';
requires 'parent' => '0';
+requires 'AnyEvent::IRC::Server';
+requires 'AnyEvent';
+requires 'AnyEvent::Lingr';
# requires 'Plack' => '0.9949';
on 'configure' => sub {
View
153 lib/App/lingr2ircd.pm
@@ -4,6 +4,151 @@ use warnings;
use 5.008005;
our $VERSION = '0.0.1';
+use AnyEvent::Lingr;
+use AnyEvent::IRC::Server;
+use Encode;
+
+use Mouse;
+
+has ircd_host => (
+ is => 'rw',
+ isa => 'Str',
+ required => 1,
+ default => '127.0.0.1',
+);
+
+has ircd_port => (
+ is => 'rw',
+ isa => 'Int',
+ required => 1,
+ default => 6667,
+);
+
+has lingr_user => (
+ is => 'rw',
+ required => 1,
+);
+
+has lingr_password => (
+ is => 'rw',
+ required => 1,
+);
+
+has lingr_api_key => (
+ is => 'rw',
+ required => 0,
+);
+
+has lingr => (
+ is => 'rw',
+ required => 0,
+);
+
+has ircd => (
+ is => 'rw',
+ required => 0,
+);
+
+no Mouse;
+
+sub run {
+ my $self = shift;
+
+ $self->ircd($self->setup_ircd());
+
+ $self->lingr($self->setup_lingr());
+
+ return;
+}
+
+sub setup_ircd {
+ my $self = shift;
+
+ my $ircd = AnyEvent::IRC::Server->new(
+ host => $self->ircd_host,
+ port => $self->ircd_port,
+ );
+ $ircd->reg_cb(
+ daemon_privmsg => sub {
+ my ($irc, $nick, $chan, $text) = @_;
+ print decode_utf8("$nick, $chan, $text\n");
+ if ($self->lingr) {
+ my $room = $chan;
+ $room =~ s!^#!!;
+ $self->lingr->say($room, $text, sub {
+ print "Post okay\n";
+ });
+ } else {
+ warn "Lingr connection is not ready yet.\n";
+ }
+ },
+ );
+ $ircd->run();
+
+ return $ircd;
+}
+
+sub setup_lingr {
+ my $self = shift;
+
+ my $lingr = AnyEvent::Lingr->new(
+ user => $self->lingr_user,
+ password => $self->lingr_password,
+ api_key => $self->lingr_api_key,
+ );
+
+ $lingr->on_error(
+ sub {
+ my ($msg) = @_;
+ warn 'Lingr error: ', $msg;
+
+ # reconnect after 5 seconds,
+ my $t;
+ $t = AnyEvent->timer(
+ after => 5,
+ cb => sub {
+ $lingr->start_session;
+ undef $t;
+ },
+ );
+ }
+ );
+
+ # room info handler
+ $lingr->on_room_info(
+ sub {
+ my ($rooms) = @_;
+
+ print "Joined rooms:\n";
+ for my $room (@$rooms) {
+ print " $room->{id}\n";
+ }
+ }
+ );
+
+ # event handler
+ $lingr->on_event(
+ sub {
+ my ($event) = @_;
+
+ # print message
+ if ( my $msg = $event->{message} ) {
+ print sprintf "[%s] %s: %s\n", $msg->{room}, $msg->{nickname}, $msg->{text};
+
+ if ($msg->{speaker_id} eq $self->lingr_user) {
+ print "It's me.\n";
+ } else {
+ $self->ircd->daemon_cmd_privmsg("\@$msg->{speaker_id}", '#' . $msg->{room}, encode_utf8($msg->{text}));
+ }
+ }
+ }
+ );
+
+ # start lingr session
+ $lingr->start_session;
+
+ return $lingr;
+}
1;
@@ -13,15 +158,11 @@ __END__
=head1 NAME
-App::lingr2ircd - ...
-
-=head1 SYNOPSIS
-
- use App::lingr2ircd;
+App::lingr2ircd - IRCD gateway for lingr
=head1 DESCRIPTION
-App::lingr2ircd is
+App::lingr2ircd is IRCD gateway for lingr. Please look L<lingr2ircd> for more details.
B<THIS IS A DEVELOPMENT RELEASE. API MAY CHANGE WITHOUT NOTICE>.

0 comments on commit a47a830

Please sign in to comment.
Something went wrong with that request. Please try again.