package Orkut;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT= qw(OrkutCredentials);

use WebServer;
use IO::File;
use Time::HiRes qw( usleep );
use HTML::Form;

sub new {
    my $class= shift;
    my $user= shift;
    my $pass= shift;


    my $self= bless {
        server=> WebServer->new("http://www.orkut.com"),
        user=>$user,
        pass=>$pass,
    }, $class;

    return $self;
}

sub post {
    my ($self, @params)= @_;
    $self->{server}->httppost(@params);
}
sub get {
    my ($self, @params)= @_;
    if (!$self->{loggedin}) {
        $self->login();
    }
    $self->{server}->httpget(@params);
}
sub readfile {
    my $fn= shift;
    my $fh= IO::File->new($fn, "r") or die "$fn: $!\n";
    binmode $fh;
    my $data;
    $fh->read($data, -s $fh);
    $fh->close();

    return $data;
}
sub savefile {
    my $fn= shift;
    my $data= shift;
    my $fh= IO::File->new($fn, "w+") or die "$fn: $!\n";
    binmode $fh;
    $fh->write($data);
    $fh->close();
}
sub filename_escape {
    my $fn= shift;

    $fn =~ s/-/--/g;
    $fn =~ s/[^a-z0-9.A-Z]/sprintf("-%02x", ord($&))/ge;

    return $fn;
}
sub encodeurlasfile {
    my ($path, %params)= @_;

    $path =~ s/^\///;

    return "cache/".join("_", filename_escape($path), map { (filename_escape($_) => filename_escape($params{$_})) } sort { lc($a) cmp lc($b) } keys %params);
}

sub randomdelay {
    my ($low, $high)= @_;
    my $delay= rand($high-$low)+$low;

    usleep($delay*1000000);
}
sub cachedget {
    my ($self, @params)= @_;

    my $filename= encodeurlasfile(@params);

    if (-e $filename) {
        return readfile($filename);
    }

    randomdelay(5, 10);

    my $data= $self->get(@params);
    savefile($filename, $data);
    return $data;
}


sub DESTROY {
    my $self= shift;
}
########################################################################
sub logout {
    my $self= shift;
    $self->{loggedin}= 0;
    $self->{searchstate}= undef;
    $self->{server}->clearcookies();
}
########################################################################
sub login {
    my ($self)= @_;

    my $result= $self->post("/Login.aspx", 
        'u'=>$self->{user},
        'p'=>$self->{pass},
        'Submit'=>'Submit');
    #'Submit.x'=>0, 'Submit.y'=>0

    $self->{loggedin}= 1;
    $self->get("/Home.aspx");
    $self->get("/style.css");
    $self->get("/edenjs.js");
}

########################################################################
sub ParseStatsTable {
    my $table = shift;
    my $expected= shift;

    my %stats;

    my $itemsfound=0;
    my $curitem;
    for ($table =~ /<td.*?<\/td>/g) {
        if (/class=S>(?:&nbsp;|\s)*(.*?)(?:<br>.*?)?<\/td>/) {
            warn "missing percentage for $curitem\n" if (defined $curitem);
            $curitem= $1;
            $itemsfound++;
        }
        elsif (/>(?:&nbsp;|\s)*(\d+\.\d+)%<\/td>/) {
            my $percent= $1;
            $stats{$curitem}= $percent;
            undef $curitem;
        }
    }
    warn "missing percentage for $curitem\n" if (defined $curitem);
    #warn "only $statesfound states found ( expected $expected )\n" if ($statesfound != $expected);

    return \%stats;
}
sub GetStats {
    my $self= shift;
    my %stats;
    my $allpage= $self->cachedget("MembersAll.aspx");
    if ($allpage =~ /<span id="lblMembersAll">(.*?)<\/span>/) {
        my $toptable= $1;
        $toptable =~ s/<table[^>]*>//;

        for ($toptable =~ /<table[^>]*>(.*?)<\/table>/g) {
            if (/<tr><td align[^>]*><b>(.*?)<\/b><\/td><\/tr>(.*)/) {
                my ($title, $lines)= ($1, $2);

                $stats{$title}= ParseStatsTable($lines);
            }
        }
    }
    my $uspage= $self->cachedget("MembersUs.aspx");
    if ($uspage =~ /<span id="lblMembersUS">(.*?)<\/span>/) {
        my $table= $1;
        if ($table =~ /<tr><td align[^>]*><b>(.*?)<\/b><\/td><\/tr>(.*)/) {
            my ($title, $lines)= ($1, $2);
            $stats{$title}= ParseStatsTable($lines);
        }
    }

    return \%stats;
}
########################################################################
sub GetFriendsList {
    my ($self, $uid)= @_;
    my $page= $self->cachedget("FriendsList.aspx", uid=>$uid);

    #$self->get("/style.css");
    printf("%20s : %6d bytes\n", $uid, length($page));
}

