File Coverage

blib/lib/Net/Kotonoha.pm

Criterion	Covered	Total	%
statement	24	97	24.7
branch	0	32	0.0
condition	0	20	0.0
subroutine	8	20	40.0
pod	1	10	10.0
total	33	179	18.4

package Net::Kotonoha;

use strict;
use warnings;
use Carp;
use WWW::Mechanize;
use HTML::Selector::XPath qw/selector_to_xpath/;
use HTML::TreeBuilder::XPath;
use HTML::Entities qw/decode_entities/;
use Net::Kotonoha::Koto;

our $VERSION = '0.08';

sub new {
    my $class = shift;
    my %args  = @_;

    $args{mail}     ||= '';
    $args{password} ||= '';
    $args{user}     ||= '';
    $args{limit}    ||= 1000;

    croak "need to set mail and password" unless $args{mail} && $args{password};

    my $mech = WWW::Mechanize->new;
    $mech->agent_alias('Windows IE 6');
    $mech->quiet(1);
    $mech->add_header('Accept-Encoding', 'identity');
    $args{mech} = $mech;

    return bless {%args}, $class;
}

sub login {
    my $self = shift;

    return 1 if $self->{loggedin};

    $self->{mech}->get('http://kotonoha.cc');
    my $res = $self->{mech}->submit_form(
        form_number => 1,
        fields      => {
            mail     => $self->{mail},
            password => $self->{password},
        }
    );
    if ($res->is_success && $self->{mech}->uri =~ /\/home$/) { # no critic
        my $tree = HTML::TreeBuilder::XPath->new;
        $tree->parse($res->content);
        $tree->eof;
        my $user = $tree->findnodes(selector_to_xpath('dt.profileicon a'));
        my $link = $user ? $user->shift->attr('href') : '';
        if ($link =~ /^\/user\/(\w+)/) {
            $self->{loggedin} = ($self->{user} = $1);
        }
        $tree->delete;
    }
    croak "can't login kotonoha.cc" unless $self->{loggedin};
    return $self->{loggedin};
}

sub _get_list {
    my $self = shift;
    my $xpath = shift;
    my $page = shift || 'http://kotonoha.cc/home';

    $self->login unless defined $self->{loggedin};

    my $res = $self->{mech}->get( $page );
    croak "can't login kotonoha.cc" unless $res->is_success;
    return unless $res->is_success;

    my @list;

    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse($res->content);
    $tree->eof;
    foreach my $item ($tree->findnodes(selector_to_xpath($xpath))) {
        if ($item->attr('href') =~ /^\/no\/(\d+)/) {
            my $koto_no = $1;
            if ($item->as_text =~ /^(.*)\s*\(([^\)]+)\)$/) {
                push @list, {
                    koto_no => $koto_no,
                    title   => $1,
                    answers => $2
                }
            }
        }
    }
    $tree->delete;
    return \@list;
}

sub _get_stream {
    my $self = shift;
    my $xpath = shift;
    my $page = shift || 'http://kotonoha.cc/stream';

    $self->login unless defined $self->{loggedin};

    my $res = $self->{mech}->get( $page );
    croak "can't login kotonoha.cc" unless $res->is_success;
    return unless $res->is_success;

    my @list;

    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse($res->content);
    $tree->eof;
    foreach my $line ($tree->findnodes(selector_to_xpath($xpath))) {
        my $html = decode_entities($line->as_HTML);
        if ($html =~ /([^<]+)<\/a>[^<]+([^<]+)<\/a>([^ ]+)(?: [^ ]+ (.+))?$/) {
            push @list, {
                user    => $1,
                name    => $2,
                comment => $6 || '',
                answer  => $5,
                koto_no => $3,
                title   => $4,
            }
        }
    }
    $tree->delete;
    return \@list;
}

sub newer_list {
    return shift->_get_list('dl#newkoto a');
}

sub recent_list {
    return shift->_get_list('dl#recentkoto a');
}

sub hot_list {
    return shift->_get_list('dl#hot20 a');
}

sub answered_list {
    return shift->_get_list('dl#answeredkoto a');
}

sub posted_list {
    return shift->_get_list('dl#postedkoto a');
}

sub stream_list {
    return shift->_get_stream('dl#stream li');
}

sub subscribed_list {
    return shift->_get_stream('dl#subscribelist li', 'http://kotonoha.cc/inbox');
}

sub get_koto {
    my $self = shift;
    $self->login unless defined $self->{loggedin};
    return Net::Kotonoha::Koto->new(
        kotonoha => $self,
        koto_no => shift);
}

1;
__END__