r1937 - in trunk/varnish-tools/regress: . bin lib/Varnish lib/Varnish/Test lib/Varnish/Test/Server

knutroy at projects.linpro.no knutroy at projects.linpro.no
Wed Sep 5 14:49:05 CEST 2007


Author: knutroy
Date: 2007-09-05 14:49:05 +0200 (Wed, 05 Sep 2007)
New Revision: 1937

Added:
   trunk/varnish-tools/regress/lib/Varnish/Test/Server/
   trunk/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm
Removed:
   trunk/varnish-tools/regress/TODO
Modified:
   trunk/varnish-tools/regress/
   trunk/varnish-tools/regress/bin/varnish-regress.pl
   trunk/varnish-tools/regress/lib/Varnish/Test.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Varnish.pm
Log:
* Added POD.
* Moved Varnish::Test::Server::Connection to its own module file.
* Removed TODO which was not too exciting anyway.



Property changes on: trunk/varnish-tools/regress
___________________________________________________________________
Name: svn:ignore
   + Makefile


Deleted: trunk/varnish-tools/regress/TODO
===================================================================
--- trunk/varnish-tools/regress/TODO	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/TODO	2007-09-05 12:49:05 UTC (rev 1937)
@@ -1,2 +0,0 @@
-* Completely POD-ify Perl-code.
-* Detect and act upon unexpected death of Varnish grandchild process.

Modified: trunk/varnish-tools/regress/bin/varnish-regress.pl
===================================================================
--- trunk/varnish-tools/regress/bin/varnish-regress.pl	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/bin/varnish-regress.pl	2007-09-05 12:49:05 UTC (rev 1937)
@@ -32,6 +32,27 @@
 
 varnish-regress.pl - run Varnish regression tests
 
+=head1 DESCRIPTION
+
+This program is a thin wrapper around the L<Varnish::Test> regression
+test framework library. Using this library, regression tests are
+performed on Varnish.
+
+The Varnish daemon (L<varnishd>) must be available in one of the
+directories given by the "PATH" environment variable.
+
+By default, this program will run all test-cases available in the
+regression test framework library, or the test-cases selected by name
+as arguments on the command line.
+
+=head1 OUTPUT
+
+STDERR is used to continually report progress during testing.
+
+STDOUT is used to output a HTML-formatted report at the end of the
+run, provided that execution does not abort prematurely for any
+reason.
+
 =cut
 
 use strict;
@@ -96,5 +117,6 @@
 =head1 SEE ALSO
 
 L<Varnish::Test>
+L<Varnish::Test::Report>
 
 =cut

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -34,14 +34,16 @@
 
 =head1 DESCRIPTION
 
-Varnish::Test::Case is meant to be the superclass of specific
-test-case clases. It provides functionality to run a number of tests
-defined in methods whose names start with "test", as well as keeping
-track of the number of successful or failed tests.
+Varnish::Test::Case is the superclass of test-case clases. It provides
+functionality to run a number of tests defined in methods whose names
+start with "test", as well as keeping track of the number of
+successful or failed tests.
 
 It also provides default event handlers for "ev_client_response" and
 "ev_client_timeout", which are standard for most test-cases.
 
+=head1 METHODS
+
 =cut
 
 package Varnish::Test::Case;
@@ -54,6 +56,12 @@
 use POSIX qw(strftime);
 use Time::HiRes qw(gettimeofday tv_interval);
 
+=head2 new
+
+Create a new Case object.
+
+=cut
+
 sub new($$) {
     my ($this, $engine) =  @_;
     my $class = ref($this) || $this;
@@ -64,12 +72,25 @@
 		       'failed' => 0 }, $class);
 }
 
+=head2 log
+
+Logging facility.
+
+=cut
+
 sub log($$) {
     my ($self, $str) = @_;
 
     $self->{'engine'}->log($self, 'CAS: ', $str);
 }
 
+=head2 init
+
+Test-case initialization which loads specified VCL into Varnish and
+starts the Varnish daemon's child.
+
+=cut
+
 sub init($) {
     my ($self) = @_;
     my ($code, $text);
@@ -105,6 +126,13 @@
     }
 }
 
+=head2 fini
+
+Does the reverse of "init" by stopping the Varnish child and reverting
+to a default VCL definition.
+
+=cut
+
 sub fini($) {
     my ($self) = @_;
 
@@ -127,6 +155,12 @@
     }
 }
 
+=head2 run
+
+Run test-case proper when everything is set up right.
+
+=cut
+
 sub run($;@) {
     my ($self, @args) = @_;
 
@@ -162,18 +196,37 @@
     $self->{'stop'} = [gettimeofday()];
 }
 
+=head2 run_loop
+
+Proxy for Varnish::Test::Engine::run_loop.
+
+=cut
+
 sub run_loop($@) {
     my ($self, @wait_for) = @_;
 
     return $self->{'engine'}->run_loop(@wait_for);
 }
 
