にぽたん研究所

package WebService::SyncSBS::L2H;

use strict;
use Carp;
use HTML::Entities ();
use HTTP::Request;
use XML::Atom::Client;
use URI;
use base qw(Class::Accessor::Fast);

__PACKAGE__->mk_accessors(qw(ua livedoor_id hatena_id password debug));

sub new {
    my($class, $args) = @_;
    my $self = bless {
        debug => 0,
    }, $class;
    if ($args && ref($args) eq 'HASH') {
        for my $method (keys %$args) {
            if ($class->can($method)) {
                $class->$method($args->{$method});
            }
        }
    }
    return $self->_init;
}

sub sync {
    my $self = shift;
    my $posted = $self->parse_livedoor_clip;
    $self->clip_to_hatena($posted);
}

sub _has_clip_account {
    my $self = shift;
    my $myclip_url =
        sprintf('http://clip.livedoor.com/clips/%s', $self->livedoor_id);
    my $res = $self->ua->get($myclip_url);
    return $res->is_success ? 1 : 0;
}

sub _init {
    my $self = shift;
    unless ($self->ua) {
        $self->ua(LWP::UserAgent->new);
    }
    return $self;
}

sub parse_livedoor_clip {
    my $self = shift;
    unless ($self->livedoor_id) {
        croak('set your livedoor_id before parsing.');
    }
    unless ($self->_has_clip_account) {
        croak('register to livedoor clip before using this module.');
    }
    my $clips_url = URI->new_abs(
        sprintf('/clips/%s', $self->livedoor_id), 'http://clip.livedoor.com',
    );
    my @posted = ();
    while (1) {
        my $content = $self->_get_content($clips_url->as_string);
        my $posted;
        ($posted, $clips_url) = $self->_parse_content($content);
        push @posted, @$posted;
        last unless $clips_url;
    }
    return \@posted;
}

sub _parse_content {
    my($self, $content) = @_;
    my @posted = ();
    while ($content =~ m{<div class="clip-info">\s*(.+?)\s*</li>}gs) {
        my $clip_data = $1;
        my($link) = $clip_data =~ m{
            <a\shref="\s*(.+?)\s*"\starget="_blank"\sclass="clip-link"\s
            id="link_\d+">
        }gsx;
        next unless length $link;
        my @tags = $clip_data =~ m{
            <a\shref="/clips/[^/]+/tag/.+?"\s
            class="linkgray\stag">\s*(.+?)\s*</a>
        }gx;
        my($summary) = $clip_data =~ m{
            <p\s+class="notes"\sid="notes_\d+">\s*(.*?)\s*</p>
        }gsx;
        push @posted, {
            link    => HTML::Entities::decode_entities($link),
            tags    => [map { HTML::Entities::decode_entities($_) } @tags],
            summary => HTML::Entities::decode_entities($summary),
        };
    }
    my $clips_url;
    if ($content =~ m{
        <div\sclass="pxsmall\smyclip-pager">\s+.*?
        <a\shref="([^<>]+?)"\s+class="linkgray">\xE6\xAC\xA1\xE3\x81\xAE}xs) {
        $clips_url = URI->new_abs($1, 'http://clip.livedoor.com');
    }
    return \@posted, $clips_url;
}

sub _get_content {
    my($self, $url) = @_;
    for (1 .. 10) { # try to get feed 10 times.
        my $res = $self->ua->get($url);
        if ($res->is_success) {
            return $res->content;
        }
    }
    croak("faild fetching: $url");
}

sub clip_to_hatena {
    my($self, $data) = @_;
    unless ($self->hatena_id && $self->password) {
        croak("You must set your livedoor_id and password before login.");
    }
    for my $posted (reverse @$data) {
        my $xml = $self->_make_atom_content($posted);
        my $req = HTTP::Request->new(POST => 'http://b.hatena.ne.jp/atom/post');
        $req->content_type('application/x.atom+xml');
        $req->content_length(length $xml);
        $req->content($xml);
        my $client = XML::Atom::Client->new;
        $client->username($self->hatena_id);
        $client->password($self->password);
        my $res = $client->make_request($req);
        unless ($res && $res->is_success) {
            if ($res->code == 403) {
                croak("Hatena::Bookmark authentication failed");
            }
            else {
                carp("fail to clip " . $posted->{link} .
                     "HTTP Status: " . $res->code);
            }
        }
    }
}

sub _make_atom_content {
    my($self, $posted) = @_;
    my $summary = join('', map { "[$_]" } @{$posted->{tags}});
    $summary .= $posted->{summary};
    my $xml = '<?xml version="1.0"?><entry xmlns="http://purl.org/atom/ns#">'
            . "<summary>$summary</summary>"
            . '<link type="text/html" rel="related" href="'
            . $posted->{link} . '" /></entry>';
    return $xml;
}

1;

__END__

=head1 NAME

WebService::SyncSBS::L2H - Sync livedoor clip to Hatena::Bookmark

=head1 SYNOPSIS

 use WebService::SyncSBS::L2H;
 
 my $l2h = WebService::SyncSBS::L2H->new;
 $l2h->livedoor_id('livedoor_id');
 $l2h->hatena_id('hatena_id');
 $l2h->password('password');
 $l2h->sync;

=head1 AUTHOR

nipotan E<lt>nipotan@gmail.comE<gt>

=head1 COPYRIGHT

Copyright (c) 2006 nipotan. All rights reserved.

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

=head1 SEE ALSO

L<XML::Atom::Client>, L<WebService::SyncSBS::D2H>

=cut