File Coverage

blib/lib/WebService/Google/Reader.pm

Criterion	Covered	Total	%
statement	34	36	94.4
branch			n/a
condition			n/a
subroutine	12	12	100.0
pod			n/a
total	46	48	95.8

package WebService::Google::Reader;

use strict;
use warnings;
use parent qw(Class::Accessor::Fast);

use Carp qw(croak);
use HTTP::Request::Common qw(GET POST);
use LWP::UserAgent;
use JSON;
use URI;
use URI::Escape;
use URI::QueryParam;

use WebService::Google::Reader::Constants;
use WebService::Google::Reader::Feed;
use WebService::Google::Reader::ListElement;

our $VERSION = '0.22';
$VERSION = eval $VERSION;

__PACKAGE__->mk_accessors(qw(
    auth compress error host password response scheme token ua username
));

sub new {
    my ($class, %params) = @_;

    my $self = bless { %params }, $class;

    croak q('host' is required) unless $self->host;
    my $host = $self->host;
    $host = "http://$host" unless $host =~ m[^https?://];
    $host =~ s[/+$][];
    $self->host($host);

    my $ua = $params{ua};
    unless (ref $ua and $ua->isa(q(LWP::UserAgent))) {
        $ua = LWP::UserAgent->new(
            agent => __PACKAGE__.'/'.$VERSION,
        );
        $self->ua($ua);
    }

    $self->compress(1);
    $self->debug(0);
    for my $accessor (qw( compress debug )) {
        $self->$accessor($params{$accessor}) if exists $params{$accessor};
    }

    $ua->default_header(accept_encoding => 'gzip,deflate')
        if $self->compress;

    $self->scheme($params{secure} || $params{https} ? 'https' : 'http');

    return $self;
}

sub debug {
    my ($self, $val) = @_;
    return $self->{debug} unless 2 == @_;

    my $ua = $self->ua;
    if ($val) {
        my $dump_sub = sub { $_[0]->dump(maxlength => 0); return };
        $ua->set_my_handler(request_send  => $dump_sub);
        $ua->set_my_handler(response_done => $dump_sub);
    }
    else {
        $ua->set_my_handler(request_send  => undef);
        $ua->set_my_handler(response_done => undef);
    }

    return $self->{debug} = $val;
}

## Feeds

sub feed  { shift->_feed(feed  => shift, @_) }
sub tag   { shift->_feed(tag   => shift, @_) }
sub state { shift->_feed(state => shift, @_) }

sub shared  { shift->state(broadcast => @_) }
sub starred { shift->state(starred   => @_) }
sub liked   { shift->state(like      => @_) }
sub unread  {
    shift->state(
        'reading-list', exclude => { state => 'read' }, @_
    );
}

sub search {
    my ($self, $query, %params) = @_;

    $self->_login or return;
    $self->_token or return;

    my $uri = URI->new($self->host . SEARCH_ITEM_IDS_PATH);

    my %fields = (num => $params{results} || 1000);

    my @types = grep { exists $params{$_} } qw(feed state tag);
    for my $type (@types) {
        push @{$fields{s}}, _encode_type($type, $params{$type});
    }

    $uri->query_form({ q => $query, %fields, output => 'json' });

    my $req = HTTP::Request->new(GET => $uri);
    my $res = $self->_request($req) or return;

    my @ids = do {
        my $ref = eval { from_json($res->decoded_content) } or do {
            $self->error("Failed to parse JSON response: $@");
            return;
        };
        map { $_->{id} } @{$ref->{results}};
    };
    return unless @ids;
    if (my $order = $params{order} || $params{sort}) {
        @ids = reverse @ids if 'asc' eq $order;
    }

    my $feed = (__PACKAGE__.'::Feed')->new(
        request => $req, ids => \@ids, count => $params{count} || 40,
    );
    return $self->more($feed);
}

sub more {
    my ($self, $feed) = @_;

    my $req;
    if (defined $feed->ids) {
        my @ids = splice @{$feed->ids}, 0, $feed->count;
        return unless @ids;

        my $uri = URI->new($self->host . STREAM_ITEMS_CONTENTS_PATH);
        $req = POST $uri, [ output => 'atom', map { (i => $_) } @ids ];
    }
    elsif ($feed->elem) {
        return unless defined $feed->continuation;
        return if $feed->entries < $feed->count;
        $req = $feed->request;
        my $prev_continuation = $req->uri->query_param('c') || '';
        return if $feed->continuation eq $prev_continuation;
        $req->uri->query_param(c => $feed->continuation);
    }
    elsif ($req = $feed->request) {
        # Initial request.
    }
    else { return }

    my $res = $self->_request($req) or return;

    $feed->init(Stream => $res->decoded_content(ref => 1)) or return;
    return $feed;
}

*previous = *previous = *next = *next = \&more;

## Lists

sub tags        { $_[0]->_list($_[0]->host . LIST_TAGS_PATH) }
sub feeds       { $_[0]->_list($_[0]->host . LIST_SUBS_PATH) }
sub preferences { $_[0]->_list($_[0]->host . LIST_PREFS_PATH) }
sub counts      { $_[0]->_list($_[0]->host . LIST_COUNTS_PATH) }
sub userinfo    { $_[0]->_list($_[0]->host . LIST_USER_INFO_PATH) }

## Edit tags

sub edit_tag        { shift->_edit_tag(tag   => @_) }
sub edit_state      { shift->_edit_tag(state => @_) }
sub share_tag       { shift->edit_tag(_listify(\@_), share   => 1) }
sub unshare_tag     { shift->edit_tag(_listify(\@_), unshare => 1) }
sub share_state     { shift->edit_state(_listify(\@_), share   => 1) }
sub unshare_state   { shift->edit_state(_listify(\@_), unshare => 1) }
sub delete_tag      { shift->edit_tag(_listify(\@_), delete => 1) }
sub mark_read_tag   { shift->mark_read(tag   => _listify(\@_)) }
sub mark_read_state { shift->mark_read(state => _listify(\@_)) }

sub rename_feed_tag {
    my ($self, $old, $new) = @_;

    my @tagged;
    my @feeds = $self->feeds or return;

    # Get the list of subs which are associated with the tag to be renamed.
    FEED:
    for my $feed (@feeds) {
        for my $cat ($self->categories) {
            for my $o ('ARRAY' eq ref $old ? @$old : ($old)) {
                if ($o eq $cat->label or $o eq $cat->id) {
                    push @tagged, $feed->id;
                    next FEED;
                }
            }
        }
    }

    $_ = [ _encode_type(tag => $_) ] for ($old, $new);

    return $self->edit_feed(\@tagged, tag => $new, untag => $old);
}

sub rename_entry_tag {
    my ($self, $old, $new) = @_;

    for my $o ('ARRAY' eq ref $old ? @$old : ($old)) {
        my $feed = $self->tag($o) or return;
        do {
            $self->edit_entry(
                [ $feed->entries ], tag => $new, untag => $old
            ) or return;
        } while ($self->feed($feed));
    }

    return 1;
}

sub rename_tag {
    my $self = shift;
    return unless $self->rename_tag_feed(@_);
    return unless $self->rename_tag_entry(@_);
    return $self->delete_tags(shift);
}

## Edit feeds

sub edit_feed {
    my ($self, $sub, %params) = @_;

    $self->_login or return;
    $self->_token or return;

    my $url = $self->host . EDIT_SUB_PATH;

    my %fields;
    for my $s ('ARRAY' eq ref $sub ? @$sub : ($sub)) {
        if (__PACKAGE__.'::Feed' eq ref $s) {
            my $id = $s->id or next;
            $id =~ s[^(?:user|webfeed|tag:google\.com,2005:reader/)][];
            $id =~ s[\?.*][];
            push @{$fields{s}}, $id;
        }
        else {
            push @{$fields{s}}, _encode_type(feed => $s);
        }
    }
    return 1 unless @{$fields{s} || []};

    if (defined(my $title = $params{title})) {
        $fields{t} = $title;
    }

    if (grep { exists $params{$_} } qw(subscribe add)) {
        $fields{ac} = 'subscribe';
    }
    elsif (grep { exists $params{$_} } qw(unsubscribe remove)) {
        $fields{ac} = 'unsubscribe';
    }
    else {
        $fields{ac} = 'edit';
    }

    # Add a tag or state.
    for my $t (qw(tag state)) {
        next unless exists $params{$t};
        defined(my $p = $params{$t}) or next;
        for my $a ('ARRAY' eq ref $p ? @$p : ($p)) {
            push @{$fields{a}}, _encode_type($t => $a);
        }
    }
    # Remove a tag or state.
    for my $t (qw(untag unstate)) {
        next unless exists $params{$t};
        defined(my $p = $params{$t}) or next;
        for my $d ('ARRAY' eq ref $p ? @$p : ($p)) {
            push @{$fields{r}}, _encode_type(substr($t, 2) => $d);
        }
    }

    return $self->_edit($url, %fields);
}

sub tag_feed       { shift->edit_feed(shift, tag     => \@_) }
sub untag_feed     { shift->edit_feed(shift, untag   => \@_) }
sub state_feed     { shift->edit_feed(shift, state   => \@_) }
sub unstate_feed   { shift->edit_feed(shift, unstate => \@_) }
sub subscribe      { shift->edit_feed(_listify(\@_), subscribe   => 1) }
sub unsubscribe    { shift->edit_feed(_listify(\@_), unsubscribe => 1) }
sub mark_read_feed { shift->mark_read(feed => _listify(\@_)) }
sub rename_feed    { $_[0]->edit_feed($_[1], title => $_[2]) }

## Edit entries

sub edit_entry {
    my ($self, $entry, %params) = @_;
    return unless $entry;

    $self->_login or return;
    $self->_token or return;

    my %fields = (ac => 'edit');
    for my $e ('ARRAY' eq ref $entry ? @$entry : ($entry)) {
        my $source = $e->source or next;
        my $stream_id = $source->get_attr('gr:stream-id') or next;
        push @{$fields{i}}, $e->id;
        push @{$fields{s}}, $stream_id;
    }
    return 1 unless @{$fields{i} || []};

    my $url = $self->host . EDIT_ENTRY_TAG_PATH;

    # Add a tag or state.
    for my $t (qw(tag state)) {
        next unless exists $params{$t};
        defined(my $p = $params{$t}) or next;
        for my $a ('ARRAY' eq ref $p ? @$p : ($p)) {
            push @{$fields{a}}, _encode_type($t => $a);
        }
    }
    # Remove a tag or state.
    for my $t (qw(untag unstate)) {
        next unless exists $params{$t};
        defined(my $p = $params{$t}) or next;
        for my $d ('ARRAY' eq ref $p ? @$p : ($p)) {
            push @{$fields{r}}, _encode_type(substr($t, 2) => $d);
        }
    }

    return $self->_edit($url, %fields);
}

sub tag_entry     { shift->edit_entry(shift, tag     => \@_) }
sub untag_entry   { shift->edit_entry(shift, untag   => \@_) }
sub state_entry   { shift->edit_entry(shift, state   => \@_) }
sub unstate_entry { shift->edit_entry(shift, unstate => \@_) }
sub share_entry   { shift->edit_entry(_listify(\@_), state   => 'broadcast') }
sub unshare_entry { shift->edit_entry(_listify(\@_), unstate => 'broadcast') }
sub star_entry    { shift->edit_entry(_listify(\@_), state   => 'starred') }
sub unstar_entry  { shift->edit_entry(_listify(\@_), unstate => 'starred') }
sub mark_read_entry { shift->edit_entry(_listify(\@_), state   => 'read') }
sub like_entry      { shift->edit_entry(_listify(\@_), state   => 'like') }
sub unlike_entry    { shift->edit_entry(_listify(\@_), unstate => 'like') }

# Create some aliases.
for (qw(star unstar like unlike)) {
    no strict 'refs';
    *$_ = \&{$_.'_entry'};
}

## Miscellaneous

sub mark_read {
    my ($self, %params) = @_;

    $self->_login or return;
    $self->_token or return;

    my %fields;
    my @types = grep { exists $params{$_} } qw(feed state tag);
    for my $type (@types) {
        push @{$fields{s}}, _encode_type($type, $params{$type});
    }

    return $self->_edit($self->host . EDIT_MARK_READ_PATH, %fields);
}

sub edit_preference {
    my ($self, $key, $val) = @_;

    $self->_login or return;
    $self->_token or return;

    return $self->_edit($self->host . EDIT_PREF_PATH, k => $key, v => $val);
}

sub opml {
    my ($self) = @_;

    $self->_login or return;

    my $res = $self->_request(GET($self->host . EXPORT_SUBS_PATH)) or return;

    return $res->decoded_content;
}

sub ping {
    my ($self) = @_;
    my $res = $self->_request(GET($self->host . PING_PATH)) or return;

    return 1 if 'OK' eq $res->decoded_content;

    $self->error('Ping failed: '. $res->decoded_content);
    return;
}

## Private interface

sub _request {
    my ($self, $req, $count) = @_;

    return if $count and 3 <= $count;

    # Assume all POST requests are secure.
    if ('POST' eq $req->method) {
        $req->uri->scheme('https');
    }
    elsif ('GET' eq $req->method and 'https' ne $req->uri->scheme) {
        $req->uri->scheme($self->scheme);
    }

    $req->uri->query_param(ck => time * 1000);
    $req->uri->query_param(client => $self->ua->agent);

    $req->header(authorization => 'GoogleLogin auth=' . $self->auth)
        if $self->auth;

    my $res = $self->ua->request($req);
    $self->response($res);
    if ($res->is_error) {
        # Need fresh tokens.
        if (401 == $res->code and $res->message =~ /^Token /) {
            print "Stale Auth token- retrying\n" if $self->debug;
            $self->_login(1) or return;
            return $self->_request($req, ++$count);
        }
        elsif ($res->header('X-Reader-Google-Bad-Token')) {
            print "Stale T token- retrying\n" if $self->debug;
            $self->_token(1) or return;

            # Replace the T token in the url-encoded content.
            my $uri = URI->new;
            $uri->query($req->content);
            $uri->query_param(T => $self->token);
            $req->content($uri->query);

            return $self->_request($req, ++$count);
        }

        $self->error(join ' - ',
            'Request failed', $res->status_line, $res->header('title')
        );
        return;
    }

    # Reset the error from previous requests.
    $self->error(undef);

    return $res;
}

sub _login {
    my ($self, $force) = @_;

    return 1 if $self->_public;
    return 1 if $self->auth and not $force;

    my $uri = URI->new($self->host . LOGIN_PATH);
    $uri->query_form(
        service => 'reader',
        Email   => $self->username,
        Passwd  => $self->password,
        source  => $self->ua->agent,
    );
    my $res = $self->_request(POST($uri)) or return;

    my $content = $res->decoded_content;
    my ($auth) = $content =~ m[ ^Auth=(.*)$ ]mx;
    unless ($auth) {
        $self->error('Failed to find Auth token');
        return;
    }
    $self->auth($auth);

    return 1;
}

sub _token {
    my ($self, $force) = @_;

    return 1 if $self->token and not $force;

    $self->_login($force) or return;

    my $uri = URI->new($self->host . TOKEN_PATH);
    $uri->scheme('https');
    my $res = $self->_request(GET($uri)) or return;

    return $self->token($res->decoded_content);
}

sub _public {
    return ! ($_[0]->username and $_[0]->password);
}

sub _encode_type {
    my ($type, $val, $escape) = @_;

    my @paths;
    if    ('feed'  eq $type) { @paths = _encode_feed($val, $escape) }
    elsif ('tag'   eq $type) { @paths = _encode_tag($val) }
    elsif ('state' eq $type) { @paths = _encode_state($val) }
    elsif ('entry' eq $type) { @paths = _encode_entry($val) }
    else                     { return }

    return wantarray ? @paths : shift @paths;
}

sub _encode_feed {
    my ($feed, $escape) = @_;

    my @paths;
    for my $f ('ARRAY' eq ref $feed ? @$feed : ($feed)) {
        my $path = ($escape ? uri_escape($f) : $f);
        $path = "feed/$path"
            if 'user/' ne substr $f, 0, 5 and 'feed/' ne substr $f, 0, 5;
        push @paths, $path;
    }

    return @paths;
}

sub _encode_tag {
    my ($tag) = @_;

    my @paths;
    for my $t ('ARRAY' eq ref $tag ? @$tag : ($tag)) {
        my $path = $t;
        if ($t !~ m[ ^user/(?:-|\d{20})/ ]x) {
            $path = "user/-/label/$t"
        }
        push @paths, $path;
    }

    return @paths;
}

sub _encode_state {
    my ($state) = @_;

    my @paths;
    for my $s ('ARRAY' eq ref $state ? @$state : ($state)) {
        my $path = $s;
        if ($s !~ m[ ^user/(?:-|\d{20})/ ]x) {
            $path = "user/-/state/com.google/$s";
        }
        push @paths, $path;
    }

    return @paths;
}

sub _encode_entry {
    my ($entry) = @_;

    my @paths;
    for my $e ('ARRAY' eq ref $entry ? @$entry : ($entry)) {
        my $path = $e;
        if ('tag:google.com,2005:reader/item/' ne substr $e, 0, 32) {
            $path = "tag:google.com,2005:reader/item/$e";
        }
        push @paths, $path;
    }

    return @paths;
}

sub _feed {
    my ($self, $type, $val, %params) = @_;
    return unless $val;

    $self->_login or return;

    my $path = $self->host . ($self->_public ? ATOM_PUBLIC_PATH : ATOM_PATH);
    my $uri = URI->new($path . '/' . _encode_type($type, $val, 1));

    my %fields;
    if (my $count = $params{count}) {
        $fields{n} = $count;
    }
    if (my $start_time = $params{start_time}) {
        $fields{ot} = $start_time;
    }
    if (my $order = $params{order} || $params{sort} || 'desc') {
        # m = magic/auto; not really sure what that is
        $fields{r} = 'desc' eq $order ? 'n' :
                     'asc'  eq $order ? 'o' : $order;
    }
    if (defined(my $continuation = $params{continuation})) {
        $fields{c} = $continuation;
    }
    if (my $ex = $params{exclude}) {
        for my $x ('ARRAY' eq ref $ex ? @$ex : ($ex)) {
            while (my ($xtype, $exclude) = each %$x) {
                push @{$fields{xt}}, _encode_type($xtype, $exclude);
            }
        }
    }

    $uri->query_form(\%fields);

    my $feed = (__PACKAGE__.'::Feed')->new(request => GET($uri), %params);
    return $self->more($feed);
}

sub _list {
    my ($self, $url) = @_;

    $self->_login or return;

    my $uri = URI->new($url);
    $uri->query_form({ $uri->query_form, output => 'json' });

    my $res = $self->_request(GET($uri)) or return;

    my $ref = eval { from_json($res->decoded_content) } or do {
        $self->error("Failed to parse JSON response: $@");
        return;
    };

    # Remove an unecessary level of indirection.
    my $aref = (grep { 'ARRAY' eq ref } values %$ref)[0] || [];

    for my $ref (@$aref) {
        $ref = (__PACKAGE__.'::ListElement')->new($ref)
    }

    return @$aref
}

sub _edit {
    my ($self, $url, %fields) = @_;
    my $uri = URI->new($url);
    my $req = POST($uri, [ %fields, T => $self->token ]);
    my $res = $self->_request($req) or return;

    return 1 if 'OK' eq $res->decoded_content;

    # TODO: is there a standard error format which can be reliably parsed?
    $self->error('Edit failed: '. $res->decoded_content);
    return;
}

sub _edit_tag {
    my ($self, $type, $tag, %params) = @_;
    return unless $tag;

    $self->_login or return;
    $self->_token or return;

    my %fields = (s => [ _encode_type($type => $tag) ]);
    return 1 unless @{$fields{s}};

    my $url;
    if (grep { exists $params{$_} } qw(share public)) {
        $url = $self->host . EDIT_TAG_SHARE_PATH;
        $fields{pub} = 'true';
    }
    elsif (grep { exists $params{$_} } qw(unshare private)) {
        $url = $self->host . EDIT_TAG_SHARE_PATH;
        $fields{pub} = 'false';
    }
    elsif (grep { exists $params{$_} } qw(disable delete)) {
        $url = $self->host . EDIT_TAG_DISABLE_PATH;
        $fields{ac} = 'disable-tags';
    }
    else {
        $self->error('Unknown action');
        return;
    }

    return $self->_edit($url, %fields);
}

sub _states {
    return qw(
        read kept-unread fresh starred broadcast reading-list
        tracking-body-link-used tracking-emailed tracking-item-link-used
        tracking-kept-unread like
    );
}

sub _listify {
    my ($aref) = @_;
    return (1 == @$aref and 'ARRAY' eq ref $aref->[0]) ? @$aref : $aref;
}


1;

__END__