########################################################################
sub ParseCommunityList {
    my $page= shift;
    my %info;

    if ($page =~ /<span id="lblPages">page \d+ of (\d+)<\/span>/) {
        $info{npages}= $1;
    }

    for ($page =~ /(<a href="Community.aspx\?cmm=\d+">.*?<\/a> <font class=R>\(-?\d+ members\)<\/font>)/g) {
        if (/<a href="Community.aspx\?cmm=(\d+)">(.*?)<\/a> <font class=R>\((-?\d+) members\)<\/font>/)  {
            my ($id, $name, $nmembers)= ($1, $2, $3);
            $info{$id}= { id=>$id, name=>$name, nmembers=>$nmembers };
        }
    }
    return \%info;
}
# 1 <= cid <= 28
sub GetCommunityList {
    my ($self, $cid)= @_;
    my @pages;
    push @pages, ParseCommunityList($self->cachedget("CommunityList.aspx", cid=>$cid, srt=>1));
    my $npages= $pages[0]->{npages};

    push @pages, ParseCommunityList($self->cachedget("CommunityList.aspx", cid=>$cid, srt=>1, pno=>$_)) for (2..4);
    push @pages, ParseCommunityList($self->cachedget("CommunityList.aspx", cid=>$cid, srt=>1, pno=>$npages-$_)) for (0..3);

    return { map { %$_ } @pages };
}
########################################################################

sub GetSearchViewState {
    my ($self)= @_;

    my $page= $self->cachedget("Search.aspx");

    if ($page =~ /name="__VIEWSTATE"\s+value="(.*?)"/) {
        return $1;
    }
}
# pass any of:
#  numeric parameter:   age  | age-age
#  word paramters: 
#       country photo female male friends activity business dating
#       single married committed openmarriage openrelationship
sub Search {
    my ($self, @flags)= @_;

    if (!$self->{searchstate}) {
        $self->{searchstate}= $self->GetSearchViewState();
    }
    if (!$self->{loggedin}) {
        $self->login();
    }
    my %flags= map { lc($_)=>1 } @flags;

    my ($age)= grep { /\d/ } @flags;
    $age ||= "";
    my ($minage,$maxage) = ($age =~ /(\d+)-(\d+)/) ? ($1,$2) : ($age,$age);

    #print "searching @flags\n";
    randomdelay(2, 4);
    my $page= $self->post("Search.aspx", 
            __EVENTTARGET=> '',
            __EVENTARGUMENT=> '',
            __VIEWSTATE=> $self->{searchstate},
            textboxAgeFrom=> $minage,
            textboxAgeTo=> $maxage,
            textboxZip=> '',
            degree=> 'radioAll',  # 'radioFof'  'radioF' 
            dropdownSavedSearch=> '0',
            textboxName=> '',

            dropdownLocation=> $flags{country}?'1' : '0', # 0=anywhere, 1=country

            $flags{photo} ? ( checkPhoto=>'on' ) : (),
            $flags{female} ? ( checkFemale=>'on' ) : (),
            $flags{male} ? ( checkMale=>'on' ) : (),

            $flags{friends} ? ( checkFriends=>'on' ) : (),
            $flags{activity} ? ( checkActivity=>'on' ) : (),
            $flags{business} ? ( checkBusiness=>'on' ) : (),

            $flags{dating} ? ( checkDating=>'on' ) : (),
            dropdownDating=> 'choose',  # 'men & women' 'men' 'women'

            $flags{single} ? ( checkSingle=>'on' ) : (),
            $flags{married} ? ( checkMarried=>'on' ) : (),
            $flags{committed} ? ( checkCommitted=>'on' ) : (),
            $flags{openmarriage} ? ( checkOMarriage=>'on' ) : (),
            $flags{openrelationship} ? ( checkORelationship=>'on' ) : (),
        );

    if ($page =~ /"lblResultCount">results .*? of <b>(\d+)<\/b>/) {
        my $count= $1;
        #print "search result : $count\n";
        return $count;
    }
    elsif ($page =~ /"lblResultCount"><b>No results<\/b>/) {
        return 0;
    }
    else {
        die "error parsing search result\n$page\n";
    }
}
########################################################################
sub SetCountry {
    my ($self, $country)= @_;

    if (!$self->{loggedin}) {
        $self->login();
    }
    #print "getting edit page\n";
    randomdelay(5, 10);
    my $page= $self->get("EditContact.aspx");
    my ($form)= HTML::Form->parse($page, $self->{server}{baseurl}."/EditContact.aspx");

    if (!grep { $_ eq $country } @{$form->find_input("dropdownCountry")->{menu}}) {
        die "invalid country: $country\n";
    }
    $form->value('dropdownCountry', $country);
    $form->find_input('__EVENTTARGET')->{type}= 'text';
    $form->value('__EVENTTARGET', 'btnNext');

    #print "moving to $country\n";
    randomdelay(2, 4);
    my $answer= $self->post("EditContact.aspx", $form->form);

    $self->logout();
}
sub GetCountryList {
    my ($self, $country)= @_;

    my $page= $self->cachedget("EditContact.aspx");
    my ($form)= HTML::Form->parse($page, $self->{server}{baseurl}."/EditContact.aspx");

    return @{$form->find_input("dropdownCountry")->{menu}};
}
########################################################################
sub OrkutCredentials {
    my $dir= exists $ENV{HOME} ? $ENV{HOME} : exists $ENV{USERPROFILE} ? $ENV{USERPROFILE} : ".";

    my $rctxt= readfile("$dir/.orkutrc");
    my %rc;
    while ($rctxt =~ /(\w+)=\s*(.*)/g) {
        my ($key, $val)= ($1, $2) ;
        $val =~ s/\s+$//;

        $rc{$key}= $val;
    }

    return ($rc{username}, $rc{password});
}
1;

