root/lang/perl/WWW-Slmame/trunk/lib/WWW/Slmame.pm @ 24639

package WWW::Slmame;

use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess qw/shift-jis euc-jp 7bit-jis/;
use WWW::Mechanize;
use Data::Dumper;
use Carp qw(croak);
our $VERSION = '0.01';

sub new{
    my $class = shift;
    my %args  = @_;
    $args{'wm'}        = WWW::Mechanize->new(autocheck => 1);
    $args{'site_root'} = 'http://slmame.com';
    return bless {%args}, $class;
}

sub _login{
    my $self = shift;
    $self->{wm}->get("$self->{site_root}");
    my $post = {
        login_id   => $self->{id},
        login_pass => $self->{pass},
        action     => 'login',
    };
    $self->{wm}->post("$self->{site_root}/admin/login.php",$post);
}

sub blog_select{
    my $self = shift;
    $self->_login();
    $self->{wm}->submit_form(
        form_number => $self->{blog},
        button      => "submit_entry",
    );
}

sub _decode_utf8{
    my $self    = shift;
    my $message = $self->{message};
    my $decodes = Encode::Guess->guess($message);
    ref($decodes) || die "Can't guess: $decodes";
    return decode($decodes->name, $message);
}

sub update{
    my $self    = shift;
    my $message = $self->_decode_utf8($self->{message});
    my $title   = $self->_decode_utf8($self->{title});
    $self->{wm}->set_fields(
        entry_title     => $title,
        entry_body      => $message,
        entry_body_more => '',
    );
    $self->{wm}->click_button(value => "確　認");
    $self->{wm}->click_button(value => "登録する");
}

1;
__END__

=head1 NAME

WWW::Slmame - slmame client for perl.

=head1 SYNOPSIS

  use WWW::Slmame;
  my $slmame = WWW::Slmame->new(
    id      => 'your login ID',
    pass    => 'your login Password',
    blog    => 'target blog index',
    title   => 'entry title',
    message => 'entry body',
  );
  $slmame->blog_select();
  $slmame->update();

=head1 DESCRIPTION

WWW::Slmame is slmame client for perl.

=head1 AUTHOR

Soshi Tamura, E<lt>st.hao.yayoi@gmail.comE<gt>

=head1 SEE ALSO

L<http://slmame.com/>

=head1 LICENSE

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

=over 13

=item new()
Initial method.

=item blog_select()
Select Blog that write entries.

=item update()
Update entry.

=item id
Slmame login id. Required.

=item pass
Slmame login pass. Required.

=item blog
Slmame blog index. Required.

=item title
Slmame blog entry's title. Required.

=item message
Slmame blog entry's message. Required.

=item more
Optional. Slmame blog entry's more message.

=cut