#!/usr/bin/perl -w
#############################################################################
# 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();
    $ua->cookie_jar(HTTP::Cookies->new());
    $ua->env_proxy();

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


package Girotel;

use strict;

sub debugoutput {
	my ($title, $content) = @_;
	print "\n------------$title---------------\n";
	print $content;
	print "\n--------------------------------\n";
}



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

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

sub pblogin
{
	my $self = shift;

	my ($girotelnummer, $girotelcode, $gin) = @_;

    $self->{ws}->httppost("/GTO/login.formproc", 
		txtAbonnementID => $girotelnummer,
		txtCodewoord => $girotelcode,
		txtGin => $gin,
		command => "0",
		txtSysteem => "GTO",
	);
    # this results in a redirect, with NETSCAPE_LIVEWIRE.PBGNCOOKIE cookie set.
    # of this cookie substr($cookie,0,5) = ?
    # of this cookie substr($cookie,5,6) = gtnummer
    # of this cookie substr($cookie,11,3) = ?
    # of this cookie substr($cookie,14,16) = serverkey - for TAN authentication
}

sub download
{
	my $self = shift;

    my $csv= $self->{ws}->httpget("/GTO/GTODownloadServlet", 
        strSource=>"GTO",
        strEvent=>"downloaden",
        txtDatumVan=>"1-01-1980",
        txtDatumTot=>"20-02-2999",
        selFormaat=>"komma",
        cbxZIP=>"null");

	return $csv;
}

1
