package WWW::Contact::AOL;

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

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

sub get_contacts {
    my ($self, $email, $password) = @_;
    
    # reset
    $self->errstr(undef);
    my @contacts;
    
    my ( $username ) = split('@', $email);
    
    my $ua = $self->ua;
    $self->debug("start get_contacts from AOL mail");
    
    # to form
    $self->get('https://my.screenname.aol.com/_cqr/login/login.psp?mcState=initialized&uitype=mini&sitedomain=sns.webmail.aol.com&authLev=1&seamless=novl&lang=en&locale=us') || return;
    $self->submit_form(
        form_name => 'AOLLoginForm',
        fields    => {
            loginId  => $username,
            password => $password,
        },
    ) || return;
    my $content = $ua->content();
    if ($content =~ /name\=\"loginId\"/) {
        $self->errstr('Wrong Password');
        return;
    }
    
    $self->debug('Login OK');

    my ($url) = ( $content =~ /\'(http\:\/\/(.*?))\'/ );
    $self->get($url) || return;
    $self->get('http://webmail.aol.com/');
    $content = $ua->content();
    if ( $content =~ /checkErrorAndSubmitForm/ and $content =~ /\'(http\:\/\/(.*?))\'/ ) {
        $url = $1;
        $self->get($url) || return;
    }

    my ($gSuccessPath) = ( $ua->content() =~ /\.com\/([^\/]+)\/aol/ );
    $self->get( "http://webmail.aol.com/$gSuccessPath/aol/en-us/Lite/MsgList.aspx" ) || return;

    my ($uid) = ($ua->content() =~ /user\=([^\'\&]+)[\'\&]/);
    unless ($uid) {
        $self->errstr('Wrong Password');
        return;
    }
    
    # http://webmail.aol.com/39598/aol/en-us/Lite/addresslist-print.aspx?command=all&sort=FirstLastNick&sortDir=Ascending&nameFormat=FirstLastNick&user=lP9ZCc0KdY
    $ua->get(
        "http://webmail.aol.com/$gSuccessPath/aol/en-us/Lite/addresslist-print.aspx?command=all&sort=FirstLastNick&sortDir=Ascending&nameFormat=FirstLastNick&user=$uid"
    ) || return;

    $content = $ua->content();
    @contacts = $self->get_contacts_from_html($content);
    
    # we don't care if it works or not, to avoid
    # Error GETing http://webmail-vma.webmail.aol.com/22250/aol/en-us/Shared/Logout.aspx: Forbidden at lib/WWW/Contact/AOL.pm line 64
    eval {
        $ua->get(
            "http://webmail-vma.webmail.aol.com/22250/aol/en-us/Shared/Logout.aspx"
        );
    };
    
    return wantarray ? @contacts : \@contacts;
}

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

    my @contacts;
    my @contents = split(
        '<tr><td colspan="4"><hr class="contactSeparator"></td></tr>',
        $content );
    foreach my $c (@contents) {
        my ( $firstname, $last_name, $name )
            = ( $c =~ /fullName\"\>(\S*)\s*(\S*)\s*\<i\>\((.*?)\)/ );
        my ($email1) = (
            $c =~ /\<span\>Email 1\:\<\/span\>\s*\<span\>([^<^>]*)\<\/span\>/
        );
        my ($email2) = (
            $c =~ /\<span\>Email 2\:\<\/span\>\s*\<span\>([^<^>]*)\<\/span\>/
        );
        my $email = $email1 || $email2;
        unless ($email) {
            my ($screen_name) = ( $c
                    =~ /\<span\>Screen Name\:\<\/span\>\s*\<span\>([^<^>]*)\<\/span\>/
            );
            $email = $screen_name . '@aol.com' if ($screen_name);
        }
        next unless ($email);

        push @contacts, {
            name       => $name,
            email      => $email
        };
    }
    
    return @contacts;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 NAME

WWW::Contact::AOL - Get contacts/addressbook from AOL Mail

=head1 SYNOPSIS

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

=head1 DESCRIPTION

get contacts from AOL Mail. extends L<WWW::Contact::Base>

=head1 SEE ALSO

L<WWW::Contact>, L<WWW::Mechanize>

=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