|
From: Ilya M. <m_...@us...> - 2002-12-22 20:35:52
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest
In directory sc8-pr-cvs1:/tmp/cvs-serv4586/lib/HTTP/WebTest
Modified Files:
Utils.pm SelfTest.pm
Log Message:
Subroutines 'start_webserver' and 'stop_webserver' was moved from
HTTP::WebTest::SelfTest to HTTP::WebTest::Utils. They still can be
exported from HTTP::WebTest::SelfTest but their usage from this module
is deprecated.
Index: Utils.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Utils.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Utils.pm 21 Jun 2002 10:51:27 -0000 1.7
--- Utils.pm 22 Dec 2002 20:35:39 -0000 1.8
***************
*** 10,16 ****
use HTTP::WebTest::Utils;
- use HTTP::WebTest::Utils qw(make_access_method find_port);
- use HTTP::WebTest::Utils qw(copy_dir load_package);
- use HTTP::WebTest::Utils qw(eval_in_playground);
*method = make_access_method($field);
--- 10,13 ----
***************
*** 19,22 ****
--- 16,21 ----
find_port(hostname => $hostname);
+ my $pid = start_webserver(port => $port, server_sub => sub { ... });
+ stop_webserver($pid);
copy_dir($src_dir, $dst_dir);
***************
*** 29,34 ****
=head1 DESCRIPTION
! This packages contains utility subroutines used by
! L<HTTP::WebTest|HTTP::WebTest>.
=head1 SUBROUTINES
--- 28,34 ----
=head1 DESCRIPTION
! This packages contains utility subroutines used by
! L<HTTP::WebTest|HTTP::WebTest>. All of them can be exported but none
! of them is exported by default.
=head1 SUBROUTINES
***************
*** 51,55 ****
@EXPORT_OK = qw(make_access_method find_port
copy_dir load_package
! eval_in_playground make_sub_in_playground);
=head2 make_access_method($field, $optional_default_value)
--- 51,56 ----
@EXPORT_OK = qw(make_access_method find_port
copy_dir load_package
! eval_in_playground make_sub_in_playground
! start_webserver stop_webserver);
=head2 make_access_method($field, $optional_default_value)
***************
*** 133,136 ****
--- 134,228 ----
return undef;
+ }
+
+ =head2 start_webserver(%params)
+
+ Starts separate process with a test webserver.
+
+ =head3 Parameters
+
+ =over 4
+
+ =item port => $port
+
+ A port number where the test webserver listens for incoming connections.
+
+ =item server_sub => $server_sub
+
+ A reference on a subroutine to handle requests. It get passed two
+ named parameters: C<connect> and C<request>.
+
+ =back
+
+ =cut
+
+ sub start_webserver {
+ my %param = @_;
+
+ my $daemon = HTTP::Daemon->new(LocalPort => $param{port}, Reuse => 1)
+ or die;
+
+ # create daemon process
+ my $pid = fork;
+ die unless defined $pid;
+ return $pid if $pid != 0;
+
+ # when we are run under debugger do not stop and call debugger at
+ # the exit of the forked process. This helps to workaround problem
+ # when forked process tries to takeover and to screw the terminal
+ $DB::inhibit_exit = 0;
+
+ # if we are running with Test::Builder do not let it output
+ # anything for daemon process
+ if(Test::Builder->can('new')) {
+ Test::Builder->new->no_ending(1);
+ }
+
+ # set 'we are working' flag
+ my $done = 0;
+
+ # exit on SIGTERM
+ $SIG{TERM} = sub { $done = 1 };
+ # handle connections closed by client
+ $SIG{PIPE} = 'IGNORE';
+
+ # handle requests till process is killed
+ eval {
+ until($done) {
+ # wait one tenth of second for connection
+ my $rbits = '';
+ vec($rbits, $daemon->fileno, 1) = 1;
+ my $nfound = select $rbits, '', '', 0.1;
+
+ # handle incoming connections
+ if($nfound > 0) {
+ my $connect = $daemon->accept;
+ die unless defined $connect;
+
+ while (my $request = $connect->get_request) {
+ $param{server_sub}->(connect => $connect,
+ request => $request);
+ }
+ $connect->close;
+ }
+ }
+ };
+ # in any event try to shutdown daemon nicely
+ $daemon->close;
+ if($@) { die $@ };
+
+ exit 0;
+ }
+
+ =head2 stop_webserver($pid)
+
+ Kills a test webserver specified by its PID.
+
+ =cut
+
+ sub stop_webserver {
+ my $pid = shift;
+
+ return kill 'SIGTERM', $pid;
}
Index: SelfTest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/SelfTest.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** SelfTest.pm 19 Dec 2002 23:24:42 -0000 1.3
--- SelfTest.pm 22 Dec 2002 20:35:39 -0000 1.4
***************
*** 42,51 ****
use Algorithm::Diff qw(diff);
use MIME::Base64;
- use POSIX qw(SIGTERM);
use Sys::Hostname;
use Test;
use URI;
! use HTTP::WebTest::Utils qw(find_port);
=head2 $HOSTNAME
--- 42,50 ----
use Algorithm::Diff qw(diff);
use MIME::Base64;
use Sys::Hostname;
use Test;
use URI;
! use HTTP::WebTest::Utils qw(find_port start_webserver stop_webserver);
=head2 $HOSTNAME
***************
*** 361,455 ****
}
- =head2 start_webserver(%params)
-
- Starts separate process with a test webserver.
-
- =head3 Parameters
-
- =over 4
-
- =item port => $port
-
- A port number where the test webserver listens for incoming connections.
-
- =item server_sub => $server_sub
-
- A reference on a subroutine to handle requests. It get passed two
- named parameters: C<connect> and C<request>.
-
- =back
-
- =cut
-
- sub start_webserver {
- my %param = @_;
-
- my $daemon = HTTP::Daemon->new(LocalPort => $param{port}, Reuse => 1)
- or die;
-
- # create daemon process
- my $pid = fork;
- die unless defined $pid;
- return $pid if $pid != 0;
-
- # when we are run under debugger do not stop and call debugger at
- # the exit of the forked process. This helps to workaround problem
- # when forked process tries to takeover and to screw the terminal
- $DB::inhibit_exit = 0;
-
- # if we are running with Test::Builder do not let it output
- # anything for daemon process
- if(Test::Builder->can('new')) {
- Test::Builder->new->no_ending(1);
- }
-
- # set 'we are working' flag
- my $done = 0;
-
- # exit on SIGTERM
- $SIG{TERM} = sub { $done = 1 };
- # handle connections closed by client
- $SIG{PIPE} = 'IGNORE';
-
- # handle requests till process is killed
- eval {
- until($done) {
- # wait one tenth of second for connection
- my $rbits = '';
- vec($rbits, $daemon->fileno, 1) = 1;
- my $nfound = select $rbits, '', '', 0.1;
-
- # handle incoming connections
- if($nfound > 0) {
- my $connect = $daemon->accept;
- die unless defined $connect;
-
- while (my $request = $connect->get_request) {
- $param{server_sub}->(connect => $connect,
- request => $request);
- }
- $connect->close;
- }
- }
- };
- # in any event try to shutdown daemon nicely
- $daemon->close;
- if($@) { die $@ };
-
- exit 0;
- }
-
- =head2 stop_webserver($pid)
-
- Kills a test webserver specified by its PID.
-
- =cut
-
- sub stop_webserver {
- my $pid = shift;
-
- return kill SIGTERM, $pid;
- }
-
=head2 parse_basic_credentials($credentials)
--- 360,363 ----
***************
*** 475,478 ****
--- 383,404 ----
return ($user, $password);
}
+
+ =head1 DEPRECATED SUBROUTINES
+
+ This module imports in namespace of test script following helper
+ subroutines but they are deprecated and may be removed in the future
+ from this module.
+
+ =head2 start_webserver
+
+ This subroutine was moved into
+ L<HTTP::WebTest::Utils|HTTP::WebTest::Utils> but for backward
+ compatibility purposes can be exported from this module.
+
+ =head2 stop_webserver
+
+ This subroutine was moved into
+ L<HTTP::WebTest::Utils|HTTP::WebTest::Utils> but for backward
+ compatibility purposes can be exported from this module.
=head1 COPYRIGHT
|
