(cache) PolycomをPerlから操作する

2010-09-07

PolycomをPerlから操作する

弊社では、東京オフィスと京都オフィスとを常時、Polycomという、ビデオチャットの高級版みたいなシステムで接続していて、東京・京都間でいつでも距離を感じさせずに自然にコミュニケーションを図れるような仕組みが整備されています。

それは便利な一方、たまに静かであるべき状況で相手側の音声が入って鬱陶しい場合があって、IRCや口頭で、近くにいるひとにマイクのミュートをお願いしたりすることがあります。最近、PolycomのWeb インタフェイスから、リモコンのような仕組みでPolycomを操作できることがわかって、それを使ってミュートすればいいじゃないかということになりました。ということはつまりなんかしらのAPIみたいなものがあるんだろうなーと思って見てみたら、案の定あったので、Perlから叩けるようにしてみました。

http://github.com/kentaro/perl-webservice-polycom-remotecontroller

以下のサンプルスクリプトでは、シェルからPolycomの各種操作（カメラの向きをかえたり、音声レベルを上下したりなど、いろいろ）を行えます。

#!/usr/bin/env perl

use strict;
use warnings;
use Config::Pit;
use Term::ReadLine;

use FindBin::libs;
use WebService::Polycom::RemoteController;

my $config = pit_get('polycom.kyoto', require => {
    host     => 'your host for polycom',
    username => 'your username for polycom',
    password => 'your password for polycom',
});

my $polycom = WebService::Polycom::RemoteController->new;
   $polycom->host($config->{host});
   $polycom->username($config->{username});
   $polycom->password($config->{password});

my $term = Term::ReadLine->new('Polycom Controller');

while (defined (my $command = $term->readline('polycom> '))) {
    my $res = $polycom->button($command);
    for my $command (@{$res->commands}) {
        printf "%s: %s\n", $command->is_success ? 'OK' : 'NG', $command->message
    }
}

http://github.com/kentaro/perl-webservice-polycom-remotecontroller/blob/master/eg/controller.pl

これだけでは何がうれしいんだという感じですが、一歩進んで、以下のようなスクリプトを書いて、社内IRCからPolycomコマンドを叩けるようにしてみました（WebService::Polycom::RemoteControllerをラップしたライブラリなどが他にあるけど、社内用なので非公開。以下は雰囲気で）。

#!/usr/bin/env perl

use strict;
use warnings;

use YAML::Syck;
use Encode;
use FindBin;
use UNIVERSAL::require;
use Getopt::Long;

use AnyEvent;
use AnyEvent::IRC::Client;

use lib      "$FindBin::Bin/../lib";
use lib glob "$FindBin::Bin/../modules/*/lib";

my $config_file = "$FindBin::Bin/../config/kyoto.yml";
GetOptions(
    "config=s" => \$config_file,
);

my $config = LoadFile($config_file);
my $polycom_class = $config->{polycom}{class};
$polycom_class->use or die $@;
my $polycom = $polycom_class->new;

my $cv     = AE::cv;
my $client = AnyEvent::IRC::Client->new;
$client->reg_cb(
    connect   => \&on_connect,
    publicmsg => \&on_publicmsg,
);

$client->connect(
    $config->{irc}{server}{host}, $config->{irc}{server}{port}, {
        user     => $config->{irc}{client}{user},
        nick     => $config->{irc}{client}{nick},
        real     => $config->{irc}{client}{real},
        password => $config->{irc}{server}{password},
        timeout  => 60,
    }
);

$cv->recv;

sub on_connect {
    my ($client, $error) = @_;
    if ($error) {
        die $error;
    }
    else {
        for my $channel (@{$config->{irc}{channels}}) {
            $client->send_srv('JOIN', '#'.$channel);
        }
    }
}

sub on_publicmsg {
    my ($client, $channel, $message) = @_;
    if ($message->{params}->[1] =~ /^@{[$config->{irc}{client}{nick}]}:\s+(.+)$/i) {
        my $command = $1;
        chomp $command;
        my $res = $polycom->button($command);
        for my $result (@{$res->commands}) {
            my $reply = sprintf "%s: %s", $result->is_success ? 'OK' : 'NG', $result->message;
            $client->send_chan(
                $channel, 'NOTICE', $channel, encode('iso-2022-jp', $reply)
            );
        }
    }
}