Skype::Anyというモジュールを書いている話

少し前に、Net::DBus::Skype::Liteというモジュールを書きました。PerlからSkype APIを叩けるのは便利なのですが、不満点がいくつかあります。

• LinuxのSkypeにしか対応していない
• 全体で2200行くらいある(Liteなのに…)
• 無駄なコードが多すぎる

そこで、Net::DBus::Skype::Liteを捨てて、マルチプラットフォームに対応した新しいモジュールSkype::Anyを作って見ることにしました。
ほぼ完成していて、以下のようなコードが動くようになっています。まだGithubにはあげていませんが。

use strict;
use warnings;
use Skype::Any;
use LWP::UserAgent;
use URI::Find;

my $ua = LWP::UserAgent->new;
my $finder = URI::Find->new(sub {
    my $url = shift;
    return $url if $url =~ m!^file://!;

    my $res = $ua->get($url);
    unless ($res->is_success) {
        my $code = $res->code;
        return "[ $code ]";
    }
    my ($title) = $res->decoded_content =~ m!<title>(.*)</title>!i;
    return "$title [ $url ]";
});

my $skype = Skype::Any->new;
$skype->message_received(sub {
    my $msg = shift;
    my $body = $msg->body;
    if ($finder->find(\$body)) {
        $msg->chat->send_message($body);
    }
});

$skype->run;

しかし、問題点があります。Macで動かないことです。
Cocoa::Growlを真似して、Cocoa::Skypeのようなものを作ってみたいのですが、うまくいってません。
今週中にCocoa::Skypeが完成しないとHokkaido.pm#6に間に合いませんね。

One more thing...

AnySan::Provider::Skype?

package AnySan::Provider::Skype;
use strict;
use warnings;
use base 'AnySan::Provider';
our @EXPORT = qw(skype);
use AnySan;
use AnySan::Receive;
use Skype::Any;
use Skype::Any::User;

{
    no warnings 'redefine';
    sub AnySan::run { Skype::Any->run }
}

sub skype {
    my(%config) = @_;
    my $self = __PACKAGE__->new(
        client => undef,
        config => \%config,
    );

    my $client = Skype::Any->new(
        name     => $config{name},
        protocol => $config{protocol},
    );
    $self->{client} = $client;

    my $nickname = $client->send_command('GET CURRENTUSERHANDLE');

    $client->message_received(sub {
        my $msg = shift;
        my $receive; $receive = AnySan::Receive->new(
            provider      => 'skype',
            event         => 'chatmessage',
            message       => $msg->body,
            nickname      => $nickname,
            from_nickname => $msg->from_handle,
            attribute     => {
                chatname  => $msg->chatname,
                dispname  => $msg->from_dispname,
                timestamp => $msg->timestamp,
                obj       => $msg,
            },
            cb            => sub { $self->event_callback($receive, @_) },
        );
        AnySan->broadcast_message($receive);
    });

    return $self;
}

sub event_callback {
    my($self, $receive, $type, @args) = @_;

    if ($type eq 'reply') {
        my $chat = $receive->attribute('obj')->chat;
        $chat->send_message($args[0]);
    }
}

sub send_message {
    my($self, $message, %args) = @_;

    my $user = Skype::Any::User->new($args{nickname});
    $user->send_message($message);
}

1;
__END__

=head1 NAME

AnySan::Provider::Skype - AnySan provides Skype API protocol

=head1 SYNOPSIS

    use AnySan;
    use AnySan::Provider::Skype;

    my $skype = skype
        name     => 'myapp',
        protocol => 8;

    $skype->send_message('message', nickname => 'echo123');

=head1 SEE ALSO

L<AnySan>, L<Skype::Any>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut