A_Static_Html_Page

package WWW::Webrobot::SelftestRunner; # Author: Stefan Trcek # Copyright(c) 2004 ABAS Software AG use Exporter; @EXPORT_OK = qw/ RunTestplan RunTestplan2 HttpdEcho Config /; use strict; use warnings; use HTTP::Response; use HTTP::Headers; use URI; use WWW::Webrobot; use WWW::Webrobot::StupidHTTPD; =head1 NAME WWW::Webrobot::SelftestRunner - Start httpd and run a test plan =head1 SYNOPSIS use WWW::Webrobot::SelftestRunner qw/RunTestplan HttpdEcho Config/; exit RunTestplan(HttpdEcho, Config(qw/Test/, $test_plan); exit RunTestplan(HttpdEcho, Config(qw/Test Html/, $test_plan); see also t/get.t =head1 DESCRIPTION This package serves some functions to start a http daemon and run a test plan. It is only used for the test in the C directory. =head1 FUNCTIONS =over =item RunTestplan($serverfunc, $config, $testplan) Run a C http daemon implementing C<$serverfunc>. Then run a C http client using the configuration C<$config> and the testplan C<$testplan>. =cut sub RunTestplan { my ($exit, $webrobot) = RunTestplan2(@_); return $exit; } sub RunTestplan2 { my ($server_func, $config, $test_plan) = @_; my $daemon = WWW::Webrobot::StupidHTTPD -> new(); $daemon -> start($server_func, fork_daemon => 1); $config .= "names=application=" . $daemon -> server_url() . "\n"; my $webrobot = WWW::Webrobot -> new($config); my $exit = $webrobot -> run($test_plan); $daemon -> stop(); return ($exit, $webrobot); } my $simple_html_text_0 = <<'EOF'; A_Static_Html_Page A simple text. EOF my $simple_html_text_1 = <<'EOF'; Confuse perl regular expressions: [a-z] HTMLish text EOF my $frame_0 = <<'EOF'; Your browser does not support frames. EOF my $ACTION = { # NOTE: depending on the key the HTTP response will be # text/html or text/plain url => sub { my ($connection, $request) = @_; $request -> uri(); }, content => sub { my ($connection, $request) = @_; $request -> content(); }, method => sub { my ($connection, $request) = @_; $request -> method(); }, headers => sub { my ($connection, $request) = @_; $request -> headers() -> as_string(); }, constant_html_0 => sub { my ($connection, $request) = @_; return $simple_html_text_0; }, constant_html_1 => sub { my ($connection, $request) = @_; return $simple_html_text_1; }, html_frame_0 => sub { my ($connection, $request) = @_; return $frame_0; }, html_as_utf8 => sub { my ($connection, $request) = @_; my $path = $request->uri(); my $file = $path || ""; $file =~ s{^/*html_as_utf8/(.*)$}{$1}; local *F; open F, "<$file" or die "Can't open '$file': $!"; my $html = do { local $/; }; close F; return $html; }, # 500 => sub {}, # Don't use '500' as a key: some tests rely that this key doesn't exist! }; =item HttpdEcho A simple server function for the C http daemon. It read the requested url C as an action where the action is denoted by the C part within the url. The result of the action is returned as content in the response. Actions are url echo the url as response content content echo the content in the request as response content method echo the method in the request as response content headers echo a stringified form of the request headers as response content =cut sub HttpdEcho { my %parm = (@_); my $charset = $parm{charset} ? "; charset=" . $parm{charset} : ""; my $plain_header = HTTP::Headers -> new(Content_Type => "text/plain$charset"); my $html_header = HTTP::Headers -> new(Content_Type => "text/html$charset"); return sub { my ($connection, $request) = @_; my $path = $request->uri(); my $action = $path || ""; $action =~ s{^/*([^/]+).*$}{$1}; $action = "" if ! exists $ACTION->{$action}; my $response = (exists $ACTION->{$action}) ? HTTP::Response -> new( 200, undef, ($action =~ /html/) ? $html_header : $plain_header, $ACTION->{$action}->($connection, $request) ) : HTTP::Response -> new(500, undef, $plain_header, undef); $connection -> send_response($response); }; }; =item Config(Modulenames...) Simple config string for C output. Defaults to "Test" if no parameter is given. Example: my $cfg = Config(qw/Html Test/); my $cfg = Config; =cut sub Config { push @_, "Test" if ! @_; return join "", map {"output=WWW::Webrobot::Print::$_\n"} @_; } =pod =back =cut 1;