File Coverage

lib/WWW/A9Toolbar.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

#!/usr/bin/perl -w

package WWW::A9Toolbar;

use strict;
# use Data::Dumper;
# use Data::Dump::Streamer 'Dumper';
use WWW::Mechanize;
use WWW::Mechanize::FormFiller;
use URI;
use URI::URL;
use URI::QueryParam;
use Net::DNS;
use XML::Simple;
use List::MoreUtils 'apply';

our $VERSION = '0.01';

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

    $args = check_new_options($args);
    my $self = bless($args, $class);

    $self->{toolbarapiurl} = 'http://client.a9.com/api/toolbarapi/toolbar';
    $self->{jspurl}        = 'http://a9.com/-/search/updBm.jsp';
    $self->{lastbookmarkfetch} = 0;
    $self->connect() if($self->{connect});

    return $self;
}

sub check_new_options
{
    my ($args) = @_;

    # check for email, password and connect
    return $args;
}

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

    if(!$self->{email} || !$self->{password})
    {
        warn "No email or password specified!";
        return;
    }

    if($self->{agent})
    {
        warn "Already connected!";
        return;
    }

    my $agent = WWW::Mechanize->new( autocheck => 1 );
    $self->{agent} = $agent;

    my $formfiller = WWW::Mechanize::FormFiller->new();
    $agent->env_proxy();
    my $cookies = HTTP::Cookies->new();
    $agent->cookie_jar($cookies);

    $agent->get('http://a9.com/-/sign-in/a9SignIn.jsp?ss=1');
    $agent->form(1) if $agent->forms and scalar @{$agent->forms};
    $formfiller->add_filler( 'email' => Fixed => $self->{email} );
    $formfiller->add_filler( 'password' => Fixed => $self->{password} );
    $formfiller->fill_form($agent->current_form);
    $agent->submit();
    $self->{cookies} = $cookies;
    $self->scan_cookies();

## What happens on error?

    return 1;
}

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

    return $self->{'customer-id'} if($self->{'customer-id'});

    if(!$self->{cookies})
    {
        warn "No cookies found, not connected?";
        return undef;
    }

    $self->scan_cookies();

    return $self->{'customer-id'} if($self->{'customer-id'});

    return;
}

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

    return unless($self->{cookies});

    my ($id, $prefs, $name, $perm);

    my $scansub = sub {
        my ($version, $key, $val, $path, $domain, $port, $path_spec, $secure, $expires, $discard, $hash) = @_;
        if($domain eq 'a9.com')
        {
            $prefs = $val if($key eq 'a9Prefs');
            $id    = $val if($key eq 'a9id');
            $name  = $val if($key eq 'a9name');
            $perm  = $val if($key eq 'a9Perm');
        }
    };

    $self->{cookies}->scan( $scansub );

    $self->{'customer-id'} = $id;
    $self->{prefs}         = $prefs;
    $self->{name}          = $name;
    $self->{perm}          = $perm;
}

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

    return $self->{userdata} if($self->{userdata});

    my $uri = URI->new($self->{toolbarapiurl}, 'http');
    my $method = 'basicuserdataunique';
    $uri->query_param('method'      => $method);
    $uri->query_param('customer-id' => $self->customer_id());
#    print $uri->as_string(), "\n";
    $self->{agent}->get($uri->as_string());

#    print $self->{agent}->content(), "\n";
    my $xmlobj = XMLin($self->{agent}->content());

    my $columns = $xmlobj->{columns};
    my $newcolumns;
    while($columns =~ s/\{id:"([^"]+)", name:"([^"]+)"\}//)
    {
        push @$newcolumns, {id => $1, name => $2};
    }
    $xmlobj->{columns} = $newcolumns;

    $self->{userdata} = $xmlobj;
    return $xmlobj;
}

