[perl-www-contact commit] r41 - in trunk: . lib/WWW lib/WWW/Contact t

[codesite...@google.com]

Author: sachinjsk
Date: Wed Oct 29 09:22:38 2008
New Revision: 41

Added:
trunk/lib/WWW/Contact/Plaxo.pm (contents, props changed)
trunk/t/110-plaxo.t (contents, props changed)
Modified:
trunk/Changes
trunk/lib/WWW/Contact.pm

Log:
added contact import from plaxo

Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Wed Oct 29 09:22:38 2008
@@ -1,4 +1,7 @@
Revision history for WWW-Contact
+0.15 2008.10.30
+ added WWW::Contact::Plaxo by Sachin Sebastian
+
0.14 2008.10.28
added WWW::Contact::Lycos by Sachin Sebastian

Modified: trunk/lib/WWW/Contact.pm
==============================================================================
--- trunk/lib/WWW/Contact.pm (original)
+++ trunk/lib/WWW/Contact.pm Wed Oct 29 09:22:38 2008
@@ -65,9 +65,21 @@
}
);

+has 'social_network' => (
+ is => 'rw',
+ isa => 'HashRef',
+ auto_deref => 1,
+ default => sub {
+ {
+ # Social networks.
+ 'plaxo' => 'Plaxo',
+ }
+ }
+);
+
sub get_contacts {
my $self = shift;
- my ( $email, $password ) = @_;
+ my ( $email, $password, $social_network ) = @_;

unless ( $email and $password ) {
$self->errstr('Both email and password are required.');
@@ -82,9 +94,19 @@
my ( $username, $postfix ) = ( lc($1), lc($2) );

# get supplier module
- my $supplier = $self->get_supplier_by_email($email);
+ my $supplier;
+ if($social_network) {
+ $social_network = lc($social_network);
+ $supplier = $self->get_supplier_by_socialnetwork($social_network);
+ } else {
+ $supplier = $self->get_supplier_by_email($email);
+ }
unless ($supplier) {
- $self->errstr("$email is not supported yet.");
+ if($social_network) {
+ $self->errstr("$social_network is not supported yet.");
+ } else {
+ $self->errstr("$email is not supported yet.");
+ }
return;
}

@@ -135,6 +157,18 @@
return;
}

+sub get_supplier_by_socialnetwork {
+ my ($self, $social_network) = @_;
+
+ my %social_supplier = $self->social_network;
+
+ if ( exists $social_supplier{ $social_network } ) {
+ return $social_supplier{ $social_network };
+ }
+
+ return;
+}
+
sub register_supplier {
my ($self, $pattern, $supplier) = @_;

@@ -157,6 +191,7 @@

use WWW::Contact;

+ # Get contacts from email providers.
my $wc = WWW::Contact->new();
my @contacts = $wc->get_contacts('fay...@gmail.com', 'password');
my $errstr = $wc->errstr;
@@ -165,6 +200,19 @@
} else {
print Dumper(\@contacts);
}
+
+ # Get contacts from social networks.(eg: Plaxo)
+ my $ws = WWW::Contact->new();
+ # Note that the last argument for get_contacts() is mandatory,
+ # or else it will try to fetch contacts from gmail.com
+ my @contacts =
$ws->get_contacts('it...@gmail.com', 'password', 'plaxo');
+ my $errstr = $ws->errstr;
+ if ($errstr) {
+ die $errstr; # like 'Wrong Username or Password'
+ } else {
+ print Dumper(\@contacts);
+ }
+

=head1 DESCRIPTION

@@ -210,6 +258,10 @@

L<WWW::Contact::Lycos> By Sachin Sebastian

+=item Plaxo
+
+L<WWW::Contact::Plaxo> By Sachin Sebastian
+
=back

=head1 METHODS
@@ -230,9 +282,15 @@
my $supplier = $wc->get_supplier_by_email('a...@gmail.com'); # 'Gmail'
my $supplier = $wc->get_supplier_by_email('a...@a.com'); # 'Unknown'

+=head2 get_supplier_by_socialnetwork
+
+get supplier by social network name.
+
+ my $supplier = $wc->get_supplier_by_socialnetwork('plaxo'); # 'Plaxo'
+
=head1 HOW TO WRITE YOUR OWN MODULE

-please read L<WWW::Contact::Base> and examples: L<WWW::Contact::Yahoo> and
L<WWW::Contact::Gmail>
+please read L<WWW::Contact::Base> and examples: L<WWW::Contact::Yahoo> and
L<WWW::Contact::Plaxo>

Assuming we write a custom module as WWW::Contact::Unknown

@@ -248,7 +306,7 @@
$self->errstr(undef);

if ($email eq 'a...@a.com' and $password ne 'a') {
- $self->errstr('Wrong Password');
+ $self->errstr('Wrong Username or Password');
return;
}

Added: trunk/lib/WWW/Contact/Plaxo.pm
==============================================================================
--- (empty file)
+++ trunk/lib/WWW/Contact/Plaxo.pm Wed Oct 29 09:22:38 2008
@@ -0,0 +1,119 @@
+package WWW::Contact::Plaxo;
+
+use Moose;
+extends 'WWW::Contact::Base';
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:SACHINJSK';
+
+has '+ua_class' => ( default => 'WWW::Mechanize::GZip' );
+
+sub get_contacts {
+ my ($self, $email, $password) = @_;
+
+ # reset errstr
+ $self->errstr(undef);
+ my @contacts;
+
+ my $ua = $self->ua;
+ $self->debug("start get_contacts from Plaxo");
+
+ # get to login form
+ $self->get('https://www.plaxo.com/signin') || return;
+
+ $self->submit_form(
+ form_name => 'form',
+ fields => {
+ 'signin.email' => $email,
+ 'signin.password' => $password,
+ },
+ ) || return;
+
+ my $content = $ua->content();
+ if ($content =~ /too many login failures/ig) {
+ $self->errstr('Account has had too many login failures recently
and has been temporarily locked');
+ return;
+ }
+ elsif ($content =~ /Sign in to Plaxo/ig) {
+ $self->errstr('Wrong Username or Password');
+ return;
+ }
+
+ $self->debug('Login OK');
+
+ $self->get("http://www.plaxo.com/export/plaxo_ab_outlook.csv");
+
+ $self->submit_form(
+ form_name => 'form'
+ ) || return;
+
+ my $address_content = $ua->content();
+ @contacts = get_contacts_from_csv($address_content);
+
+ return wantarray ? @contacts : \@contacts;
+}
+
+sub get_contacts_from_csv {
+ my ($csv) = shift;
+ my @contacts;
+
+ # title, first_name, middle_name, last_name, suffix, e-mail.
+ my @lines = split(/\n/, $csv);
+ shift @lines; # skip the first line
+ foreach my $line (@lines) {
+ $line =~ s/"//g;
+ my @cols = split(',', $line);
+ push @contacts, {
+ name => $cols[1].' '.$cols[3],
+ email => $cols[5]
+ };
+ }
+
+ return wantarray ? @contacts : \@contacts;
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
+1;
+__END__
+
+=head1 NAME
+
+WWW::Contact::Plaxo - Get contacts from Plaxo
+
+=head1 SYNOPSIS
+
+ use WWW::Contact;
+
+ my $wc = WWW::Contact->new();
+ # Note that the last argument for get_contacts is mandatory,
+ # or else it will try to fetch contacts from email.com
+ my @contacts =
$wc->get_contacts('it...@email.com', 'password', 'plaxo');
+ my $errstr = $wc->errstr;
+ if ($errstr) {
+ die $errstr;
+ } else {
+ print Dumper(\@contacts);
+ }
+
+=head1 DESCRIPTION
+
+get contacts from plaxo. extends L<WWW::Contact::Base>
+
+=head1 SEE ALSO
+
+L<WWW::Contact>, L<WWW::Contact::Base>, L<WWW::Mechanize::GZip>
+
+=head1 AUTHOR
+
+Sachin Sebastian, C<< <sachinjsk at cpan.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Sachin Sebastian, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut

Added: trunk/t/110-plaxo.t
==============================================================================
--- (empty file)
+++ trunk/t/110-plaxo.t Wed Oct 29 09:22:38 2008
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$Bin/lib";
+use Test::More;
+use WWW::Contact::Plaxo;
+use Data::Dumper;
+
+BEGIN {
+ unless ( $ENV{TEST_PLAXO} and $ENV{TEST_PLAXO_PASS} ) {
+ plan skip_all => 'set $ENV{TEST_PLAXO} and $ENV{TEST_PLAXO_PASS}
to test';
+ }
+ plan tests => 4;
+}
+
+my $wc = new WWW::Contact::Plaxo->new();
+
+my @contacts = $wc->get_contacts('cp...@gmail.com', 'letmein', 'plaxo');
+my $errstr = $wc->errstr;
+is($errstr, 'Wrong Username or Password', 'get error with wrong password');
+is(scalar @contacts, 0, 'empty contact list');
+
+{
+ @contacts = $wc->get_contacts($ENV{TEST_PLAXO},
$ENV{TEST_PLAXO_PASS}, 'plaxo');
+ $errstr = $wc->errstr;
+ is($errstr, undef, 'no error with username or password');
+ cmp_ok(scalar @contacts, '>', 0, 'got contact list');
+ diag(Dumper(\@contacts));
+}
+1;