#!/usr/bin/env perl
use strict;
use warnings;

use Config::Pit;
use Getopt::Long;
use IO::Select;
use IO::Socket;
use MIME::Base64;
use Pod::Usage;
use WWW::HatenaLogin;

GetOptions(
    'front=s' => \my $front,
    'back=s'  => \my $back,
    'shape=s' => \my $shape,
    'lat=s'   => \my $lat,
    'lng=s'   => \my $lng,
) or pod2usage(2);
Getopt::Long::Configure("bundling"); # allows -c -v

pod2usage(2) unless $front && $back && $shape;

$lat ||= '39.581375000';
$lng ||= '141.175125000';

my($front_data, $back_data, $shape_data);
{
    local $/;
    $front_data = Path::Class::File->new($front)->slurp or die "Can’t read $front: $!";
    $back_data  = Path::Class::File->new($back)->slurp or die "Can’t read $back: $!";
    $shape_data = Path::Class::File->new($shape)->slurp or die "Can’t read $shape: $!";
}

my $config = pit_get('hatena', require => {
    username => 'your username on hatena',
    password => 'your password on hatena'
});


my $sock = IO::Socket::INET->new(
    PeerAddr => 'w.hatena.ne.jp',
    PeerPort => 28000,
    Proto    => 'tcp') or die $!;

my $login = WWW::HatenaLogin->new({ %$config });

my $select = IO::Select->new;
$select->add($sock);
my $seq = 1082;
sub send_ {
    my $line = join "\t", $seq++, @_;
    $line .= "\r\n";
    print $sock $line;
    $sock->flush;
    print $line;

    for my $fh ($select->can_read(2)) {
        sysread($fh, my $buf, 4096);
        print "$buf\n";
    }
}

send_ 'hello', '1.0', 'WORLD/1.0';
send_ 'user.login', 'rk', $config->{username}, $login->session_id, $lng, $lat, 0;

$login->mech->add_header( Referer => 'http://w.hatena.ne.jp/swf/HatenaWorld.swf?'.time() );
$login->mech->post(
    sprintf('http://w.hatena.ne.jp/%s/skin.upload', $config->{username}),
    {
        front  => encode_base64($front_data),
        back   => encode_base64($back_data),
        anchor => $shape_data,
    }
);
send_ 'agent.change_skin', $login->mech->content;

close $sock;
#$login->logout;

exit 0;

__END__

=head1 SYNOPSIS

    $ isoginner -f front.png -b back.png -s shape.xml

=head1 画像ファイル

front.png/back.pngは縦400横300のpngファイルが使えます。

=head1 shape.xml

<?xml version="1.0" encoding="UTF-8" ?>
<HatenaWorld>
  <Vertex x="105" y="0"/>
  <Vertex x="196" y="0"/>
  <Vertex x="299" y="1"/>
  <Vertex x="195" y="0"/>
  <Vertex x="299" y="2"/>
  <Vertex x="299" y="0"/>
  <Vertex x="299" y="0"/>
  <Vertex x="298" y="0"/>
  <Vertex x="297" y="0"/>
  <Vertex x="297" y="0"/>
  <Vertex x="299" y="389"/>
  <Vertex x="285" y="394"/>
  <Vertex x="297" y="399"/>
  <Vertex x="162" y="399"/>
  <Vertex x="161" y="391"/>
  <Vertex x="153" y="389"/>
  <Vertex x="146" y="392"/>
  <Vertex x="146" y="399"/>
  <Vertex x="3" y="398"/>
  <Vertex x="12" y="392"/>
  <Vertex x="0" y="391"/>
  <Vertex x="0" y="0"/>
  <Vertex x="0" y="2"/>
  <Vertex x="1" y="0"/>
  <Vertex x="0" y="0"/>
  <Vertex x="0" y="2"/>
  <Vertex x="100" y="0"/>
  <Vertex x="103" y="1"/>
  <Vertex x="0" y="0"/>
</HatenaWorld>

=head1 NOTE

たまに認証が弾かれるので、ブラウザの方でワールドにログインしたりログアウトしたりしてみてください。

=head1 AUTHOR

Kazuhiro Osawa

=head1 SEE ALSO

L<http://w.hatena.ne.jp/>, L<WWW::HatenaLogin>

=head1 LICENSE

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

=cut