+=head2 new_client
+
+Creates a new Client object.
+
+=cut
+
 sub new_client($) {
     my ($self) = @_;
 
     return Varnish::Test::Client->new($self->{'engine'});
 }
 
+=head2 results
+
+Report test-case results as a hashref suitable for Template
+processing.
+
+=cut
+
 sub results($) {
     my ($self) = @_;
 
@@ -196,12 +249,22 @@
 # Default event handlers
 #
 
+=head1 DEFAULT EVENT HANDLER METHODS
+
+=head2 ev_client_response
+
+=cut
+
 sub ev_client_response($$$) {
     my ($self, $client, $response) = @_;
 
     return $response;
 }
 
+=head2 ev_client_timeout
+
+=cut
+
 sub ev_client_timeout($$) {
     my ($self, $client) = @_;
 
@@ -209,6 +272,10 @@
     return $client;
 }
 
+=head2 ev_server_request
+
+=cut
+
 sub ev_server_request($$$$) {
     my ($self, $server, $connection, $request) = @_;
 
@@ -237,6 +304,10 @@
     $connection->send_response($response);
 }
 
+=head2 ev_server_timeout
+
+=cut
+
 sub ev_server_timeout($$) {
     my ($self, $srvconn) = @_;
 
@@ -248,6 +319,16 @@
 # Client utilities
 #
 
+=head1 CLIENT UTILITY METHODS
+
+=head2 request
+
+Prepare and send an HTTP request using Client object given as
+argument. Also, HTTP method, URI, HTTP headers and content are given
+as argument. HTTP headers and content is optional.
+
+=cut
+
 sub request($$$$;$$) {
     my ($self, $client, $method, $uri, $header, $content) = @_;
 
@@ -279,18 +360,40 @@
     return $self->{'cached_response'} = $resp;
 }
 
+=head2 head
+
+Send "HEAD" request using "request" method above. Client object, URI,
+and HTTP headers (optional) are given as arguments.
+
+=cut
+
 sub head($$$;$) {
     my ($self, $client, $uri, $header) = @_;
 
     return $self->request($client, 'HEAD', $uri, $header);
 }
 
+=head2 get
+
+Send "GET" request using "request" method above. Client object, URI,
+and HTTP headers (optional) are given as arguments.
+
+=cut
+
 sub get($$$;$) {
     my ($self, $client, $uri, $header) = @_;
 
     return $self->request($client, 'GET', $uri, $header);
 }
 
+=head2 post
+
+Send "POST" request using "request" method above. Client object, URI,
+and HTTP headers (optional) and body (optional) are given as
+arguments.
+
+=cut
+
 sub post($$$;$$) {
     my ($self, $client, $uri, $header, $body) = @_;
 
@@ -299,6 +402,18 @@
     return $self->request($client, 'POST', $uri, $header, $body);
 }
 
+=head1 ASSERT METHODS
+
+The following assert methods take an optional response object is their
+last argument. When this argument is not used, response object is
+looked up in $self->{'cached_response'}.
+
+=head2 assert_code
+
+Assert a certain HTTP status code.
+
+=cut
+
 sub assert_code($$;$) {
     my ($self, $code, $resp) = @_;
 
@@ -308,6 +423,12 @@
 	unless $resp->code == $code;
 }
 
+=head2 assert_ok
+
+Assert status "200 OK" using "assert_code" method above.
+
+=cut
+
 sub assert_ok($;$) {
     my ($self, $resp) = @_;
 
@@ -317,6 +438,12 @@
     $self->assert_code(200, $resp);
 }
 
+=head2 assert_xid
+
+Assert a certain XID in "X-Varnish" header.
+
+=cut
+
 sub assert_xid($;$) {
     my ($self, $resp) = @_;
 
@@ -329,6 +456,12 @@
 	unless ($resp->header('X-Varnish') =~ m/^\d+(?: \d+)?$/);
 }
 
+=head2 assert_no_xid
+
+Assert absence of "X-Varnish" header.
+
+=cut
+
 sub assert_no_xid($;$) {
     my ($self, $resp) = @_;
 
@@ -339,6 +472,12 @@
 	if (defined($resp->header('X-Varnish')));
 }
 
+=head2 assert_cached
+
+Assert that "X-Varnish" header indicates that the response was cached.
+
+=cut
+
 sub assert_cached($;$) {
     my ($self, $resp) = @_;
 
@@ -350,6 +489,13 @@
 	unless $resp->header('X-Varnish') =~ /^\d+ \d+$/;
 }
 
+=head2 assert_uncached
+
+Assert that "X-Varnish" header indicates that the response was NOT
+cached.
+
+=cut
+
 sub assert_uncached($;$) {
     my ($self, $resp) = @_;
 
@@ -361,6 +507,13 @@
 	if $resp->header('X-Varnish') =~ /^\d+ \d+$/;
 }
 
+=head2 assert_header
+
+Assert that a certain header (named by an argument) is present, and
+optionally matches a given regular expression.
+
+=cut
+
 sub assert_header($$;$$) {
     my ($self, $header, $re, $resp) = @_;
 
@@ -375,6 +528,13 @@
     }
 }
 
+=head2 assert_body
+
+Assert presence of a HTTP body, optionally matching given regular
+expression.
+
+=cut
+
 sub assert_body($;$$) {
     my ($self, $re, $resp) = @_;
 
@@ -389,6 +549,12 @@
     }
 }
 
