diff --git a/bin/lingr-ircd b/bin/lingr-ircd new file mode 100755 index 0000000..b4de2dc --- /dev/null +++ b/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; diff --git a/cpanfile b/cpanfile index e1608fb..639085c 100644 --- a/cpanfile +++ b/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 { diff --git a/lib/App/lingr2ircd.pm b/lib/App/lingr2ircd.pm index c30000a..5b1ee1c 100644 --- a/lib/App/lingr2ircd.pm +++ b/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 for more details. B.