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

use List::Util qw(first);

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

    my $ua= LWP::UserAgent->new(agent=>'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7) Gecko/20040501');
    $ua->cookie_jar(HTTP::Cookies->new(hide_cookie2=>1));
    $ua->env_proxy();

    return bless {
        ua=>$ua,
        baseurl=>$baseurl,
    }, $class;
}
sub clearcookies {
    my $self= shift;

    $self->{ua}->cookie_jar(HTTP::Cookies->new(hide_cookie2=>1));
}
# 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;

    # todo: get rid of 'TE' header, and 'Connection'-TE flag. and 'Cookie2' header
    $rq->header(
        'User-Agent'=> 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7) Gecko/20040501',
        'Accept'=> ($path =~ /\.aspx|\.htm/ 
            ? 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5'
            : $path =~ /\.css/
            ? 'text/css,*/*;q=0.1'
            : '*/*') ,
        'Accept-Language'=> 'en-us,en;q=0.5',
        'Accept-Encoding'=> 'gzip,deflate',
        'Accept-Charset'=> 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
    );
    #print "request:\n", $rq->as_string, "\n";
    #warn "network access disabled\n";
    #return;
    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 ]);
    $rq->header(
        'User-Agent'=> 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7) Gecko/20040501',
        'Accept'=> 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
        'Accept-Language'=> 'en-us,en;q=0.5',
        'Accept-Encoding'=> 'gzip,deflate',
        'Accept-Charset'=> 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
    );
    #print "request:\n", $rq->as_string, "\n";
    #warn "network access disabled\n";
    #return;
    my $rp= $self->{ua}->request($rq) or die "httperror: $@\n";

    #print $rp->status_line, "\n";
    #print $rp->headers->as_string();

    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"]);
}


1;
