view release on metacpan or  search on metacpan

bin/tacochan  view on Meta::CPAN

#!perl
use strict;
use warnings;
use utf8;
use 5.008001;
use App::Tacochan;
use Amon2::Lite;
use Skype::Any;
use URI;
use Getopt::Long ();
use Pod::Usage;

use Plack::Builder;
use Plack::Builder::Conditionals -prefix => 'c';
use Twiggy::Server;

my $skype = Skype::Any->new(name => 'tacochan');

sub render_text {
    my ($self, $code, $message) = @_;

    $message = $self->encoding->encode($message);

    return $self->create_response(
        $code,
        [
            'Content-Type'   => 'text/plain; charset=utf-8',
            'Content-Length' => length $message,
        ],
        [$message]
    );
}

sub res_404 { $_[0]->render_text(404, 'Not Found') }

sub guess_chat {
    my ($self, $stuff) = @_;
    if ($stuff =~ /^#/) {
        # from chatname
        return $skype->chat($stuff);
    } elsif ($stuff =~ /^skype:/) {
        # from "/get uri"
        my %query = URI->new($stuff)->query_form();
        my $command = $skype->api->send_command("CHAT FINDUSINGBLOB $query{blob}");
        my @reply = $command->split_reply();
        return $skype->chat($reply[1]);
    } else {
        # from username
        return $skype->user($stuff)->chat();
    }
}

get '/' => sub {
    my ($c) = @_;
    return $c->render('index.tt' => {
        ok => scalar $skype->api->is_running,
    });
};

get '/chat_list' => sub {
    my ($c) = @_;
    unless ($skype->api->is_running) {
        return $c->render_text(500, 'Skype is not running');
    }

    my $command = $skype->api->send_command('SEARCH RECENTCHATS');
    my ($obj, $chats) = $command->split_reply(2);
    my @recentchats;
    for my $chatname (split /,\s+/, $chats) {
        my $chat = $skype->chat($chatname);
        my $topic = $chat->topic;
        push @recentchats, {
            chatname => $chatname,
            status   => $chat->status,
            members  => [split /\s+/, $chat->members],
            $topic ? (topic => $topic) : (),
        };
    }
    return $c->render_json(\@recentchats);
};

post qr!^/(?:leave|part)$! => sub {
    my ($c) = @_;
    unless ($skype->api->is_running) {
        return $c->render_text(500, 'Skype is not running')
    }

    my $chat = $c->req->param('chat');

    my $chat_obj = $c->guess_chat($chat);
    eval {
        $chat_obj->alter('leave');
    };
    if ($@) {
        return $c->render_text(403, "leave failure chat: $chat");
    }
    return $c->render_text(200, "leave success chat: $chat");
};

post qr!^/(?:send|notice|privmsg)$! => sub {
    my ($c) = @_;
    unless ($skype->api->is_running) {
        return $c->render_text(500, 'Skype is not running')
    }

    my $chat = $c->req->param('chat');
    my $message = $c->req->param('message');

    my $chat_obj = $c->guess_chat($chat);
    eval {
        $chat_obj->send_message($message);
    };
    if ($@) {
        return $c->render_text(403, "message sent failure chat: $chat $message");
    }
    return $c->render_text(200, "message sent chat: $chat_obj->{id} $message");
};

get '/chat_id' => sub {
    my ($c) = @_;
    unless ($skype->api->is_running) {
        return $c->render_text(500, 'Skype is not running');
    }

    my $chat = $c->req->param('chat');

    my $chat_obj = $c->guess_chat($chat);
    return $c->render_text(200, "$chat_obj->{id}");
};

__PACKAGE__->load_plugin('Web::JSON');

my $parser = Getopt::Long::Parser->new(
    config => ['no_ignore_case', 'pass_through'],
);

my %options;
my ($http_host, $http_port) = ('127.0.0.1', 4969);
my @reverse_proxy;
$parser->getoptions(
    'o|host=s'  => \$http_host,
    'p|port=i'  => \$http_port,
    'r|reverse-proxy=s' => \@reverse_proxy,
    'h|help'    => \$options{help},
    'v|version' => \$options{version},
);
pod2usage(1) if $options{help};
if ($options{version}) {
    die "tacochan $App::Tacochan::VERSION\n";
}

my $app = builder {
    if (@reverse_proxy) {
        enable c_match_if c_addr(\@reverse_proxy), 'Plack::Middleware::ReverseProxy';
    }
    enable 'Plack::Middleware::AccessLog', format => 'combined';
    __PACKAGE__->to_app(
        handle_static             => 1,
        no_x_content_type_options => 1,
        no_x_frame_options        => 1,
    );
};

$skype->attach;

warn "starting httpd: http://$http_host:$http_port/\n";
my $twiggy = Twiggy::Server->new(
    host => $http_host,
    port => $http_port,
);
$twiggy->register_service($app);

$skype->run;

__DATA__

@@ index.tt
<!DOCTYPE html>
<html>
<head>
    <meta charset="utf-8" />
    <title>tacochan</title>
    <meta name="viewport" content="width=device-width, initial-scale=1.0" />
    <link rel="stylesheet" type="text/css" href="http://netdna.bootstrapcdn.com/bootswatch/2.3.0/united/bootstrap.min.css" />
    <link rel="stylesheet" type="text/css" href="http://netdna.bootstrapcdn.com/twitter-bootstrap/2.3.0/css/bootstrap-responsive.min.css" />
    <link rel="stylesheet" href="[% uri_for('/static/css/main.css') %]" />
</head>