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 ($@) {