view release on metacpan or  search on metacpan

lib/App/SocialSKK.pm  view on Meta::CPAN

package App::SocialSKK;
use 5.008_001;
use strict;
use warnings;
use Carp qw(croak);
use UNIVERSAL::require;
use LWP::UserAgent::POE;
use base qw(App::SocialSKK::Base);

use App::SocialSKK::Protocol;

our $VERSION = '0.02';

__PACKAGE__->mk_accessors(qw(
    config
    hostname address port
    ua
    protocol
    plugins
));

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
       $self->init;
}

sub init {
    my $self = shift;
       $self->config  = {} if !$self->config;
       $self->plugins = [] if !$self->plugins;

    my %ua_options = ref $self->config->{ua_options} eq 'HASH' ? %{$self->config->{ua_options}} : ();
    $self->ua ||= LWP::UserAgent::POE->new(
        timeout => 5,
        agent   => $self->get_version,
        %ua_options,
    );

    $self->load_plugins;
    $self->protocol = App::SocialSKK::Protocol->new;
    $self->protocol->on_get_version    = sub { $self->get_version           };
    $self->protocol->on_get_serverinfo = sub { $self->get_serverinfo        };
    $self->protocol->on_get_candidates = sub { $self->get_candidates(shift) };
    $self;
}

sub load_plugins {
    my $self   = shift;
    my $prefix = sprintf '%s::Plugin', __PACKAGE__;

    for my $plugin (@{$self->config->{plugins}}) {
        my $module = join '::', $prefix, $plugin->{name};
           $module->use or croak(qq{Couldn't load plugin: $module});
        my %config = ref $plugin->{config} eq 'HASH' ? %{$plugin->{config}} : ();
        push @{$self->plugins}, $module->new({(ua => $self->ua, %config)});
    }
}

sub get_version {
    sprintf '%s/%s ' , __PACKAGE__, $VERSION;
}

sub get_serverinfo {
    my $self = shift;
    sprintf '%s:%s: ', $self->hostname, $self->address;
}

sub get_candidates {
    my ($self, $text) = @_;
    return if !defined $text;
    $text =~ s/\s*$//g;

    my @candidates;
    for my $plugin (@{$self->plugins}) {
        push @candidates, $plugin->get_candidates($text);
    }
    if (@candidates) {
        join '/', (1, @candidates, "\n")
    }
    else {
        sprintf '4%s ', $text;
    }
}