package Hatena::Keyword;
use strict;
use warnings;
use base qw(Class::Data::Inheritable Class::Accessor Class::ErrorHandler);
use overload '""' => \&as_string, fallback => 1;
use Carp;
use URI;
use RPC::XML;
use RPC::XML::Client;
use Jcode;

our $VERSION = 0.02;

my @Fields = qw(refcount word score cname);
__PACKAGE__->mk_accessors(@Fields);
__PACKAGE__->mk_classdata(rpc_client => RPC::XML::Client->new(
    URI->new_abs('/xmlrpc', 'http://d.hatena.ne.jp/'),
    [ useragent => join('/', __PACKAGE__, __PACKAGE__->VERSION) ]
));

BEGIN {
    no strict 'refs';
    for my $code (qw(sjis euc jis ucs2 iso_2022_jp)) {
        *$code = sub {
            my $self = shift;
            $self->{$code} and return $self->{code};
            return $self->{$code} = Jcode->new($self->word, 'utf8')->$code;
        };
    }
}

sub retrieve {
    my $class = shift;
    my $body = shift or croak sprintf 'usage %s->retrieve($text)', $class;
    my $args = shift || {};
    $args->{mode} = 'lite';
    my $res = $class->_call_rpc($body, $args)
        or $class->error($class->errstr);
    my @keywords = map { $class->_instance_from_rpcdata($_) }@{$res->{wordlist}};
    wantarray ? @keywords : \@keywords;
}

sub markup_as_html {
    my $class = shift;
    my $body = shift or croak sprintf 'usage %s->markup_as_html($text)', $class;
    my $args = shift || {};
    $args->{mode} = '';
    my $res = $class->_call_rpc($body, $args)
        or $class->error($class->errstr);
    return $res->value;
}

sub _call_rpc {
    my ($class, $body, $args) = @_;
    my $params = {
        body  => RPC::XML::string->new($body),
        score => RPC::XML::int->new($args->{score} || 0),
        mode  => RPC::XML::string->new($args->{mode} || ''),
        cname => defined $args->{cname} ? RPC::XML::array->new(
            map { RPC::XML::string->new($_) } @{$args->{cname}}
        ) : undef,
        a_target => RPC::XML::string->new($args->{a_target} || ''),
        a_class  => RPC::XML::string->new($args->{a_class} || ''),
    };
    # For all categories, It doesn't need an undefined cname value.
    delete $params->{cname} unless defined $params->{cname};

    my $res = $class->rpc_client->send_request(
        RPC::XML::request->new('hatena.setkeywordlink', $params),
    );
    ref $res ? $res : $class->error(qq/RPC Error: "$res"/);
}

sub _instance_from_rpcdata {
    my ($class, $data) = @_;
    $class->new({
        map {$_ => $data->{$_}->value  } @Fields,
    });
}

sub as_string { $_[0]->word }

1;