Perl x Open Food Facts Hackathon: Paris, France - May 24-25 Learn more

SACHINJSK / WWW-Contact-0.15 / lib / WWW / Contact / Yahoo.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
—
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

              
package WWW::Contact::Yahoo;
use Moose;
extends 'WWW::Contact::Base';
our $VERSION   = '0.15';
our $AUTHORITY = 'cpan:FAYLAND';
has '+ua_class' => ( default => 'WWW::Mechanize::GZip' );
sub get_contacts {
    my ($self, $email, $password) = @_;
    # reset
    $self->errstr(undef);
    my @contacts;
     
    my $ua = $self->ua;
    $self->debug("start get_contacts from Yahoo!");
     
    # to form
    $self->get('https://login.yahoo.com/config/login_verify2?&.src=ym') || return;
    $self->submit_form(
        form_name => 'login_form',
        fields    => {
            login  => $email,
            passwd => $password,
        },
    ) || return;
    my $content = $ua->content();
    if ($content =~ /=[\'\"]yregertxt/) {
        $self->errstr('Wrong Username or Password');
        return;
    }
     
    $self->debug('Login OK');
    $self->get('http://address.mail.yahoo.com/') || return;
    $ua->follow_link( url_regex => qr/import_export/i );
     
    $ua->form_number(0); # the last form
    $self->submit_form(
        button      => 'submit[action_export_yahoo]',
    );
     
    $content = $ua->content();
    my $i;
    while ( $content
        =~ /^\"(.*?)\"\,\".*?\"\,\"(.*?)\"\,\".*?\"\,\"(.*?)\"\,\".*?\"\,\".*?\"\,\"(.*?)\"/mg
        ) {
        $i++;
        next if ( $i == 1 );    # skip the first line.
        next unless ( $3 or $4 );
        my $email = $3 || $4 . '@yahoo.com';
        my $name = ( $1 or $2 ) ? "$1 $2" : $4;
        push @contacts, {
            name       => $name,
            email      => $email,
        };;
    }
    return wantarray ? @contacts : \@contacts;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
WWW::Contact::Yahoo - Get contacts/addressbook from Yahoo! Mail
=head1 SYNOPSIS
    use WWW::Contact;
     
    my $wc       = WWW::Contact->new();
    my @contacts = $wc->get_contacts('itsa@yahoo.com', 'password');
    my $errstr   = $wc->errstr;
    if ($errstr) {
        die $errstr;
    } else {
        print Dumper(\@contacts);
    }
=head1 DESCRIPTION
get addressbook from Yahoo! Mail. extends L<WWW::Contact::Base>
=head1 SEE ALSO
L<WWW::Contact>, L<WWW::Mechanize::GZip>
=head1 AUTHOR
Fayland Lam, C<< <fayland at gmail.com> >>
=head1 COPYRIGHT & LICENSE
Copyright 2008 Fayland Lam, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut