#!/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";
    }
}

# http testing
sub tst {
    my $self= WebServer->new("http://itsme.dyndns.org");

    # test just url.
    print $self->httprequest("GET", "/cgi-bin/tst.cgi");
    # test just url.
    print $self->httprequest("POST", "/cgi-bin/tst.cgi");

    # test weird value encoding
    print $self->httprequest("GET", "/cgi-bin/tst.cgi", a=>"&=?", "&=?"=>"\000");
    # test multi values
    print $self->httprequest("GET", "/cgi-bin/.cgi", tst1=>[1,2,3], a=>"1", "b"=>"1");

    # test interchangablilty with post
    print $self->httprequest("GET", "/cgi-bin/tst.cgi", {qq=>11, zz=>22}, a=>1, b=>2, c=>3);

    # test post form value
    print $self->httprequest("POST", "/cgi-bin/tst.cgi", a=>1, b=>2, c=>3);
    # test post form value with urlparams
    print $self->httprequest("POST", "/cgi-bin/tst.cgi", {qq=>11, zz=>22}, a=>1, b=>2, c=>3);

    # test file upload
    print $self->httprequest("POST", "/cgi-bin/tst.cgi", {qq=>11, zz=>22}, a=>"sometext", b=>["/etc/motd"]);
}

#############################################################################
# this is the base class for webobject apps
package WebObjectsApplication;

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

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

sub SetSession {
    my ($self, $session)= @_;
    print "new session: $session" unless ($self->{sessionid});

    $self->{sessionid}= $session;
}

sub SetInstance {
    my ($self, $instance)= @_;
    print "new instance $instance" unless ($self->{instanceid});

    $self->{instanceid}= $instance;
}

sub SetContext {
    my ($self, $context)= @_;
    print "new context $context" unless ($self->{contextid});

    $self->{contextid}= $context;
}

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

    return $self->{instanceid} ? "$self->{app}/$self->{instanceid}" : "$self->{app}";
}

sub LookforActionUrl {
    my ($self, $page)= @_;
    if (my ($instanceid, $sessionid)= ($page =~ m{"\S*?\.woa/(\d+)/wa\S*?wosid=(\w+)\S*"})) {
        $self->SetSession($sessionid);
        $self->SetInstance($instanceid);

        return 1;
    }
}

sub LookForComponentUrl {
    my ($self, $page)= @_;
    if (my ($instanceid, $sessionid, $contextid)= ($page =~ m{"\S*?\.woa/(\d+)/wo/(\w+)/(\d+)\.\d+\S*"})) {
        my $isFirstSession= !exists $self->{sessionid} || $self->{sessionid};
        $self->SetSession($sessionid);
        $self->SetInstance($instanceid);
        $self->SetContext($contextid);

        print "instance=$instanceid, session=$sessionid\n" if ($isFirstSession);
        return 1;
    }
}

sub ApplicationRequest {
    my ($self, $method, $handler, @params)= @_;
    die unless($handler);

    my $result= $self->{ws}->httprequest($method, $self->GetAppPath().$handler, @params);

    $self->LookForComponentUrl($result);
    $self->LookforActionUrl($result);

    return $result;
}

sub ActionRequest {
    my ($self, $method, $actionhandler, @params)= @_;
    die unless($actionhandler);

    return $self->ApplicationRequest($method, "/wa/$actionhandler", @params);
}

sub ComponentRequest {
    my ($self, $method, $component, @params)= @_;
    die unless($component);

    die "no sessionid" unless $self->{sessionid};
    die "no contextid" unless $self->{contextid};

    return $self->ApplicationRequest($method, "/wo/$self->{sessionid}/$self->{contextid}.$component", @params);
}


1;

