#!/usr/bin/perl -w

# ** Design Note **
#
# Right now this script is data-driven.  Thus, I could have used the '-an'
# flags to Perl.  This turns Perl into an awk-style script.  However, I may
# want to make this non-data-driven later, so it isn't worth it.

use strict;
use warnings;

# Need these 3 for do_test() that performs the actual HTTP request.
use HTTP::Request;
use HTTP::Headers;
use LWP::UserAgent;

# Process command line options/flags.
use Getopt::Std;
my %opt;
getopts('h:pv', \%opt);

# Debug logging on or off.
my $verbose = 0;
if (defined $opt{'v'}) {
        $verbose = 1;
}

# Pretend on or off.
my $pretend = 0;
if (defined $opt{'p'}) {
        $pretend = 1;
}

# Which host to test.
# This is a global.  It doesn't have to be.  Might refactor later, but now it is OK.
my $host = 'localhost:80';
if (defined $opt{'h'}) {
        $host = $opt{'h'};
}

my $flag = 0; # When true, current line is POST data.
my $uri; # Holds URI string.
my $data; # Holds POST data for a single URI.
while (<>) {

        # If the line starts with "POST" this must be the URI line.
        if (/^POST/) {
                print STDERR 'DEBUG: /^POST/ re line = ' . $_ . "\n" if $verbose;
                $uri = (split /\s+/, $_)[1];
                print "$uri\n\n" if $pretend;
                next;
        }

        # A number by itself signals the beginning of the HTTP body, which contains the POST data.
        if (/^\d+$/ && $flag == 0) {
                print STDERR 'DEBUG: /^\d+$/ re turned flag on' . "\n" if $verbose;
                $flag = 1;
                next;
        }

        if ($flag) {
                $data .= $_;
                print if $pretend;
        }

        # A blank line by itself signals the end of the POST data.
        if (/^\s*$/ && $flag == 1) {

                print STDERR 'DEBUG: /^\s*$/ re turned flag off' . "\n" if $verbose;
                print "\n" if ($pretend);

                do_test($uri, $data);

                $data = '';
                $uri = '';
                $flag = 0;
                next;
        }
}

sub do_test {
        my ($uri, $data) = @_;

        # Uses the $host global.  If you're going to refactor and pass 3 args to
        # this sub, then please convert to named args (pass a hash ref).

        my $head = HTTP::Headers->new(
                Content_Type => 'txt/xml',
        );

        $uri = 'http://' . $host . $uri;
        my $req = HTTP::Request->new( 'POST', $uri, $head, $data);

        if ($pretend) {
                print STDERR "DEBUG: Pretend flag set. Not really doing HTTP request.\n" if $verbose;
                print $req->as_string() . "\n\n";
        }
        else {
                my $ua = LWP::UserAgent->new;
                my $resp;
                $resp = $ua->request($req); # This actually performs the HTTP request.

                print STDERR $resp->status_line . "\n" if $verbose;
        }

}

__END__

=pod

=head1 Usage

./test_from_postlog.pl [options] post_log_files ...

=head1 Options

=head2 -h hostname:port

To target a system other than localhost:80.

=head2 -p

Pretend/print only.  Don't test, just print relevant lines of post_log file.

=head2 -v

Turns on verbose logging to stderr.

=cut

##</code><code>##

==f3731b40==============================
Request: bob 10.0.1.5 - - [29/Dec/2009:18:11:59 --0500] "POST /our/uri/is.here HTT
P/1.0" 200 218 "-" "-" SzqMvwoEVDQAAHGZBgIAAAAB "-"
Handler: jakarta-servlet
----------------------------------------
POST /our/uri/is.here HTTP/1.0
Host: bob:80
Content-Type: text/xml
Content-Length: 149

149
<?xml version='1.0' encoding='ISO-8859-1'?><BobSaysSomething><SomeDataDate>12/29/2009</SomeDataDate></BobSaysSomething>

HTTP/1.1 200 OK
Content-Length: 218
Connection: close
Content-Type: text/xml
--f3731b40--