#!/usr/bin/env perl
#
#  POST example instance SOAP documents to an echo service
#  capture request and response messages in a log file
# 
#   Copyright (C) 2006 W3C (R) (MIT ERCIM Keio), All Rights Reserved.
#   W3C liability, trademark and document use rules apply.
#
#   This work is distributed under the W3C(R) Software License 
#   in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
#   without even the implied warranty of MERCHANTABILITY 
#   or FITNESS FOR A PARTICULAR PURPOSE.
#
#   http://www.w3.org/Consortium/Legal/ipr-notice
#   http://www.w3.org/Consortium/Legal/2002/copyright-software-20021231
#
#   $Header: /w3ccvs/WWW/2002/ws/databinding/edcopy/toolkits/weblogicserver_java_10.0/runit.sh,v 1.1 2008/04/01 09:05:24 gcowe Exp $
#
use strict;
use Cwd;
use File::Basename;
use POSIX qw(strftime);
use Time::Local;
use IO::File;
use LWP;
use LWP::UserAgent;
use HTTP::Request::Common;
use XML::Writer;		# http://search.cpan.org/dist/XML-Writer/Writer.pm
use XML::Simple;		# http://search.cpan.org/~grantm/XML-Simple-2.15/lib/XML/Simple.pm

#
#  context
#
my $DATABINDING_HOME = $ENV{'DATABINDING_HOME'} || '../../..';
my $EXAMPLES_DIR = $ENV{'EXAMPLES_DIR'} || "${DATABINDING_HOME}/examples/6/09";

my $examples =  'http://www.w3.org/2002/ws/databinding/examples/6/09/';
my $logns =  'http://www.w3.org/2002/ws/databinding/log/6/09/';
my $SOAPAction =  "${examples}#";
my $verbose = 1;
my $datetime = strftime("%Y-%m-%d %H:%M:%S UTC", gmtime());

#
#  parameters from toolkit.xml
#
my $examples_file = "../../patterns/examples.xml";
my $toolkit_file = "toolkit.xml";
my $log_file = "output.xml";

my $t = XMLin($toolkit_file, ForceArray => qw(exclude)) || die "unable to read $toolkit_file";
#use Data::Dumper; print Dumper($t);

my $toolkit = $t->{'xml:id'} || die "unknown toolkit";
my $endpoint = $t->{endpoint} || die "missing endpoint";
my $content_type = $t->{content_type} || "text/xml; charset=utf-8";

my %include = ();
my $includes = @ARGV;
foreach my $a (@ARGV) { $a =~ s/://g; $include{$a} = 1 }

my %exclude = ();
foreach my $exclude (@{$t->{exclude}}) { $exclude{$exclude} = 1 }

print "$toolkit $endpoint\n" if ($verbose);

sub slurp
{ 
    my ($file) = @_;
    local($/, *FH);
    open(FH, $file) or die "failed to open $file";
    return <FH>;
}

sub make_raw
{
    my ($raw, $escape) = @_;
    my ($head, $body) = split(/\n\n/, $raw, 2); 
    $body =~ s/<\?xml/<?_xml/;
    $body =~ s/&([^;]*&)/{BARE-AMPERSAND}$1/g;
    $body =~ s/&([^;]*$)/{BARE-AMPERSAND}$1/;
    $body = "<![CDATA[\n$body\n]]>" if ($escape);
    return "<log:head><![CDATA[\n$head\n]]></log:head><log:body>$body</log:body>";
}

sub call
{
    my ($userAgent, $xml, $endpoint, $example, $instance, $message) = @_;

    print "$instance" if ($verbose);
    $xml->startTag('log:call', example => $example, instance => $instance);

    my $operation = "echo" . $example;

    my $request = HTTP::Request->new(POST => $endpoint);

    $request->content_type($content_type);

    $request->header(SOAPAction => '"' . $SOAPAction . $operation . '"');
    $request->content($message);

    my $response = $userAgent->request($request);

    $xml->startTag('log:request');
    $xml->raw(make_raw($request->as_string, 0));
    $xml->endTag('log:request');

    # TBD - a better check is for invalid XML before escaping
    my $escape = ($response->content_type =~ /html/)?1:0;
    print " "  . $response->content_type if ($verbose);

    print (($response->is_success) ? "\n" : " :FAULT:\n") if ($verbose);

    $xml->startTag('log:response');
    $xml->raw(make_raw($response->as_string, $escape));
    $xml->endTag('log:response');

    $xml->endTag('log:call');
}

{
    my $userAgent = LWP::UserAgent->new(agent => 'databinding tester');
    $userAgent->env_proxy;

    my $output = new IO::File("> $log_file");
    my $xml = new XML::Writer(OUTPUT => $output, UNSAFE => 1);

    $xml->startTag("log:log", toolkit => $toolkit, 
	    examples => $examples,
	    datetime => $datetime,
	    'xmlns:log' => $logns, 
	    'xmlns:ex' => '*invalid*',); 

    #my @instances = <$EXAMPLES_DIR/*/*soap11.xml>;
    my $s = XMLin($examples_file, ForceArray => qw(instance)) || die "unable to read $examples_file";
    my @instances = ();
    foreach my $e (@{$s->{'ex:example'}})
    {
	my $example = $e->{'xml:id'};
	foreach my $i (@{$e->{'ex:instance'}})
	{
	    push(@instances, "$EXAMPLES_DIR/$example/echo${example}-".$i->{'xml:id'}."-soap11.xml");
	}
    }
    #use Data::Dumper; print Dumper(\@instances);

    foreach my $file (@instances)
    {
	my $t = $file;
	$t =~ s|.*/echo([\w\d]+)-([\w\d]+)-soap11.xml$|$1 $2|;
	my ($example, $instance) = split(/ /, $t);

	next if ($exclude{$example});
        next unless (!$includes or $include{$example});

	my $message = slurp($file);

	call($userAgent, $xml, $endpoint, $example, $instance, $message);
    }

    $xml->endTag("log:log");
    $xml->end();
    $output->close();
}

exit(0);