#!/usr/bin/perl -w
use strict;

use Getopt::Long;
use CGI;

my $USAGE = <<EOF;
USAGE: webrobot-gen-plan [options] [files]
Options:
-help               give help
-prefix=path        Prefixes any url with path
-encode=url         encode url values according CGI (%xx notion)
        data        encode form data values according CGI (%xx notion)
-output=xml         (default) output testplan in WebRobot xml format
        text        output in simple text format (filter)
EOF

my $USAGE_EXTENDED = <<EOF;
$USAGE

Converts line based testplans to xml testplans.

>>> FORMAT
        [protocol] url [data] (regular_expressions)*
protocoll:
        GET | POST | HEAD | PUT | DELETE
url:
        check this url, -prefix is prepended
data:
        (POST only) data to be sent, name-value pairs
regular_expression:
        asserts that the resulting page matches these regular expressions

>>> Examples (format)
        /abc
        GET /abc
        POST /abc name1=value1&name2=value2
        GET /abc expression1 expression2
        POST /abc name1=value1&name2=value2 expression1 expression2

>>> Examples (usage)
        find . | webrobot-gen-plan -prefix='http://www/'
EOF
my $prefix;
my @encode = ();
my $output = "xml";
GetOptions(
           help => sub {print $USAGE_EXTENDED; exit},
           "prefix=s" => \$prefix,
           "encode=s" => \@encode,
           "output=s" => \$output,
          ) || die $USAGE;
my %encode = map {$_ => 1} @encode;
my %METHOD = map {$_ => 1} qw(GET HEAD POST DELETE PUT); # ignore TRACE CONNECT

MAIN: {
    my $i = 0;
    print "<plan>\n" if $output eq "xml";

    while (<>) {
        chomp;
        s/^\s+//;
        next if /^#/ || /^$/;
        my ($method, $url, $data, $assert) = split_line($_);
        $url = $prefix . $url if defined $prefix;

        if ($encode{url}) {
            my ($start, $ende) = split /\?/, $url, 2;
            if ($ende) {
                $ende = join "&",
                    map {"$_->[0]=$_->[1]"}
                        map {[ CGI::escape($_->[0]), CGI::escape($_->[1]) ]}
                            cgi_parse($ende);
            }
            $url = "$start";
            $url .= "?$ende" if defined $ende;
        }
        if ($encode{data}) {
            if ($data) {
                my @list = cgi_parse($data);
                $data = join "&",
                    map {"$_->[0]=$_->[1]"}
                        map {[ CGI::escape($_->[0]), CGI::escape($_->[1]) ]}
                            @list;
            }
        }

        if ($output eq "text") {
            print "$method $url",
                 defined($data) ? " $data" : "",
                 $assert && @$assert ? " " . join(" ", @$assert) : "",
                 "\n";
        }
        elsif ($output eq "xml") {
            my $xml = "";
            if ($data) {
                my @list = cgi_parse($data);
                my $parameter = join "",
                    map {"    <parm name='$_->[0]' value='$_->[1]'/>\n"}
                        map {[ html_encode($_->[0]), html_encode($_->[1]) ]}
                            @list;
                $xml .= "<data>\n$parameter</data>\n";
            }
            if ($assert && @$assert) {
                $xml .= "<assert>\n<WWW.Webrobot.Assert>\n<and>\n<status value='2'/>\n";
                $xml .= join "", map {"<regex value='$_'/>\n"} @$assert;
                $xml .= "</and>\n</WWW.Webrobot.Assert>\n</assert>\n";
            }
            $url = html_encode($url) if $output eq "xml";
            print <<EOF;
<entry>
    <!-- $_ -->
    <method value='$method'/>
    <url value='$url'/>
    <description value='$i'/>
$xml\
</entry>
EOF
        }
        $i++;
    }

    print "</plan>\n" if $output eq "xml";
}


sub split_line {
    my ($line) = @_;
    my ($method, $rest) = split /\s+/, $_, 2;
    # insert missing GET
    ($method, $rest) = ("GET", $method) if ! $METHOD{$method};
    (my $url, $rest) = split /\s+/, $rest, 2;
    my $data;
    if ($method eq "POST") {
        ($data, $rest) = split /\s+/, $rest, 2;
    }
    my @assert = split /\s+/, ($rest || "");
    return ($method, $url, $data, \@assert);

}

sub cgi_parse {
    my ($data) = @_;
    my $cgi = CGI->new($data);
    my @str = ();
    foreach (keys %{$cgi->Vars}) {
        push @str, [$_, $cgi->param($_)];
    }
    return @str;
}

sub html_encode {
    my ($parm) = @_;
    $parm =~ s/&/&amp;/g;
    return $parm;
}

1;

=head1 NAME

webrobot-gen-plan - Generate an XML testplan from a simple ASCII format

=head1 SYNOPSIS

 webrobot-gen-plan --help

=head1 DESCRIPTION

Given an ASCII file
This command runs a testplan.
It takes two parameters,
both are mandatory:


=head1 SEE ALSO

L<webrobot>


=cut
