package WWW::Contact::AOL;

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

our $VERSION   = '0.47';
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=registration.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 Username or Password');
        return;
    }
    
    $self->debug('Login OK');
    #snsRedir("https://account.login.aol.com/opr/_cqr/data/update.psp?sitedomain=registration.aol.com&authLev=1&lang=en&locale=us&acctfixsid=oar-artifact&uitype=mini&mcAuth=%2FBcAG06o0D0AAK9OARkfR06o0HkI3xp9FQJ8VlIAAA%3D%3D");
    my ($url) = ( $content =~ /snsRedir\([\"\"]([^\'\"]+)[\"\"]/ );
    
    $ua->get($url); # usually we don't care the Response status here
    
    # but we have to skip data update form
    # skip the data update
    if ($ua->content =~ /oprFormV2/) {
        eval { $ua->submit_form( form_name => 'oprFormV2' , fields => { action => 'dataUpdateSkip' } ); };
    }
    
    $self->get('http://mail.aol.com/');
    
    # http://my.screenname.aol.com/_cqr/login/login.psp?sitedomain=sns.mail.aol.com&lang=en&locale=us&authLev=0&uitype=mini&siteState=ver%3a4%7crt%3aSTANDARD%7cat%3aSNS%7cld%3amail.aol.com%7crp%3aLite%252fToday.aspx%7cuv%3aAOL%7clc%3aen-us%7cmt%3aAOL%7csnt%3aScreenName%7csid%3a721f5d19-a18f-4f11-bf35-500d91ddf6d6&seamless=novl&loginId=&_sns_width_=174&_sns_height_=196&_sns_fg_color_=373737&_sns_err_color_=C81A1A&_sns_link_color_=0066CC&_sns_bg_color_=FFFFFF&redirType=js
    $content = $ua->{content};
    if ( $content =~ /(http\:\/\/my.screenname.aol.com\/_cqr\/login\/login.psp([^\'\"]+))/s ) {
        $self->get($1) || return;
        $content = $ua->{content};
    }
    if ( $content =~ /checkErrorAndSubmitForm/ and $content =~ /\'(http\:\/\/(.*?))\'/ ) {
        $self->get($1) || return;
    }

    my ($gSuccessPath, $aol_v) = ( $ua->content() =~ /\.com\/([^\/]+)\/(aol[^\/]*)\/en\-us/ );
    $self->get( "http://mail.aol.com/$gSuccessPath/$aol_v/en-us/Lite/Today.aspx?src=bandwidth" ) || return;

    my ($uid) = ($ua->content() =~ /user\=([^\'\&]+)[\'\&]/);
    unless ($uid) {
        $self->errstr('Wrong Password');
        return;
    }
    
    # http://mail.aol.com/39598/aol/en-us/Lite/addresslist-print.aspx?command=all&sort=FirstLastNick&sortDir=Ascending&nameFormat=FirstLastNick&user=lP9ZCc0KdY
    $ua->get(
        "http://mail.aol.com/$gSuccessPath/$aol_v/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);
    @contacts = grep { lc($_->{email}) ne lc($email) } @contacts; # skip himself
    
    # we don't care if it works or not, to avoid
    # Error GETing 
    eval {
        $ua->get(
            "http://mail.aol.com/$gSuccessPath/$aol_v/en-us/common/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;
    use Data::Dumper;
    
    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