+=head2 assert_no_body
+
+Assert absence of HTTP body.
+
+=cut
+
 sub assert_no_body($;$) {
     my ($self, $resp) = @_;
 
@@ -402,6 +568,14 @@
 # Miscellaneous
 #
 
+=head1 MISCELLANEOUS METHODS
+
+=head2 usleep
+
+Sleep for a given number of microseconds.
+
+=cut
+
 sub usleep($$) {
     my ($self, $usec) = @_;
 
@@ -409,3 +583,11 @@
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<Varnish::Test::Client>
+L<HTTP::Request>
+L<HTTP::Response>
+
+=cut

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -44,9 +44,17 @@
 use strict;
 
 use IO::Socket::INET;
+use HTTP::Response;
 
 our $id_seq = 1;
 
+=head2 new
+
+Called by test-cases to create a new Client object to be used to send
+HTTP-requests.
+
+=cut
+
 sub new($$) {
     my ($this, $engine, $attrs) = @_;
     my $class = ref($this) || $this;
@@ -62,18 +70,36 @@
     return $self;
 }
 
+=head2 log
+
+Logging facility.
+
+=cut
+
 sub log($$;$) {
     my ($self, $str, $extra_prefix) = @_;
 
     $self->{'engine'}->log($self, sprintf('CLI[%d]: ', $self->{'id'}) . ($extra_prefix || ''), $str);
 }
 
+=head2 logf
+
+Logging facility using a formatting string as first argument.
+
+=cut
+
 sub logf($$;@) {
     my ($self, $fmt, @args) = @_;
 
     $self->{'engine'}->log($self, sprintf('CLI[%d]: ', $self->{'id'}), sprintf($fmt, @args));
 }
 
+=head2 send_request
+
+Called by test-cases to send HTTP requests out on a connection.
+
+=cut
+
 sub send_request($$;$) {
     my ($self, $request, $timeout) = @_;
 
@@ -93,6 +119,13 @@
     $self->logf("%s %s %s", $request->method(), $request->uri(), $request->protocol());
 }
 
+=head2 got_response
+
+Called by mux_input and mux_eof to dispatch event related to received
+HTTP response.
+
+=cut
+
 sub got_response($$) {
     my ($self, $response) = @_;
 
@@ -101,6 +134,13 @@
     $self->{'engine'}->ev_client_response($self, $response);
 }
 
+=head2 shutdown
+
+Called by test-cases to shutdown client including termination of HTTP
+connection.
+
+=cut
+
 sub shutdown($) {
     my ($self) = @_;
 
@@ -119,6 +159,17 @@
     }
 }
 
+=head1 IO::MULTIPLEX CALLBACKS
+
+=head2 mux_input
+
+Called by L<IO::Multiplex> when new input is received on an associated
+file-handle. Complete HTTP messages are extracted from the input
+buffer, while any incomplete message is left in the buffer, awaiting
+more input (mux_input) or EOF (mux_eof).
+
+=cut
+
 sub mux_input($$$$) {
     my ($self, $mux, $fh, $data) = @_;
 
@@ -197,6 +248,13 @@
     # nothing at all or a partial HTTP message.
 }
 
+=head2 mux_eof
+
+Called by L<IO::Multiplex> when connection is being shutdown by
+foreign host.
+
+=cut
+
 sub mux_eof($$$$) {
     my ($self, $mux, $fh, $data) = @_;
 
@@ -210,6 +268,13 @@
     }
 }
 
+=head2 mux_timeout
+
+Called by L<IO::Multiplex> when a specified timeout has been reached
+on an associated file-handle.
+
+=cut
+
 sub mux_timeout($$$) {
     my ($self, $mux, $fh) = @_;
 
@@ -217,6 +282,13 @@
     $self->{'engine'}->ev_client_timeout($self);
 }
 