sub get_bookmarks
{
    my ($self, $args) = @_;
    $args->{since} = $self->{lastbookmarkfetch} || 0
        if(!defined $args->{since});
    if($args->{since} < $self->{lastbookmarkfetch})
    {
        return $self->{bookmarks};
    }
    $args->{since} *= 1000 if($args->{since} < 9999999999);

    my $uri = URI->new($self->{toolbarapiurl}, 'http');
    my $method = 'GetBookmarksChangedSinceTime';
    $uri->query_param('method'      => $method);
    $uri->query_param('customer-id' => $self->customer_id());
    $uri->query_param('bmtimestamp' => $args->{since});
    $uri->query_param('useAPI'      => 2);
    $uri->query_param('timestamp'   => $args->{since});
    $uri->query_param('clientid'    => 2);
    $uri->query_param('passback'    => 1);

    $self->{agent}->get($uri->as_string());

    my $xmlobj = XMLin($self->{agent}->content(), ForceArray => ['BookmarkEntry']);
    $self->{lastbookmarkfetch} = $xmlobj->{'a9'}{'getbookmarkschangedsincetime'}{'LastReturnedTimestamp'};

    foreach my $bm (@{$xmlobj->{'a9'}{'getbookmarkschangedsincetime'}{'BookmarkEntry'}})
    {
        $self->{bookmarks}{$bm->{guid}} = $bm;
    }

    my $prev;
    foreach my $b (values %{$self->{bookmarks}})
    {
#        $b = $bm->{guid};
        $b->{previous} = $prev;
        $prev->{next} = $b;
        $prev = $b;
    }
    $prev->{next} = undef;

#    print Dumper($self->{bookmarks});

    $self->{bookmarks} ||= {};

    return values %{$self->{bookmarks}};
#    print Dumper($self->{bookmarks});
}

sub find_bookmarks
{
    my ($self, $args) = @_;

    if(!$args->{title} && !$args->{url})
    {
        warn "Can't find bookmark without url or title";
        return;
    }
    $args->{title} ||= qr//;
    $args->{url}   ||= qr//;

    $self->get_bookmarks() if(!$self->{bookmarks});

    my @bookmarks = map {$_->{guid} } $self->{bookmarks};
    @bookmarks = grep { ( $_->{title} =~ /$args->{title}/ ||
                          ($_->{url} && $_->{url} =~ /$args->{url}/)) &&
                          $_->{deleted} eq 'false' }
                             @bookmarks;

    @bookmarks = apply { delete $_->{next}; delete $_->{previous} } @bookmarks;

    return @bookmarks;

}

sub add_bookmark
{
    my ($self, $args) = @_;
#    print Dumper($args);
    my ($title, $url, $type, $parent, $before)
        = @{$args}{qw/title url type parent before/};

    if(!$self->{bookmarks})
    {
        warn "Call get_bookmarks before trying to add any bookmarks.";
        return undef;
    }

    if($type ne 'folder' && $type ne 'url')
    {
        warn "Wrong type $type passed to get_bookmarks, use 'url' or 'folder'";
        return undef;
    }

    $parent ||= {guid => 0};

    my @sorted = sort {$a->{ordinal} <=> $b->{ordinal}}
             values(%{$self->{bookmarks}});

    my $after = $before->{previous} if($before);
    if(!$before)
    {
        $before = $sorted[0];
        $after->{ordinal} = 0;
    }

    my $ordinal = $before->{ordinal} -
        ($before->{ordinal} - $after->{ordinal})/2;

    my $method = 'AddBookmark';
    my $uri = URI->new($self->{toolbarapiurl}, 'http');
    $uri->query_param('method'      => $method);
    $uri->query_param('customer-id' => $self->customer_id());
    $uri->query_param('passback'    => 1);

    my %vars = ('clientid' => 2,
                'parentguid'  => $parent->{guid} || 0,
                'ordinal'     => $ordinal,
                'bmtype'      => $type,
                'title'       => $title,
                'url'         => $url || '',
                'useAPI'      => 2);

    $self->{agent}->post($uri->as_string(), \%vars);

#    print Dumper($self->{agent}->content);
    my $xmlresponse = XMLin($self->{agent}->content);

#    print Dumper($xmlresponse);
    if($xmlresponse->{status}{code} == 200)
    {
        # woo it worked
        $self->get_bookmarks({since => $self->{lastbookmarkfetch}});
        return $xmlresponse->{a9}{addbookmark};
    }

    warn "Failed to create bookmark n add_bookmark, " .
        $xmlresponse->{status}{code} .
        ' ' . $xmlresponse->{status}{text};
    return undef;
}

