]> err.no Git - varnish/commitdiff
* Added POD.
authorknutroy <knutroy@d4fa192b-c00b-0410-8231-f00ffab90ce4>
Wed, 5 Sep 2007 12:49:05 +0000 (12:49 +0000)
committerknutroy <knutroy@d4fa192b-c00b-0410-8231-f00ffab90ce4>
Wed, 5 Sep 2007 12:49:05 +0000 (12:49 +0000)
* Moved Varnish::Test::Server::Connection to its own module file.
* Removed TODO which was not too exciting anyway.

git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1937 d4fa192b-c00b-0410-8231-f00ffab90ce4

varnish-tools/regress/TODO [deleted file]
varnish-tools/regress/bin/varnish-regress.pl
varnish-tools/regress/lib/Varnish/Test.pm
varnish-tools/regress/lib/Varnish/Test/Case.pm
varnish-tools/regress/lib/Varnish/Test/Client.pm
varnish-tools/regress/lib/Varnish/Test/Engine.pm
varnish-tools/regress/lib/Varnish/Test/Report.pm
varnish-tools/regress/lib/Varnish/Test/Server.pm
varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm [new file with mode: 0644]
varnish-tools/regress/lib/Varnish/Test/Varnish.pm

diff --git a/varnish-tools/regress/TODO b/varnish-tools/regress/TODO
deleted file mode 100644 (file)
index 36e44f3..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-* Completely POD-ify Perl-code.
-* Detect and act upon unexpected death of Varnish grandchild process.
index da9ea5497e11e2af1140fb0892b469fd121c9853..55841137cb0849682ccb0a43e39611af28f7802b 100755 (executable)
 
 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 @@ MAIN:{
 =head1 SEE ALSO
 
 L<Varnish::Test>
+L<Varnish::Test::Report>
 
 =cut
index ae506d5bb0488565b8c43fc783675a4fe0867e02..719d7285a8d1c69b97359d1f108729721fc60d9a 100644 (file)
@@ -34,7 +34,7 @@ Varnish::Test - Regression test framework for Varnish
 
 =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 @@ of both HTTP client and server.
 
 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 @@ object, and also determines whether the event being processed is
 supposed to pause the select-loop and return control back to the main
 program.
 
+=head1 METHODS
+
 =cut
 
 package Varnish::Test;
@@ -105,6 +107,12 @@ package Varnish::Test;
 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 @@ sub new($) {
     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 @@ sub start_engine($;@) {
     $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 @@ sub stop_engine($;$) {
     }
 }
 
+=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 @@ sub cases($) {
     return @cases;
 }
 
+=head2 run_case
+
+Run a test-case given by its name.
+
+=cut
+
 sub run_case($$) {
     my ($self, $name) = @_;
 
@@ -166,6 +204,12 @@ sub run_case($$) {
     }
 }
 
+=head2 results
+
+Return a hashref of all test-case results.
+
+=cut
+
 sub results($) {
     my ($self) = @_;
 
@@ -177,8 +221,9 @@ sub results($) {
 =head1 SEE ALSO
 
 L<Varnish::Test::Engine>
-L<Varnish::Test::Varnish>
 L<Varnish::Test::Server>
+L<Varnish::Test::Varnish>
 L<Varnish::Test::Case>
+L<IO::Multiplex>
 
 =cut
index 3c09a16a62598b03e6304c51bf8ea603a0f296b8..b628b06a57d51c365171242856cb1ce0afcb5fe7 100644 (file)
@@ -34,14 +34,16 @@ Varnish::Test::Case - test-case superclass
 
 =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 HTTP::Response;
 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 @@ sub new($$) {
                       '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 @@ sub init($) {
     }
 }
 
+=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 @@ sub fini($) {
     }
 }
 
+=head2 run
+
+Run test-case proper when everything is set up right.
+
+=cut
+
 sub run($;@) {
     my ($self, @args) = @_;
 
@@ -162,18 +196,37 @@ sub run($;@) {
     $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 @@ sub results($) {
 # 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 @@ sub ev_client_timeout($$) {
     return $client;
 }
 
+=head2 ev_server_request
+
+=cut
+
 sub ev_server_request($$$$) {
     my ($self, $server, $connection, $request) = @_;
 
@@ -237,6 +304,10 @@ sub ev_server_request($$$$) {
     $connection->send_response($response);
 }
 
+=head2 ev_server_timeout
+
+=cut
+
 sub ev_server_timeout($$) {
     my ($self, $srvconn) = @_;
 
@@ -248,6 +319,16 @@ sub ev_server_timeout($$) {
 # 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 @@ sub request($$$$;$$) {
     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 @@ sub post($$$;$$) {
     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 @@ sub assert_code($$;$) {
        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 @@ sub assert_ok($;$) {
     $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 @@ sub assert_xid($;$) {
        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 @@ sub assert_no_xid($;$) {
        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 @@ sub assert_cached($;$) {
        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 @@ sub assert_uncached($;$) {
        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 @@ sub assert_header($$;$$) {
     }
 }
 
+=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 @@ sub assert_body($;$$) {
     }
 }
 
+=head2 assert_no_body
+
+Assert absence of HTTP body.
+
+=cut
+
 sub assert_no_body($;$) {
     my ($self, $resp) = @_;
 
@@ -402,6 +568,14 @@ sub assert_no_body($;$) {
 # Miscellaneous
 #
 
+=head1 MISCELLANEOUS METHODS
+
+=head2 usleep
+
+Sleep for a given number of microseconds.
+
+=cut
+
 sub usleep($$) {
     my ($self, $usec) = @_;
 
@@ -409,3 +583,11 @@ sub usleep($$) {
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<Varnish::Test::Client>
+L<HTTP::Request>
+L<HTTP::Response>
+
+=cut
index 0245364737150e8f3c538adc4f87bc226102acf2..07016d6f3c5213e147569866c45874cc77015e62 100644 (file)
@@ -44,9 +44,17 @@ package Varnish::Test::Client;
 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 @@ sub new($$) {
     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 @@ sub send_request($$;$) {
     $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 @@ sub got_response($$) {
     $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 @@ sub shutdown($) {
     }
 }
 
+=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 @@ sub mux_input($$$$) {
     # 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 @@ sub mux_eof($$$$) {
     }
 }
 
+=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 @@ sub mux_timeout($$$) {
     $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 @@ sub mux_close($$) {
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<HTTP::Response>
+L<HTTP::Request>
+
+=cut
index 32824389551a1f3c79902f075ea29cbfbb1d8773..eae44a43e566db3ea7a05b02b53829d9b1db0932 100644 (file)
@@ -34,14 +34,14 @@ Varnish::Test::Engine - select-loop wrapper and event dispatcher
 
 =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
 
@@ -53,6 +53,16 @@ use Varnish::Test::Server;
 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 @@ sub new($$;%) {
     return $self;
 }
 
+=head2 log
+
+Logging facility.
+
+=cut
+
 sub log($$$) {
     my ($self, $object, $prefix, $str) = @_;
 
@@ -92,6 +108,14 @@ sub log($$$) {
     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 @@ sub run_loop($@) {
     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 shutdown($) {
     }
 }
 
-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 @@ sub AUTOLOAD ($;@) {
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<Varnish::Test::Varnish>
+L<Varnish::Test::Server>
+L<IO::Multiplex>
+
+=cut
index 55bc0dd7914ab77a086b65f8b26a0c5bfef7ac17..2b0b2bb955f86d3ea00818d7520908a3b39fd5e4 100644 (file)
 # $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 @@ sub new($) {
     return $self;
 }
 
+=head2 new
+
+Generate report.
+
+=cut
+
 sub run($@) {
     my ($self, @cases) = @_;
 
@@ -75,3 +101,9 @@ sub run($@) {
 }
 
 1;
+
+=head1 SEE ALSO
+
+L<Template>
+
+=cut
index a206468e5e4322fa2e564e4255bf12eb1455db8d..7bf60f2af56f34989da7fa623809b4f8232d6c54 100644 (file)
@@ -38,7 +38,7 @@ A Varnish::Test::Server object has the capability of listening on a
 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 @@ package Varnish::Test::Server;
 
 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 @@ sub new($$) {
     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,19 +120,13 @@ sub shutdown($) {
     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) = @_;
-
-    $self->log('CLOSE');
-    delete $self->{'socket'} if $fh == $self->{'socket'};
-}
+=cut
 
 sub got_request($$) {
     my ($self, $connection, $request) = @_;
@@ -114,131 +136,42 @@ sub got_request($$) {
     $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) = @_;
-
-    my $inbuffer = $self->{'mux'}->inbuffer($self->{'fh'});
+=head2 mux_close
 
-    if (defined($inbuffer) and $inbuffer ne '') {
-       use Data::Dumper;
+Called by L<IO::Multiplex> when the listening socket has been closed.
 
-       $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);
-       }
-    }
-}
+=cut
 
-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) = @_;
-
-    # 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.
+1;
 
-    if ($$data ne '') {
-       use Data::Dumper;
+=head1 SEE ALSO
 
-       $self->{'server'}->log('Junk or incomplete request. Discarding: ' . Dumper($data));
-       $$data = '';
-    }
-}
+L<Varnish::Test::Server::Connection>
 
-1;
+=cut
diff --git a/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm b/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm
new file mode 100644 (file)
index 0000000..7089318
--- /dev/null
@@ -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
index d6d9c11a84f7767a7db7a46621871f27d4dc18da..e38676f921d11d72ed69580a2be2a0990695591a 100644 (file)
 
 =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 strict;
 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 @@ sub new($$;$) {
     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 @@ sub backend_block($$) {
                   $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 @@ sub send_command($@) {
     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 @@ sub start_child($) {
     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 @@ sub stop_child($) {
     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 @@ sub shutdown($) {
        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 @@ sub mux_input($$$$) {
     }
 }
 
+=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) = @_;