#!/usr/bin/perl -w

use strict;

use Dumpvalue;
my $d= Dumpvalue->new();

$|=1;

#############################################################################
# this is a simple interface to a webserver.
package WebServer;
use HTTP::Request::Common qw(POST GET);
use LWP::UserAgent;

use List::Util qw(first);

sub new {
    my ($class, $baseurl)= @_;

    my $ua= LWP::UserAgent->new();

    return bless {
        ua=>$ua,
        baseurl=>$baseurl,
    }, $class;
}
# almost interface compatible with httpost
#   - optional hashref with parameters is merged with parameters.
#
# httpget("/some.cgi", key1=>123, key2=>455);
# httpget("/some.cgi", { urlkey1=>999 }, key1=>123, key2=>455);
#
sub httpget {
    my $self= shift;
    my $path= shift;

    my $query;
    if (@_) {
        $query= shift;
        if (ref $query ne "HASH") {
            unshift @_, $query;
            $query=undef;
        }
    }
    my %params= @_;

    my $uri= URI->new($self->{baseurl});
    $uri->path($path);
    $uri->query_form($query?%$query:(), %params);
    my $rq= GET $uri;

    my $rp= $self->{ua}->request($rq) or die "httperror: $@\n";

    return $rp->content;
}

# can be called in several ways:
# httppost("/some.cgi", key1=>123, key2=>455);
#   -> just form values
# httppost("/some.cgi", { urlkey1=>999 }, key1=>123, key2=>455);
#   -> both url and form params
# httppost("/some.cgi", key1=>123, key2=>455, file1=>["filename"]);
#   -> form-data file upload
sub httppost {
    my $self= shift;
    my $path= shift;

    my $query;
    if (@_) {
        $query= shift;
        if (ref $query ne "HASH") {
            unshift @_, $query;
            $query=undef;
        }
    }
    my %params= @_;

    my $uri= URI->new($self->{baseurl});
    $uri->path($path);
    $uri->query_form(%$query) if ($query);
    my $rq= POST $uri, [ %params ];

    # -- for http uploads : 
    # ( Content_Type=>"form-data", Content=>[ %params ]);

    my $rp= $self->{ua}->request($rq) or die "httperror: $@\n";

    return $rp->content;
}

sub httprequest {
    my ($self, $method, @params)= @_;
    if (lc($method) eq "get") {
        return $self->httpget(@params);
    }
    elsif (lc($method) eq "post") {
        return $self->httppost(@params);
    }
    else {
        die "invalid http request method '$method'\n";
    }
}

package NetspanningServer;

use URI::Escape;
sub new {
    my ($class, $webserver)= @_;

    return bless {
        ref $webserver?(ws=>$webserver):(ws=>WebServer->new($webserver)),
    }, $class;
}

sub requeststatic {
    my ($self, $url)= @_;

    my $answer= $self->{ws}->httprequest("GET", $url);

    my %result;
    for (split /&/, $answer) {
        if (/(.*)=(.*)/) {
            my $key= uri_unescape($1);
            my $value= uri_unescape($2);

            $result{$key}= $value;
        }
    }

    return \%result;
}

sub request {
    my ($self, $url, $request)= @_;

    my $answer= $self->{ws}->httprequest("POST", $url, %$request);

    my %result;
    for (split /&/, $answer) {
        if (/(.*)=(.*)/) {
            my $key= uri_unescape($1);
            my $value= uri_unescape($2);

            $result{$key}= $value;
        }
    }

    return \%result;
}

package Wetenschapkwis;

sub new {
    my ($class, $server)= @_;

    return bless {
        ref $server?(ws=>$server):(ws=>NetspanningServer->new($server)),
    }, $class;
}


package main;

my $wk= new NetspanningServer(new WebServer("http://forum.vpro.nl"));

my $info= $wk->requeststatic("/wetenschap/netspanning/game.shtml");

# $info->{server}  = "http://forum.vpro.nl/vpro"

my %database;   # keep track of old answers