sub delete_bookmark
{
    my ($self, $args) = @_;

    if(ref($args) ne 'ARRAY')
    {
        $args = [ $args ];
    }

    foreach my $bk (@$args)
    {
        if(!$bk->{guid})
        {
            warn "Bookmark without GUID, skipping";
            return undef;
        }
        my $method = 'deletebookmark';
        my $uri = URI->new($self->{jspurl}, 'http');
        $uri->query_param('method', $method);
        $uri->query_param('clientid', 1);
        $uri->query_param('guid', $bk->{guid});
#        print "Running", $uri->as_string(), "\n";
        $self->{agent}->get($uri->as_string());
        my $xmlresult = XMLin($self->{agent}->content);
#        print Dumper($xmlresult);
        if($xmlresult->{status} ne 'success')
        {
            warn "Failed to delete " . $bk->{title};
            last;
        }
    }

    $self->get_bookmarks({since => $self->{lastbookmarkfetch}});
    return 1;
}

sub get_diary_entries
{
    my ($self, $args) = @_;

    my $method = 'AllDiary';
    my $uri = URI->new($self->{toolbarapiurl}, 'http');
    $uri->query_param('method', $method);

    $self->{agent}->get($uri->as_string());
    my $xmlresponse = XMLin($self->{agent}->content);

    print Dumper($xmlresponse);

## POST!
## wants a url?
}

sub add_diary_entry
{
    my ($self, $args) = @_;

    if(!$args->{url} || !$args->{text} || !$args->{title})
    {
        warn "add_diary_entry needs a url and a text argument";
        return;
    }

    my $diaryuri = URI->new($args->{url})->canonical();
    my $domain = $diaryuri->host();
    my $res = new Net::DNS::Resolver;
    $res->tcp_timeout(10);
    my $resolved;
    do
    {
        $domain =~ s/(.+?)\.//;
        $resolved = $res->query($domain, 'SOA');
    } until($resolved && ($resolved->answer)[0]->name eq $domain);

    my $method = 'AddDiaryEntry';
    my $uri = URI->new($self->{toolbarapiurl}, 'http');
    $uri->query_param('method', $method);
    $uri->query_param('customer-id', $self->customer_id());
    $uri->query_param('passback', 1);

    my %qvars = ('url' => $args->{url},
                 'domain' => $domain,
                 'shortannot' => $args->{text},
                 'clientid'   => 2,
                 'pagetitle'  => $args->{title},
                 'longannot'  => $args->{text},
                 'toolbarVer' => '1.3.1.154',
                 'debug'      => 'true',
                 );

    $self->{agent}->post($uri->as_string(), \%qvars);

    my $xmlresponse = XMLin($self->{agent}->content);

    return 1 if($xmlresponse->{status}{code} == 200);

    warn "Can't create diary entry: " . $xmlresponse->{status}{text};
    return undef;
}

sub remove_diary_entry
{
    my ($self, $args) = @_;

    if(!$args->{url})
    {
        warn "remove_diary_entry: URL argument missing";
        return;
    }

    my $method = 'removeEntry';
    my $uri = URI->new('http://diary.a9.com/-/diary/', 'http');
    $uri->query_param('method', $method);
    $uri->query_param('url', $args->{url});
    $self->{agent}->get($uri->as_string);

}


1;


__END__