The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package WWW::Webrobot::Print::Test;
use strict;
use warnings;

# Author: Stefan Trcek
# Copyright(c) 2004-2006 ABAS Software AG


use WWW::Webrobot::Util qw/textify/;
use WWW::Webrobot::XML2Tree;
use Test::More qw/no_plan/;


sub new {
    my $class = shift;
    my $self = bless({}, ref($class) || $class);
    return $self;
}

sub global_start {
    #my ($self) = @_;
}

sub item_pre {
    #my ($self, $arg) = @_;
}

sub responses {
    my ($r) = @_;
    my @list = ();
    while (defined $r) {
        push @list, " "x8 . "$r->{_rc} $r->{_request}->{_uri}";
        $r = $r -> {_previous};
    }
    return @list;
}

sub bool_assert { $_[0] ? "FALSE" : "TRUE " }
sub bool { $_[0] ? "TRUE " : "FALSE" }

sub item_post {
    my ($self, $r, $arg) = @_;
    my $data = $arg->{data};
    my $out_ok = "$arg->{method} $arg->{url}";
    $out_ok .= " '$_'=>'$data->{$_}'" foreach (keys %$data);
    if (! ok(! $arg->{fail}, textify $out_ok)) {
        diag " "x4 . textify "Request:     $arg->{method} $arg->{url}";

        diag " "x4 . textify "Description: $arg->{description}";
        if ($data && scalar keys %$data) {
            diag " "x4 . textify "Data:";
            diag " "x8 . textify "'$_' => '$data->{$_}'" foreach (keys %$data);
        }

        diag textify " "x4 . "Predicates:  " . bool_assert($arg->{fail});
        foreach (@{$arg->{fail_str}}) {
            my $s = $_; # don't change the source
            $s =~ s/^(.)/ bool($1) /ge;
            $s =~ s/^/        /gm;
            diag textify $s;
        }

        if ($arg->{assert_xml}) {
            foreach my $assert (@{$arg->{assert_xml}}) {
                my $xml = WWW::Webrobot::XML2Tree::print_xml($assert);
                diag " "x4 . textify "Expression of the assertion in this request:";
                diag " "x8 . textify $_ foreach (split /\n/, $xml);
            }
        }

        diag " "x4 . textify "Responses:";
        diag textify($_) foreach (responses($r));
        if ($arg->{new_properties}) {
            diag " "x4 . textify "New properties:";
            diag " "x8 . textify "property '$_->[0]' => '$_->[1]'" foreach (@{$arg->{new_properties}});
        }
        if ($r && (my $c = $r->content)) {
            my $line = substr($c, 0, 132);
            diag " "x4 . textify "Content: [$line]" ;
        }
    }

}

sub global_end {
    #my $self = shift;
}

1;

=head1 NAME

WWW::Webrobot::Print::Test - write response content according to L<Test::More>

=head1 DESCRIPTION

This module adapts to L<Test::Harness>.

=head1 METHODS

See L<WWW::Webrobot::pod::OutputListeners>.

=over

=item WWW::Webrobot::Print::Test -> new ();

=back