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

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

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

sub get_contacts {
    my ($self, $email, $password) = @_;
    
    # reset
    $self->errstr(undef);
    my @contacts;
    
    my $ua = $self->ua;
    $self->debug("start get_contacts from CN::163");
    
    # to form
    $self->get('https://reg.163.com/logins.jsp?type=1&product=mail163&url=http://entry.mail.163.com/coremail/fcg/ntesdoor2?lightweight%3D1%26verifycookie%3D1%26language%3D-1%26style%3D') || return;
    $self->submit_form(
        form_name => 'fLogin',
        fields    => {
            username => $email,
            password => $password,
        },
    ) || return;
    my $content = $ua->content();
    if ($content =~ /fLogin/) {
        $self->errstr('Wrong Username or Password');
        return;
    }
    
    $self->debug('Login OK');
    
    while ( $ua->content() =~ /URL=(.*?)\"/ ) {
        my $url = $1;
        if ( $self->{ua}->content() =~ /window.location.replace\(\"(.*?)\"/ ) {
            $self->get($1) || return;
        } else {
            $self->get($url) || return;
        }
    }
    
    my ($sid) = ( $ua->content() =~ /sid\=(\w+)(\"|\&)/ );
    unless ( $sid ) {
        $self->errstr('Unknown Error');
        return;
    }
    
    $self->get("/jy3/address/addrprint.jsp?sid=$sid") || return;
    $content = $ua->content();
    @contacts = $self->get_contacts_from_html($content);
    
    return wantarray ? @contacts : \@contacts;
}

sub get_contacts_from_html {
    my ($self, $content) = @_;

    my @contents = split('class="gTitleSub', $content);
    shift @contents;

    my @contacts;
    foreach my $con (@contents) {
        my ( $name, $email );
        if ( $con =~ /mTT\"\>(.*?)\</ ) {
            $name = $1;
        }
        if ( $con =~ /td\>\s*((.*?)\@(.*?))\</ ) {
            $email = $1;
        }
        next unless $email;
        
        my $c = { name => $name || $email, email => $email };
        push @contacts, $c;
    }

    return @contacts;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 NAME

WWW::Contact::CN::163 - Get contacts/addressbook from mail.163.com

=head1 SYNOPSIS

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

=head1 DESCRIPTION

Get contacts from mail.163.com. Extends L<WWW::Contact::Base>

=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