for (1..2) {
    my $game= $wk->request("/vpro/$info->{aanmeldURL}", {login=>"gast"});

    my @spelers;    # names of all players
    my $spelerno;   # which player am I?
    my $round= 0;

    my @nrinround= map { $game->{"vragenR$_"} } (1,2,3);
    my $questionnr;
    my @questions;

    my $id= $game->{id};

    my %usedcategories;
    $usedcategories{$_}= 0 for map { $info->{"categorie$_"} } (1..9);

    while(1) {
        my $params= {time=>$game->{time}||"", id=>$game->{id}||$id};
        my $url= $game->{url};

        # create new request
        if ($url eq "do.AvatarS") {
            # entering new game
            # received info on other players
        }
        elsif ($url eq "do.CategorieS") {
            # last question answered
            if ($game->{kiezer} eq "1") {
                $params->{cat}=ChooseCategory(\%usedcategories);
            }
            else {
                $params->{cat}="noppo";
            }
            $round++;
        }
        elsif ($url eq "do.AntwoordS") {
            # question answered
            # possibly received list of new questions
            $params->{tijd}= 0;
            $params->{antwoord}= ChooseAnswer($questions[$questionnr]);
        }
        else {
            last;
        }

        sleep(5);
        print "request $url {", join(",", map { "$_=>$params->{$_}" } keys %$params), "}\n";
        $game= $wk->request("/vpro/$url", $params);

        print "answer {", join(",", map { "$_=>$game->{$_}" } keys %$game), "}\n";

        # process answer
        if ($url eq "do.AvatarS") {
            # received info on other players
            $spelerno= $game->{spelerno};
            @spelers= map { $game->{"speler$_"} } (1,2,3);

            print "players: @spelers\n";
        }
        elsif ($url eq "do.CategorieS") {
            # received list of new questions ( round 1 + 2 )
            $usedcategories{$game->{cat}}=1;
        }
        elsif ($url eq "do.AntwoordS") {
            # question answered
            $questions[$questionnr]->{answer}= $questions[$questionnr]->{$game->{goedeantwoord}};
            $questionnr++;
        }

        if (exists $game->{v1}) {
            if (@questions) {
                SaveQuestions(\@questions);
            }
            @questions= ();
            for (my $i=1 ; exists $game->{"v$i"} ; $i++) {
                $questions[$i-1]= {
                    question=>$game->{"v$i"},
                    a=>$game->{"a$i"},
                    b=>$game->{"b$i"},
                    c=>$game->{"c$i"},
                    category=>(exists $game->{cat}?$game->{cat}:$game->{"cat$i"}),
                } 
            }
            $questionnr= 0;

            PrintQuestions(\@questions);
        }
    }

    if (@questions) {
        SaveQuestions(\@questions);
    }
}
print map { "question: $_->{question}\nanswer: $_->{answer}\n\n"; } values %database;

exit(0);

sub ChooseCategory {
    my ($usedcats)= @_;

    for (keys %$usedcats) {
        if ($usedcats->{$_}==0) {
            return $_;
        }
    }
    return "noppo";
}
sub ChooseAnswer {
    my ($question)= @_;
    if (exists $database{$question->{question}}) {
        my $answer= $database{$question->{question}}{answer};
        for (qw(a b c)) {
            if ($question->{$_} eq $answer) {
                return $_;
            }
        }
        print "!!! answer not found in new question: $question->{question}\n";
    }
    return "a";
}
sub SaveQuestions {
    my ($questions)= @_;

    for my $q (@$questions) {
        if (!exists $database{$q->{question}}) {
            $database{$q->{question}}= $q;
        }
        else {
            if ($database{$q->{question}}{answer} ne $q->{answer}) {
                print "answer changed: $q->{question}\n";
                print "old : $database{$q->{question}}{answer}\n";
                print "new : $q->{answer}\n";
            }
        }
    }
}
sub PrintQuestions {
    my ($questions)= @_;
    for my $q (@$questions) {
        print "question: $q->{question}\n";
        print map { "    $_ : $q->{$_}\n"; } (qw(a b c));
    }
}