+=head2 mux_close
+
+Called by L<IO::Multiplex> when an associated file-handle has been
+closed.
+
+=cut
+
 sub mux_close($$) {
     my ($self, $mux, $fh) = @_;
 
@@ -224,3 +296,10 @@
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<HTTP::Response>
+L<HTTP::Request>
+
+=cut

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -34,15 +34,15 @@
 
 =head1 DESCRIPTION
 
-Varnish::Test::Engine is primarily a wrapper around a
-IO::Multiplex-based select-loop which monitors activity on
-client-side, server-side and Varnish's I/O-channels. On startup, it
-automatically creates an associated Server object and a Varnish
-objects whoses sockets/filehandles are registered in the
-IO::Multiplex-object.
+An L<Engine|Varnish::Test::Engine> object is primarily a wrapper
+around a L<select(2)>-based L<IO::Multiplex> object which monitors
+activity on relevant sockets and file handles.
 
-Additionally, event dispatching is performed by the AUTOLOAD method.
+Additionally, an Engine object performs event dispatching and queuing,
+which are handled by an AUTOLOAD method.
 
+=head1 METHODS
+
 =cut
 
 package Varnish::Test::Engine;
@@ -53,6 +53,16 @@
 use Varnish::Test::Varnish;
 use IO::Multiplex;
 
+=head2 new
+
+Used by main program to create a new Varnish::Test::Engine object
+which starts up a L<Varnish::Test::Server> and
+L<Varnish::Test::Varnish> object, so test-cases are ready to be run.
+Also an <IO::Multiplex> object is started to handle the central
+select(2) mechanism.
+
+=cut
+
 sub new($$;%) {
     my ($this, $controller, %config) =  @_;
     my $class = ref($this) || $this;
@@ -83,6 +93,12 @@
     return $self;
 }
 
+=head2 log
+
+Logging facility.
+
+=cut
+
 sub log($$$) {
     my ($self, $object, $prefix, $str) = @_;
 
@@ -92,6 +108,14 @@
     print STDERR $str;
 }
 
+=head2 run_loop
+
+Enter event loop based on IO::Multiplex::loop. Also, handles
+dispatching of "wait-for" or "die" events which are returned to the
+caller.
+
+=cut
+
 sub run_loop($@) {
     my ($self, @wait_for) = @_;
 
@@ -145,6 +169,13 @@
     return undef;
 }
 
+=head2 shutdown
+
+Shutdown Engine by shutting down Server, Varnish, and IO::Multiplex
+objects.
+
+=cut
+
 sub shutdown($) {
     my ($self) = @_;
 
@@ -158,7 +189,17 @@
     }
 }
 
