The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package WWW::Contact::Gmail;

use Moose;
extends 'WWW::Contact::Base';

our $VERSION   = '0.24';
our $AUTHORITY = 'cpan:FAYLAND';

has '+ua_class' => ( default => 'WWW::Mechanize::GZip' );

use HTML::TokeParser::Simple;

sub get_contacts {
    my ($self, $email, $password) = @_;
    
    # reset
    $self->errstr(undef);
    my @contacts;
    
    my $ua = $self->ua;
    $self->debug("start get_contacts from gmail");
    
    # to form
    $self->get('https://mail.google.com/mail/') || return;
    $self->submit_form(
        form_number => 1,
        fields      => {
            Email  => $email,
            Passwd => $password,
        }
    ) || return;
    my $content = $ua->content();
    if ($content =~ /=[\'\"]errormsg/) {
        $self->errstr('Wrong Username or Password');
        return;
    }
    
    $self->debug('Login OK');
    # use basic HTML
    $self->get('https://mail.google.com/mail/?ui=html&zy=a') || return;
    $ua->follow_link( url => '?v=cl' );
    $ua->follow_link( url => '?v=cl&pnl=a' );
    
    $content = $ua->content();
    @contacts = $self->get_contacts_from_html($content);
    
    return wantarray ? @contacts : \@contacts;
}

sub get_contacts_from_html {
    my ($self, $content) = @_;
    
    my (@names, @emails);
    
    my $start = 0;
    my $p = HTML::TokeParser::Simple->new( string => $content );
    while ( my $token = $p->get_token ) {
        if ( my $tag = $token->get_tag ) {
            # start with input checbox and <input type="checkbox" name="c"
            # end with  /table
            if ($tag eq 'input') {
                my $type = $token->get_attr('type');
                my $name = $token->get_attr('name');
                if ( $type and $type eq 'checkbox' and $name and $name eq 'c' ) {
                    $start = 1;
                }
            }
            $start = 0 if ($tag eq 'table');
            if ($start and $tag eq 'a') { # <a href="?v=ct&ct_id=0">fayland</a>
                my $href = $token->get_attr('href');
                if ( $href and $href =~ /v\=ct\&ct_id\=/ ) {
                    my $name = $p->peek(1);
                    push @names, $name;
                }
            }   
        }
        if ($start) {
			if( scalar @names > scalar @emails and $token->is_start_tag('td') ) {
				my $text = $p->peek(2);
				if ($text =~ /(\S+\@\S+)/) {
					push @emails, $1;
				} else {
				    pop @names; # remove last name for NoEmail
				}
			}
        }
    }

    my @contacts;
    foreach my $i (0 .. $#emails) {
        push @contacts, {
            name  => $names[$i],
            email => $emails[$i]
        };
    }
    
    return @contacts;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 NAME

WWW::Contact::Gmail - Get contacts/addressbook from Gmail (DEPRECATED for GoogleContactsAPI)

=head1 SYNOPSIS

    use WWW::Contact;
    use Data::Dumper;
    
    my $wc       = WWW::Contact->new();
    $wc->known_supplier->{'gmail.com'} = 'Gmail';
    my @contacts = $wc->get_contacts('itsa@gmail.com', 'password');
    my $errstr   = $wc->errstr;
    if ($errstr) {
        die $errstr;
    } else {
        print Dumper(\@contacts);
    }

=head1 DESCRIPTION

Get contacts from Gmail. Extends L<WWW::Contact::Base>, replaced by L<WWW::Contact::GoogleContactsAPI>

=head1 SEE ALSO

L<WWW::Contact>, L<WWW::Mechanize>, L<HTML::TokeParser::Simple>

=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