-sub AUTOLOAD ($;@) {
+=head2 AUTOLOAD
+
+Event dispatch mechanism. When an I/O event occurs, it goes through
+this method because $engine->ev_* resolves to this one. It will the
+look for a method of the same name in the running test-case object.
+Queuing and end-loop signaling is done when a "wait-for" or "die"
+event occurs.
+
+=cut
+
+sub AUTOLOAD($;@) {
     my ($self, @args) = @_;
 
     (my $event = our $AUTOLOAD) =~ s/.*://;
@@ -209,3 +250,11 @@
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<Varnish::Test::Varnish>
+L<Varnish::Test::Server>
+L<IO::Multiplex>
+
+=cut

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -28,12 +28,32 @@
 # $Id$
 #
 
+=head1 NAME
+
+Varnish::Test::Report
+
+=head1 DESCRIPTION
+
+Produce test result reports in different formats. Currently, HTML
+format is supported via a subclass found in
+Varnish::Test::Report::HTML.
+
+=head1 METHODS
+
+=cut
+
 package Varnish::Test::Report;
 
 use strict;
 
 use Template;
 
+=head2 new
+
+Create a new Report object.
+
+=cut
+
 sub new($) {
     my ($this) =  @_;
     my $class = ref($this) || $this;
@@ -51,6 +71,12 @@
     return $self;
 }
 
+=head2 new
+
+Generate report.
+
+=cut
+
 sub run($@) {
     my ($self, @cases) = @_;
 
@@ -75,3 +101,9 @@
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<Template>
+
+=cut

Added: trunk/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm	                        (rev 0)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -0,0 +1,226 @@
+#!/usr/bin/perl -w
+#-
+# Copyright (c) 2006-2007 Linpro AS
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer
+#    in this position and unchanged.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $Id$
+#
+
+=head1 NAME
+
+Varnish::Test::Server::Connection
+
+=head1 DESCRIPTION
+
+An Varnish::Test::Server::Connection object is used to handle an
+individual HTTP connection which stems from the listening socket
+handled by L<Varnish::Test::Server>.
+
+=cut
+
+package Varnish::Test::Server::Connection;
+
+use strict;
+use HTTP::Request;
+use HTTP::Status;
+
+=head2 new
+
+Called by a Server object when a new connection (given by the
+file-handle argument) is established. This object is set as the
+IO::Multiplex call-back object for this connection.
+
+=cut
+
+sub new($$) {
+    my ($this, $server, $fh) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = bless({ 'server' => $server,
+		       'engine' => $server->{'engine'},
+		       'fh' => $fh,
+		       'mux' => $server->{'mux'},
+		       'data' => '' }, $class);
+    $self->{'mux'}->set_callback_object($self, $fh);
+    return $self;
+}
+
+=head2 send_response
+
+Called by test-cases to send a given HTTP::Response object out on the
+associated HTTP connection.
+
+=cut
+
+sub send_response($$) {
+    my ($self, $response) = @_;
+
+    $response->message(status_message($response->code()))
+	unless $response->message();
+    $self->{'mux'}->write($self->{'fh'}, $response->as_string("\r\n"));
+    $self->{'server'}->{'responses'} += 1;
+    $self->{'server'}->logf("%s %s", $response->code(), $response->message());
+}
+
+=head2 shutdown
+
+Called by test-cases to close HTTP connection.
+
+=cut
+
+sub shutdown($) {
+    my ($self) = @_;
+
+    my $inbuffer = $self->{'mux'}->inbuffer($self->{'fh'});
+
+    if (defined($inbuffer) and $inbuffer ne '') {
+	use Data::Dumper;
+
+	$self->{'server'}->log('Junk or incomplete request. Discarding: ' . Dumper(\$inbuffer));
+	$self->{'mux'}->inbuffer($self->{'fh'}, '');
+    }
+
+    $self->{'mux'}->close($self->{'fh'});
+}
+
+=head1 IO::MULTIPLEX CALLBACKS
+
+=head2 mux_input
+
+Called by L<IO::Multiplex> when new input is received on an associated
+file-handle. Complete HTTP messages are extracted from the input
+buffer, while any incomplete message is left in the buffer, awaiting
+more input (mux_input) or EOF (mux_eof).
+
+=cut
+
+sub mux_input($$$$) {
+    my ($self, $mux, $fh, $data) = @_;
+
+    $mux->set_timeout($fh, undef);
+
+    # Iterate through the input buffer ($$data) and identify HTTP
+    # messages, one per iteration. Break out of the loop when there
+    # are no complete HTTP messages left in the buffer, and let
+    # whatever data remains stay in the buffer, as we will get a new
+    # chance to parse it next time we get more data ("mux_input").
+    while ($$data =~ /\n\r?\n/) {
+	# If we find a double (CR)LF in the input data, we have at
+	# least a complete header section of a message, so look for
+	# content-length and decide what to do.
+
+	my $request = HTTP::Request->parse($$data);
+	my $content_ref = $request->content_ref;
+	my $content_length = $request->content_length;
+
+	if (defined($content_length)) {
+	    my $data_length = length($$content_ref);
+	    if ($data_length == $content_length) {
+		# We found exactly content-length amount of data, so
+		# empty input buffer and send request to event
+		# handling.
+		$$data = '';
+		$self->{'server'}->got_request($self, $request);
+	    }
+	    elsif ($data_length < $content_length) {
+		# We only received the first part of an HTTP message,
+		# so break out of loop and wait for more.
+		$mux->set_timeout($fh, 2);
+		last;
+	    }
+	    else {
+		# We have more than content-length data, which means
+		# more than just one HTTP message. The extra data
+		# (beyond content-length) is now at the end of
+		# $$content_ref, so move it back to the input buffer
+		# so we can parse it on the next iteration. Note that
+		# this "substr" also removes this data from
+		# $$content_ref (the message body of $request itself).
+		$$data = substr($$content_ref, $content_length,
+				$data_length - $content_length, '');
+		# Send request to event handling.
+		$self->{'server'}->got_request($self, $request);
+	    }
+	}
+	else {
+	    # HTTP requests without a content-length has no body by
+	    # definition, so whatever was parsed as content must be
+	    # the start of another request. Hence, move this back to
+	    # input buffer and empty the body of this $request. Then,
+	    # send $request to event handling.
+
+	    $$data = $$content_ref;
+	    $$content_ref = '';
+	    $self->{'server'}->got_request($self, $request);
+	}
+    }
+}
+
+=head2 mux_timeout
+
+Called by L<IO::Multiplex> when a specified timeout has been reached
+on an associated file-handle.
+
+=cut
+
+sub mux_timeout($$$) {
+    my ($self, $mux, $fh) = @_;
+
+    $self->{'mux'}->set_timeout($fh, undef);
+    $self->{'engine'}->ev_server_timeout($self);
+}
+
+=head2 mux_eof
+
+Called by L<IO::Multiplex> when connection is being shutdown by
+foreign host.
+
+=cut
+
+sub mux_eof($$$$) {
+    my ($self, $mux, $fh, $data) = @_;
+
+    # On server side, HTTP does not use EOF from client to signal end
+    # of request, so if there is anything left in input buffer, it
+    # must be incomplete because "mux_input" left it there.
+
+    if ($$data ne '') {
+	use Data::Dumper;
+
+	$self->{'server'}->log('Junk or incomplete request. Discarding: ' . Dumper($data));
+	$$data = '';
+    }
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Varnish::Test::Server>
+L<HTTP::Request>
+L<HTTP::Response>
+L<HTTP::Status>
+
+=cut


Property changes on: trunk/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm
___________________________________________________________________
Name: svn:keywords
   + Id

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -38,7 +38,7 @@
 TCP socket, receiving HTTP requests and sending responses.
 
 Every established connection is handled by an associated object of
-type Varnish::Test::Server::Connection.
+type L<Varnish::Test::Server::Connection>.
 
 =cut
 
@@ -46,8 +46,17 @@
 
 use strict;
 
+use Varnish::Test::Server::Connection;
 use IO::Socket::INET;
 
+=head2 new
+
+Called by a Varnish::Test::Engine object to create a new Server
+object. It sets up its listening socket and registers it in Engine's
+IO::Multiplex object (mux).
+
+=cut
+
 sub new($$) {
     my ($this, $engine, $attrs) = @_;
     my $class = ref($this) || $this;
@@ -73,18 +82,37 @@
     return $self;
 }
 
+=head2 log
+
+Logging facility.
+
+=cut
+
 sub log($$;$) {
     my ($self, $str, $extra_prefix) = @_;
 
     $self->{'engine'}->log($self, 'SRV: ' . ($extra_prefix || ''), $str);
 }
 
+=head2 logf
+
+Logging facility using a formatting string as first argument.
+
+=cut
+
 sub logf($$;@) {
     my ($self, $fmt, @args) = @_;
 
     $self->{'engine'}->log($self, 'SRV: ', sprintf($fmt, @args));
 }
 
+=head2 shutdown
+
+Called by the main program to terminate the server object and its
+listening socket.
+
+=cut
+
 sub shutdown($) {
     my ($self) = @_;
 
@@ -92,20 +120,14 @@
     delete $self->{'socket'};
 }
 
-sub mux_connection($$$) {
-    my ($self, $mux, $fh) = @_;
+=head2 got_request
 
-    $self->log('CONNECT');
-    my $connection = Varnish::Test::Server::Connection->new($self, $fh);
-}
+Called by L<Varnish::Test::Server::Connection> object when an HTTP
+message has been received. An B<ev_server_request> event is
+dispatched.
 
-sub mux_close($$) {
-    my ($self, $mux, $fh) = @_;
+=cut
 
-    $self->log('CLOSE');
-    delete $self->{'socket'} if $fh == $self->{'socket'};
-}
-
 sub got_request($$) {
     my ($self, $connection, $request) = @_;
 
@@ -114,131 +136,42 @@
     $self->{'engine'}->ev_server_request($self, $connection, $request);
 }
 
-package Varnish::Test::Server::Connection;
+=head1 IO::MULTIPLEX CALLBACKS
 
-use strict;
-use HTTP::Status;
+=head2 mux_connection
 
-sub new($$) {
-    my ($this, $server, $fh) = @_;
-    my $class = ref($this) || $this;
+Called by L<IO::Multiplex> when the listening socket has received a
+new connection. The file-handle of the new connection is provided as
+an argument and is given to a newly created
+L<Varnish::Test::Server::Connection> object which will operate the new
+connection from now on.
 
-    my $self = bless({ 'server' => $server,
-		       'engine' => $server->{'engine'},
-		       'fh' => $fh,
-		       'mux' => $server->{'mux'},
-		       'data' => '' }, $class);
-    $self->{'mux'}->set_callback_object($self, $fh);
-    return $self;
-}
+=cut
 
-sub send_response($$) {
-    my ($self, $response) = @_;
+sub mux_connection($$$) {
+    my ($self, $mux, $fh) = @_;
 
-    $response->message(status_message($response->code()))
-	unless $response->message();
-    $self->{'mux'}->write($self->{'fh'}, $response->as_string("\r\n"));
-    $self->{'server'}->{'responses'} += 1;
-    $self->{'server'}->logf("%s %s", $response->code(), $response->message());
+    $self->log('CONNECT');
+    my $connection = Varnish::Test::Server::Connection->new($self, $fh);
 }
 
-sub shutdown($) {
-    my ($self) = @_;
+=head2 mux_close
 
-    my $inbuffer = $self->{'mux'}->inbuffer($self->{'fh'});
+Called by L<IO::Multiplex> when the listening socket has been closed.
 
-    if (defined($inbuffer) and $inbuffer ne '') {
-	use Data::Dumper;
+=cut
 
-	$self->{'server'}->log('Junk or incomplete request. Discarding: ' . Dumper(\$inbuffer));
-	$self->{'mux'}->inbuffer($self->{'fh'}, '');
-    }
-
-    $self->{'mux'}->close($self->{'fh'});
-}
-
-sub mux_input($$$$) {
-    my ($self, $mux, $fh, $data) = @_;
-
-    $mux->set_timeout($fh, undef);
-
-    # Iterate through the input buffer ($$data) and identify HTTP
-    # messages, one per iteration. Break out of the loop when there
-    # are no complete HTTP messages left in the buffer, and let
-    # whatever data remains stay in the buffer, as we will get a new
-    # chance to parse it next time we get more data ("mux_input").
-    while ($$data =~ /\n\r?\n/) {
-	# If we find a double (CR)LF in the input data, we have at
-	# least a complete header section of a message, so look for
-	# content-length and decide what to do.
-
-	my $request = HTTP::Request->parse($$data);
-	my $content_ref = $request->content_ref;
-	my $content_length = $request->content_length;
-
-	if (defined($content_length)) {
-	    my $data_length = length($$content_ref);
-	    if ($data_length == $content_length) {
-		# We found exactly content-length amount of data, so
-		# empty input buffer and send request to event
-		# handling.
-		$$data = '';
-		$self->{'server'}->got_request($self, $request);
-	    }
-	    elsif ($data_length < $content_length) {
-		# We only received the first part of an HTTP message,
-		# so break out of loop and wait for more.
-		$mux->set_timeout($fh, 2);
-		last;
-	    }
-	    else {
-		# We have more than content-length data, which means
-		# more than just one HTTP message. The extra data
-		# (beyond content-length) is now at the end of
-		# $$content_ref, so move it back to the input buffer
-		# so we can parse it on the next iteration. Note that
-		# this "substr" also removes this data from
-		# $$content_ref (the message body of $request itself).
-		$$data = substr($$content_ref, $content_length,
-				$data_length - $content_length, '');
-		# Send request to event handling.
-		$self->{'server'}->got_request($self, $request);
-	    }
-	}
-	else {
-	    # HTTP requests without a content-length has no body by
-	    # definition, so whatever was parsed as content must be
-	    # the start of another request. Hence, move this back to
-	    # input buffer and empty the body of this $request. Then,
-	    # send $request to event handling.
-
-	    $$data = $$content_ref;
-	    $$content_ref = '';
-	    $self->{'server'}->got_request($self, $request);
-	}
-    }
-}
-
-sub mux_timeout($$$) {
+sub mux_close($$) {
     my ($self, $mux, $fh) = @_;
 
-    $self->{'mux'}->set_timeout($fh, undef);
-    $self->{'engine'}->ev_server_timeout($self);
+    $self->log('CLOSE');
+    delete $self->{'socket'} if $fh == $self->{'socket'};
 }
 
-sub mux_eof($$$$) {
-    my ($self, $mux, $fh, $data) = @_;
+1;
 
-    # On server side, HTTP does not use EOF from client to signal end
-    # of request, so if there is anything left in input buffer, it
-    # must be incomplete because "mux_input" left it there.
+=head1 SEE ALSO
 
-    if ($$data ne '') {
-	use Data::Dumper;
+L<Varnish::Test::Server::Connection>
 
-	$self->{'server'}->log('Junk or incomplete request. Discarding: ' . Dumper($data));
-	$$data = '';
-    }
-}
-
-1;
+=cut

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Varnish.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Varnish.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Varnish.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -30,17 +30,19 @@
 
 =head1 NAME
 
-Varnish::Test::Varnish - Varnish child-process controller
+Varnish::Test::Varnish - Varnish daemon process controller
 
 =head1 DESCRIPTION
 
-A Varnish::Test::Varnish object is used to fork off a Varnish child
-process and control traffic going into and coming out of the Varnish
-(management process) command-line interface (CLI).
+A Varnish::Test::Varnish object is used to fork off a Varnish daemon
+(varnishd) process and control traffic going into and coming out of
+the Varnish (management process) command-line interface (CLI).
 
 Various events are generated when certain strings are identified in
 the output from the CLI.
 
+=head1 METHODS
+
 =cut
 
 package Varnish::Test::Varnish;
@@ -50,6 +52,13 @@
 use IO::Socket::INET;
 use Socket;
 
+=head2 new
+
+Called by an Varnish::Test::Engine object to create a
+Varnish::Test::Varnish object which spawns a "varnishd" sub-process.
+
+=cut
+
 sub new($$;$) {
     my ($this, $engine, $attrs) =  @_;
     my $class = ref($this) || $this;
@@ -145,12 +154,25 @@
     return $self;
 }
 
+=head2 log
+
+Logging facility.
+
+=cut
+
 sub log($$) {
     my ($self, $str) = @_;
 
     $self->{'engine'}->log($self, 'VAR: ', $str);
 }
 
+=head2 backend_block
+
+Return a string containing a VCL "backend" block containing the
+information about the running backend (Varnish::Test::Server object).
+
+=cut
+
 sub backend_block($$) {
     my ($self, $name) = @_;
 
@@ -158,6 +180,13 @@
 		   $name, split(':', $self->{'engine'}->{'config'}->{'server_address'}));
 }
 
+=head2 send_command
+
+Called by main program or test-cases to send commands to the Varnish
+deamon.
+
+=cut
+
 sub send_command($@) {
     my ($self, @args) = @_;
     die "not ready\n"
@@ -186,18 +215,38 @@
     return ($code, $text);
 }
 
+=head2 send_vcl
+
+Send "vcl.inline" command to Varnish daemon.
+
+=cut
+
 sub send_vcl($$$) {
     my ($self, $config, $vcl) = @_;
 
     return $self->send_command('vcl.inline', $config, $vcl);
 }
 
+=head2 use_vcl
+
+Send "vcl.use" command to the Varnish daemon.
+
+=cut
+
 sub use_vcl($$) {
     my ($self, $config) = @_;
 
     return $self->send_command('vcl.use', $config);
 }
 
+=head2 start_child
+
+Issue command to start Varnish daemon's child process, so that HTTP
+traffic may begin. An B<ev_varnish_started> will be dispatched from
+"mux_input" once the child actually has started.
+
+=cut
+
 sub start_child($) {
     my ($self) = @_;
     die "not ready\n"
@@ -223,6 +272,12 @@
     return (500, 'unable to start child');
 }
 
+=head2 stop_child
+
+Issue command to stop Varnish daemon's child process.
+
+=cut
+
 sub stop_child($) {
     my ($self) = @_;
     die "not ready\n"
@@ -246,12 +301,24 @@
     return (500, 'unable to stop child');
 }
 
+=head2 set_param
+
+Send "param.set" command to Varnish daemon.
+
+=cut
+
 sub set_param($$$) {
     my ($self, $param, $value) = @_;
 
     return $self->send_command('param.set', $param, $value);
 }
 
+=head2 shutdown
+
+Shutdown Varnish daemon.
+
+=cut
+
 sub shutdown($) {
     my ($self) = @_;
 
@@ -267,6 +334,14 @@
 	if $self->{'pid'};
 }
 
+=head2 mux_input
+
+Called by L<IO::Multiplex> when new input is received on the Varnish
+daemon's output channels. Dispatches relevant events based on the
+output received.
+
+=cut
+
 sub mux_input($$$$) {
     my ($self, $mux, $fh, $data) = @_;
 
@@ -318,6 +393,13 @@
     }
 }
 
+=head2 mux_timeout
+
+Called by L<IO::Multiplex> when a specified timeout has been reached
+on an associated file-handle. Dispatch an B<ev_varnish_timeout> event.
+
+=cut
+
 sub mux_timeout($$$) {
     my ($self, $mux, $fh) = @_;
 

Modified: trunk/varnish-tools/regress/lib/Varnish/Test.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test.pm	2007-09-04 14:00:13 UTC (rev 1936)
+++ trunk/varnish-tools/regress/lib/Varnish/Test.pm	2007-09-05 12:49:05 UTC (rev 1937)
@@ -34,7 +34,7 @@
 
 =head1 DESCRIPTION
 
-The varnish regression test framework works by starting up a Varnish
+The Varnish regression test framework works by starting up a Varnish
 process and then communicating with this process as both client and
 server.
 
@@ -63,7 +63,7 @@
 
 A single select(2)-driven loop is used to handle all activity on both
 server and client side, as well on Varnish's I/O-channels. This is
-done using IO::Multiplex.
+done using L<IO::Multiplex>.
 
 As a result of using a select-loop (as opposed to a multi-threaded or
 multi-process approach), the framework has an event-driven design in
@@ -98,6 +98,8 @@
 supposed to pause the select-loop and return control back to the main
 program.
 
+=head1 METHODS
+
 =cut
 
 package Varnish::Test;
@@ -105,6 +107,12 @@
 use Varnish::Test::Case;
 use Varnish::Test::Engine;
 
+=head2 new
+
+Create a new Test object.
+
+=cut
+
 sub new($) {
     my ($this) =  @_;
     my $class = ref($this) || $this;
@@ -112,6 +120,14 @@
     return bless({ 'cases' => [] }, $class);
 }
 
+=head2 start_engine
+
+Creates an associated L<Varnish::Test::Engine> object which in turn
+starts an L<IO::Multiplex>, a L<Varnish::Test::server>, and a
+L<Varnish::Test::Varnish> object.
+
+=cut
+
 sub start_engine($;@) {
     my ($self, @args) = @_;
 
@@ -119,6 +135,15 @@
     $self->{'engine'} = Varnish::Test::Engine->new(@args);
 }
 
+=head2 stop_engine
+
+Stop Engine object using its "shutdown" method which also stops the
+server, Varnish, and closes all other open sockets (which might have
+been left by client objects that have not been shut down explicitly
+during test-case run).
+
+=cut
+
 sub stop_engine($;$) {
     my ($self) = @_;
 
@@ -128,6 +153,13 @@
     }
 }
 
+=head2 cases
+
+Return a list of Perl modules under Varnish/Test/Case directory. These
+are all the available test-cases.
+
+=cut
+
 sub cases($) {
     my ($self) = @_;
 
@@ -141,6 +173,12 @@
     return @cases;
 }
 
+=head2 run_case
+
+Run a test-case given by its name.
+
+=cut
+
 sub run_case($$) {
     my ($self, $name) = @_;
 
@@ -166,6 +204,12 @@
     }
 }
 
+=head2 results
+
+Return a hashref of all test-case results.
+
+=cut
+
 sub results($) {
     my ($self) = @_;
 
@@ -177,8 +221,9 @@
 =head1 SEE ALSO
 
 L<Varnish::Test::Engine>
+L<Varnish::Test::Server>
 L<Varnish::Test::Varnish>
-L<Varnish::Test::Server>
 L<Varnish::Test::Case>
+L<IO::Multiplex>
 
 =cut




More information about the varnish-commit mailing list