http-webtest-commits Mailing List for HTTP-WebTest (Page 28)
Brought to you by:
m_ilya,
richardanderson
Menu
▾
▴
http-webtest-commits
You can subscribe to this list here.
| 2002 |
Jan
(38) |
Feb
(83) |
Mar
(10) |
Apr
(28) |
May
(42) |
Jun
(61) |
Jul
(43) |
Aug
(42) |
Sep
(14) |
Oct
(27) |
Nov
(16) |
Dec
(81) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2003 |
Jan
(81) |
Feb
(29) |
Mar
(32) |
Apr
(42) |
May
(3) |
Jun
|
Jul
(11) |
Aug
|
Sep
(33) |
Oct
(6) |
Nov
(4) |
Dec
|
| 2004 |
Jan
|
Feb
|
Mar
(10) |
Apr
(1) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Ilya M. <m_...@us...> - 2002-02-12 12:47:19
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin
In directory usw-pr-cvs1:/tmp/cvs-serv23059/lib/HTTP/WebTest/Plugin
Modified Files:
DefaultReport.pm
Log Message:
Added report parameter show_headers
Index: DefaultReport.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/DefaultReport.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** DefaultReport.pm 2 Feb 2002 04:08:19 -0000 1.3
--- DefaultReport.pm 12 Feb 2002 12:47:10 -0000 1.4
***************
*** 51,54 ****
--- 51,66 ----
Name associated with this url in the test report and error messages.
+ =head2 show_headers
+
+ Include request and response headers in the test report.
+
+ =head3 Allowed values
+
+ C<yes>, C<no>
+
+ =head3 Default value
+
+ C<no>
+
=head2 show_html
***************
*** 107,110 ****
--- 119,123 ----
show_html yesno
show_cookies yesno
+ show_headers yesno
terse scalar('^(?:no|summary|failed_only)$') );
}
***************
*** 133,137 ****
return unless $self->global_yesno_test_param('default_report', 1);
! $self->validate_params(qw(test_name show_html
show_cookies terse));
--- 146,150 ----
return unless $self->global_yesno_test_param('default_report', 1);
! $self->validate_params(qw(test_name show_html show_headers
show_cookies terse));
***************
*** 140,143 ****
--- 153,157 ----
my $show_html = $self->yesno_test_param('show_html');
my $show_cookies = $self->yesno_test_param('show_cookies');
+ my $show_headers = $self->yesno_test_param('show_headers');
my $terse = lc $self->test_param('terse');
***************
*** 185,190 ****
my $request = $self->webtest->last_request;
if($show_cookies) {
! # sent and recieved cookies
my @sent = $request->header('Cookie');
--- 199,217 ----
my $request = $self->webtest->last_request;
+ if($show_headers) {
+ # show all headers
+
+ $out .= "\n";
+
+ $out .= " REQUEST HEADERS:\n";
+ $out .= $request->method . ' ' . $request->uri . "\n";
+ $out .= $request->headers_as_string . "\n";
+ $out .= " RESPONSE HEADERS:\n";
+ $out .= $response->protocol . " " . $response->status_line . "\n";
+ $out .= $response->headers_as_string . "\n";
+ }
+
if($show_cookies) {
! # show sent and recieved cookies
my @sent = $request->header('Cookie');
|
|
From: Ilya M. <m_...@us...> - 2002-02-12 12:17:48
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t/test.out
In directory usw-pr-cvs1:/tmp/cvs-serv17588/t/test.out
Added Files:
user_agent
Log Message:
Added tests for 'user_agent'
--- NEW FILE: user_agent ---
Failed Succeeded Test Name
0 2 *** no name ***
0 2 *** no name ***
URL: http://http.web.test/show-agent
STATUS CODE CHECK
200 OK SUCCEED
REQUIRED TEXT
User agent: HTTP-WebTest/1.99_03 SUCCEED
URL: http://http.web.test/show-agent
STATUS CODE CHECK
200 OK SUCCEED
REQUIRED TEXT
User agent: Test Test SUCCEED
Total web tests failed: 0 succeeded: 4
|
|
From: Ilya M. <m_...@us...> - 2002-02-12 12:17:48
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv17588/t
Modified Files:
02-generic.t
Log Message:
Added tests for 'user_agent'
Index: 02-generic.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/02-generic.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** 02-generic.t 7 Feb 2002 23:34:25 -0000 1.2
--- 02-generic.t 12 Feb 2002 12:17:44 -0000 1.3
***************
*** 18,22 ****
use vars qw($HOSTNAME $PORT $URL);
! BEGIN { plan tests => 16 }
# init tests
--- 18,22 ----
use vars qw($HOSTNAME $PORT $URL);
! BEGIN { plan tests => 17 }
# init tests
***************
*** 352,355 ****
--- 352,377 ----
}
+ # 17: test user_agent parameter
+ {
+ my $version = HTTP::WebTest->VERSION;
+
+ my $tests = [ { url => abs_url($URL, '/show-agent'),
+ text_require => [ "User agent: HTTP-WebTest/$version" ], },
+ { url => abs_url($URL, '/show-agent'),
+ user_agent => 'Test Test',
+ text_require => [ "User agent: Test Test" ] }
+ ];
+
+ my $out_filter = sub {
+ $_[0] =~ s|HTTP-WebTest/\Q$version\E|HTTP-WebTest/NN|g;
+ };
+
+ check_webtest(webtest => $WEBTEST,
+ server_url => $URL,
+ tests => $tests,
+ out_filtet => $out_filter,
+ check_file => 't/test.out/user_agent');
+ }
+
# try to stop server even we have been crashed
END { stop_webserver($PID) if defined $PID }
***************
*** 426,429 ****
--- 448,461 ----
}
}
+
+ # create response object
+ my $response = new HTTP::Response(RC_OK);
+ $response->header(Content_Type => 'text/plain');
+ $response->content($content);
+
+ # send it to browser
+ $connect->send_response($response);
+ } elsif($path eq '/show-agent') {
+ my $content = 'User agent: ' . $request->user_agent;
# create response object
|
|
From: Ilya M. <m_...@us...> - 2002-02-12 12:17:12
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin
In directory usw-pr-cvs1:/tmp/cvs-serv17422/lib/HTTP/WebTest/Plugin
Modified Files:
SetRequest.pm
Log Message:
Added test parameter 'user_agent'
Index: SetRequest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/SetRequest.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** SetRequest.pm 7 Feb 2002 23:41:34 -0000 1.4
--- SetRequest.pm 12 Feb 2002 12:17:00 -0000 1.5
***************
*** 86,98 ****
for proxy server access authorization.
=cut
sub param_types {
! return q(url uri
! method scalar('^(?:GET|POST)$')
! params hashlist
! auth list('scalar','scalar')
! proxies hashlist
! pauth list('scalar','scalar'));
}
--- 86,110 ----
for proxy server access authorization.
+ =head2 user_agent
+
+ Get/set the product token that is used to identify the user agent on
+ the network.
+
+ =head3 Default value
+
+ C<HTTP-WebTest/NN>
+
+ where C<NN> is version number of HTTP-WebTest.
+
=cut
sub param_types {
! return q(url uri
! method scalar('^(?:GET|POST)$')
! params hashlist
! auth list('scalar','scalar')
! proxies hashlist
! pauth list('scalar','scalar')
! user_agent scalar);
}
***************
*** 107,119 ****
$self->validate_params(qw(url method params
! auth proxies pauth));
# get various params we handle
! my $url = $self->test_param('url');
! my $method = $self->test_param('method');
! my $params = $self->test_param('params');
! my $auth = $self->test_param('auth');
my $proxies = $self->test_param('proxies');
! my $pauth = $self->test_param('pauth');
# fix broken url
--- 119,133 ----
$self->validate_params(qw(url method params
! auth proxies pauth
! user_agent));
# get various params we handle
! my $url = $self->test_param('url');
! my $method = $self->test_param('method');
! my $params = $self->test_param('params');
! my $auth = $self->test_param('auth');
my $proxies = $self->test_param('proxies');
! my $pauth = $self->test_param('pauth');
! my $ua_name = $self->test_param('user_agent');
# fix broken url
***************
*** 169,172 ****
--- 183,191 ----
$request->proxy_authorization_basic(@$pauth);
}
+
+ # set user agent name
+ $ua_name = 'HTTP-WebTest/' . HTTP::WebTest->VERSION
+ unless defined $ua_name;
+ $user_agent->agent($ua_name);
}
|
|
From: Ilya M. <m_...@us...> - 2002-02-12 11:48:26
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv10794/t
Modified Files:
simple.wt 06-parser.t
Log Message:
Added more tests for handling of double quote enclosed strings in
wtscript files.
Index: simple.wt
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/simple.wt,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** simple.wt 9 Feb 2002 16:15:49 -0000 1.5
--- simple.wt 12 Feb 2002 11:48:21 -0000 1.6
***************
*** 26,30 ****
'test @a'
"test $a"
! "test @a" )
regex_forbid = ( More = tests
Some @#$%^&* chars
--- 26,34 ----
'test @a'
"test $a"
! "test @a"
! "test \$a"
! "\$a"
! "\\$a"
! "\\\$a")
regex_forbid = ( More = tests
Some @#$%^&* chars
Index: 06-parser.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/06-parser.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** 06-parser.t 9 Feb 2002 16:25:16 -0000 1.8
--- 06-parser.t 12 Feb 2002 11:48:21 -0000 1.9
***************
*** 13,19 ****
require 't/utils.pl';
! BEGIN { plan tests => 54 }
! # 1-46: check parsed wt script (which contains all variants of
# supported syntax)
{
--- 13,19 ----
require 't/utils.pl';
! BEGIN { plan tests => 58 }
! # 1-50: check parsed wt script (which contains all variants of
# supported syntax)
{
***************
*** 28,32 ****
ok($tests->[0]{auth}[0] eq 'name');
ok($tests->[0]{auth}[1] eq 'value');
! ok(@{$tests->[0]{regex_require}} == 8);
ok($tests->[0]{regex_require}[0] eq 'Quoted text " test');
ok($tests->[0]{regex_require}[1] eq 'We can => quote \'');
--- 28,32 ----
ok($tests->[0]{auth}[0] eq 'name');
ok($tests->[0]{auth}[1] eq 'value');
! ok(@{$tests->[0]{regex_require}} == 12);
ok($tests->[0]{regex_require}[0] eq 'Quoted text " test');
ok($tests->[0]{regex_require}[1] eq 'We can => quote \'');
***************
*** 37,40 ****
--- 37,44 ----
ok($tests->[0]{regex_require}[6] eq 'test $a');
ok($tests->[0]{regex_require}[7] eq 'test @a');
+ ok($tests->[0]{regex_require}[8] eq 'test \\$a');
+ ok($tests->[0]{regex_require}[9] eq '\\$a');
+ ok($tests->[0]{regex_require}[10] eq '\\$a');
+ ok($tests->[0]{regex_require}[11] eq '\\\\$a');
ok($tests->[0]{url} eq 'www.dot.com');
ok(@{$tests->[0]{regex_forbid}} == 6);
***************
*** 80,84 ****
}
! # 47-54: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
--- 84,88 ----
}
! # 51-58: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
|
|
From: Ilya M. <m_...@us...> - 2002-02-12 11:47:37
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest
In directory usw-pr-cvs1:/tmp/cvs-serv10522/lib/HTTP/WebTest
Modified Files:
Parser.pm
Log Message:
Fix bug with handling of $ @ chars in test parameter values enclosed
in double quotes
Index: Parser.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Parser.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Parser.pm 8 Feb 2002 14:31:34 -0000 1.6
--- Parser.pm 12 Feb 2002 11:47:20 -0000 1.7
***************
*** 103,108 ****
# let Perl remove quote chars and handle special
# sequences like \n but don't treat $ and @ as
! # special
! $extracted =~ s/(\$|\@)/\\\\$1/g if $delim eq '"';
my $string = eval "$extracted";
$string;
--- 103,114 ----
# let Perl remove quote chars and handle special
# sequences like \n but don't treat $ and @ as
! # special. Note \\\\ in patterns. It is actually just
! # *one* backslash. Four chars are because of double
! # quoting (one inside parser grammar definition,
! # second inside regexp body)
! if($delim eq '"') {
! $extracted =~ s/(^|[^\\\\])((?:\\\\\\\\)*)(\\\\)(\$|\@)/$1$2$3$3$4/g;
! $extracted =~ s/(\$|\@)/\\\\$1/g;
! }
my $string = eval "$extracted";
$string;
|
|
From: Ilya M. <m_...@us...> - 2002-02-09 16:25:20
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv4068
Modified Files:
06-parser.t
Log Message:
Added more tests for parser
Index: 06-parser.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/06-parser.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** 06-parser.t 9 Feb 2002 16:21:36 -0000 1.7
--- 06-parser.t 9 Feb 2002 16:25:16 -0000 1.8
***************
*** 13,19 ****
require 't/utils.pl';
! BEGIN { plan tests => 49 }
! # 1-41: check parsed wt script (which contains all variants of
# supported syntax)
{
--- 13,19 ----
require 't/utils.pl';
! BEGIN { plan tests => 54 }
! # 1-46: check parsed wt script (which contains all variants of
# supported syntax)
{
***************
*** 28,31 ****
--- 28,32 ----
ok($tests->[0]{auth}[0] eq 'name');
ok($tests->[0]{auth}[1] eq 'value');
+ ok(@{$tests->[0]{regex_require}} == 8);
ok($tests->[0]{regex_require}[0] eq 'Quoted text " test');
ok($tests->[0]{regex_require}[1] eq 'We can => quote \'');
***************
*** 37,40 ****
--- 38,42 ----
ok($tests->[0]{regex_require}[7] eq 'test @a');
ok($tests->[0]{url} eq 'www.dot.com');
+ ok(@{$tests->[0]{regex_forbid}} == 6);
ok($tests->[0]{regex_forbid}[0] eq 'More = tests');
ok($tests->[0]{regex_forbid}[1] eq 'Some @#$%^&* chars');
***************
*** 48,51 ****
--- 50,56 ----
ok($tests->[1]{test_name} eq 'Another name # this is not a comment');
ok($tests->[1]{url} eq 'www.tiv.net');
+ ok(@{$tests->[1]{cookie}} == 2);
+ ok(@{$tests->[1]{cookie}[0]} == 12);
+ ok(@{$tests->[1]{cookie}[1]} == 12);
ok($tests->[1]{cookie}[0][0] eq '0');
ok($tests->[1]{cookie}[0][1] eq 'webtest');
***************
*** 75,79 ****
}
! # 42-49: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
--- 80,84 ----
}
! # 47-54: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
|
|
From: Ilya M. <m_...@us...> - 2002-02-09 16:21:40
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv3382
Modified Files:
06-parser.t
Log Message:
Minor fix
Index: 06-parser.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/06-parser.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** 06-parser.t 9 Feb 2002 16:15:49 -0000 1.6
--- 06-parser.t 9 Feb 2002 16:21:36 -0000 1.7
***************
*** 15,19 ****
BEGIN { plan tests => 49 }
! # 1-41: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
--- 15,20 ----
BEGIN { plan tests => 49 }
! # 1-41: check parsed wt script (which contains all variants of
! # supported syntax)
{
my $filename = shift;
|
|
From: Ilya M. <m_...@us...> - 2002-02-09 16:16:04
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv2099/t
Modified Files:
simple.wt 06-parser.t
Log Message:
Added a couple of new tests for wtscript parser
Index: simple.wt
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/simple.wt,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** simple.wt 8 Feb 2002 14:28:35 -0000 1.4
--- simple.wt 9 Feb 2002 16:15:49 -0000 1.5
***************
*** 12,15 ****
--- 12,18 ----
elements )
+ ignore_case =
+ no
+
test_name = Some name here
# another comment here
***************
*** 30,36 ****
)
auth = ( name => value )
end_test
! test_name = Another name
url = www.tiv.net
cookie = ( 0
--- 33,42 ----
)
auth = ( name => value )
+ ignore_case =yes
+ show_cookies= yes
+ show_html=no
end_test
! test_name = Another name # this is not a comment
url = www.tiv.net
cookie = ( 0
Index: 06-parser.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/06-parser.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** 06-parser.t 8 Feb 2002 14:28:35 -0000 1.5
--- 06-parser.t 9 Feb 2002 16:15:49 -0000 1.6
***************
*** 13,19 ****
require 't/utils.pl';
! BEGIN { plan tests => 45 }
! # 1-37: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
--- 13,19 ----
require 't/utils.pl';
! BEGIN { plan tests => 49 }
! # 1-41: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
***************
*** 42,46 ****
ok($tests->[0]{regex_forbid}[4] eq 'abcdef 1234');
ok($tests->[0]{regex_forbid}[5] eq ' a b c d \' e f ');
! ok($tests->[1]{test_name} eq 'Another name');
ok($tests->[1]{url} eq 'www.tiv.net');
ok($tests->[1]{cookie}[0][0] eq '0');
--- 42,49 ----
ok($tests->[0]{regex_forbid}[4] eq 'abcdef 1234');
ok($tests->[0]{regex_forbid}[5] eq ' a b c d \' e f ');
! ok($tests->[0]{ignore_case} eq 'yes');
! ok($tests->[0]{show_cookies} eq 'yes');
! ok($tests->[0]{show_html} eq 'no');
! ok($tests->[1]{test_name} eq 'Another name # this is not a comment');
ok($tests->[1]{url} eq 'www.tiv.net');
ok($tests->[1]{cookie}[0][0] eq '0');
***************
*** 68,74 ****
ok($opts->{text_forbid}[2] eq 'for list');
ok($opts->{text_forbid}[3] eq 'elements');
}
! # 38-45: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
--- 71,78 ----
ok($opts->{text_forbid}[2] eq 'for list');
ok($opts->{text_forbid}[3] eq 'elements');
+ ok($opts->{ignore_case} eq 'no')
}
! # 42-49: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
|
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:31:41
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest In directory usw-pr-cvs1:/tmp/cvs-serv23812 Modified Files: Parser.pm Log Message: Minor fix Index: Parser.pm =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Parser.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Parser.pm 8 Feb 2002 14:25:31 -0000 1.5 --- Parser.pm 8 Feb 2002 14:31:34 -0000 1.6 *************** *** 104,108 **** # sequences like \n but don't treat $ and @ as # special ! $extracted =~ s/(\$|\@)/\\$1/g if $delim eq '"'; my $string = eval "$extracted"; $string; --- 104,108 ---- # sequences like \n but don't treat $ and @ as # special ! $extracted =~ s/(\$|\@)/\\\\$1/g if $delim eq '"'; my $string = eval "$extracted"; $string; |
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:28:45
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv22651/t
Modified Files:
simple.wt 06-parser.t
Log Message:
Updated
Index: simple.wt
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/simple.wt,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** simple.wt 8 Feb 2002 14:06:16 -0000 1.3
--- simple.wt 8 Feb 2002 14:28:35 -0000 1.4
***************
*** 21,25 ****
'test \''
'test $a'
! 'test @a' )
regex_forbid = ( More = tests
Some @#$%^&* chars
--- 21,27 ----
'test \''
'test $a'
! 'test @a'
! "test $a"
! "test @a" )
regex_forbid = ( More = tests
Some @#$%^&* chars
Index: 06-parser.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/06-parser.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** 06-parser.t 8 Feb 2002 14:06:16 -0000 1.4
--- 06-parser.t 8 Feb 2002 14:28:35 -0000 1.5
***************
*** 13,19 ****
require 't/utils.pl';
! BEGIN { plan tests => 43 }
! # 1-35: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
--- 13,19 ----
require 't/utils.pl';
! BEGIN { plan tests => 45 }
! # 1-37: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
***************
*** 33,36 ****
--- 33,38 ----
ok($tests->[0]{regex_require}[4] eq 'test $a');
ok($tests->[0]{regex_require}[5] eq 'test @a');
+ ok($tests->[0]{regex_require}[6] eq 'test $a');
+ ok($tests->[0]{regex_require}[7] eq 'test @a');
ok($tests->[0]{url} eq 'www.dot.com');
ok($tests->[0]{regex_forbid}[0] eq 'More = tests');
***************
*** 68,72 ****
}
! # 36-43: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
--- 70,74 ----
}
! # 38-45: check error handling for borked wtscript files
parse_error_check(wtscript => 't/borked1.wt',
check_file => 't/test.out/borked1.err');
|
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:25:36
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest In directory usw-pr-cvs1:/tmp/cvs-serv21659 Modified Files: Parser.pm Log Message: Fix typo Index: Parser.pm =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Parser.pm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Parser.pm 8 Feb 2002 14:07:39 -0000 1.4 --- Parser.pm 8 Feb 2002 14:25:31 -0000 1.5 *************** *** 102,106 **** my $delim = substr $extracted, 0, 1; # let Perl remove quote chars and handle special ! # sequences like \n but don't tread $ and @ as # special $extracted =~ s/(\$|\@)/\\$1/g if $delim eq '"'; --- 102,106 ---- my $delim = substr $extracted, 0, 1; # let Perl remove quote chars and handle special ! # sequences like \n but don't treat $ and @ as # special $extracted =~ s/(\$|\@)/\\$1/g if $delim eq '"'; |
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:07:42
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest
In directory usw-pr-cvs1:/tmp/cvs-serv15007/lib/HTTP/WebTest
Modified Files:
Parser.pm
Log Message:
Rules for test parameters value quoting have been changed to be more
Perl alike.
Index: Parser.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Parser.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Parser.pm 29 Jan 2002 03:52:40 -0000 1.3
--- Parser.pm 8 Feb 2002 14:07:39 -0000 1.4
***************
*** 99,103 ****
qscalar: { $extracted = extract_delimited($text) }
! { substr $extracted, 1, length($extracted) - 2 }
uscalar: <rulevar: $word_re = qr/ (?: [^=)\s] | [^)\s] (?!>) ) /x>
--- 99,111 ----
qscalar: { $extracted = extract_delimited($text) }
! {
! my $delim = substr $extracted, 0, 1;
! # let Perl remove quote chars and handle special
! # sequences like \n but don't tread $ and @ as
! # special
! $extracted =~ s/(\$|\@)/\\$1/g if $delim eq '"';
! my $string = eval "$extracted";
! $string;
! }
uscalar: <rulevar: $word_re = qr/ (?: [^=)\s] | [^)\s] (?!>) ) /x>
|
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:06:51
|
Update of /cvsroot/http-webtest/HTTP-WebTest
In directory usw-pr-cvs1:/tmp/cvs-serv14615
Modified Files:
Changes
Log Message:
Updated
Index: Changes
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/Changes,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Changes 2 Feb 2002 04:08:19 -0000 1.11
--- Changes 8 Feb 2002 14:06:48 -0000 1.12
***************
*** 13,17 ****
* Improve syntax error reporting in parser of wtscript files.
! * Support for embeded Perl in wtscript files in parser.
INCOMPATIBILITIES:
--- 13,17 ----
* Improve syntax error reporting in parser of wtscript files.
! * Support for embeded Perl in wtscript files.
INCOMPATIBILITIES:
***************
*** 20,23 ****
--- 20,44 ----
been fixed to conform new API. This change is required for proper
support of embeded Perl in wtscript files.
+
+ * Changed format of wtscript files. Speaking more precisely rules for
+ test parameters value quoting have been changed to be more Perl
+ alike. It means that value of param should be written either as
+
+ value - any string without special chars like => or ). It is
+ treated in same way as in old HTTP::WebTest
+
+ "value" - usual Perl string quoting rules apply (i.e sequences
+ like \n, \r, etc are treated as special and " can be escaped with
+ \"). It is new in HTTP::WebTest.
+
+ 'value' - usual Perl string quoting rules apply (i.e sequences
+ like \n is not tread as special but ' can be escaped with
+ \'). This change breaks previosly allowed ''value'' style for
+ escaping quote characters.
+
+ Also Perl expression in curly brackets can be
+ specified instead of test parameter value. Like
+
+ url = { "http://" . 'somehost.com' }
1.99_03 Mon Jan 28 2002
|
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:06:32
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv14417/t
Modified Files:
simple.wt 06-parser.t
Log Message:
Updated
Index: simple.wt
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/simple.wt,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** simple.wt 29 Jan 2002 03:52:40 -0000 1.2
--- simple.wt 8 Feb 2002 14:06:16 -0000 1.3
***************
*** 17,21 ****
regex_require = (
'Quoted text " test'
! "We can => quote '" )
regex_forbid = ( More = tests
Some @#$%^&* chars
--- 17,25 ----
regex_require = (
'Quoted text " test'
! "We can => quote '"
! "test \""
! 'test \''
! 'test $a'
! 'test @a' )
regex_forbid = ( More = tests
Some @#$%^&* chars
Index: 06-parser.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/06-parser.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** 06-parser.t 29 Jan 2002 03:52:40 -0000 1.3
--- 06-parser.t 8 Feb 2002 14:06:16 -0000 1.4
***************
*** 13,19 ****
require 't/utils.pl';
! BEGIN { plan tests => 39 }
! # 1-31: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
--- 13,19 ----
require 't/utils.pl';
! BEGIN { plan tests => 43 }
! # 1-35: check parsing wt script (contain all syntax variants)
{
my $filename = shift;
***************
*** 29,32 ****
--- 29,36 ----
ok($tests->[0]{regex_require}[0] eq 'Quoted text " test');
ok($tests->[0]{regex_require}[1] eq 'We can => quote \'');
+ ok($tests->[0]{regex_require}[2] eq 'test "');
+ ok($tests->[0]{regex_require}[3] eq "test '");
+ ok($tests->[0]{regex_require}[4] eq 'test $a');
+ ok($tests->[0]{regex_require}[5] eq 'test @a');
ok($tests->[0]{url} eq 'www.dot.com');
ok($tests->[0]{regex_forbid}[0] eq 'More = tests');
***************
*** 64,80 ****
}
! # 32-39: check error handling for borked wtscript files
! parse_error_check('t/borked1.wt', 't/test.out/borked1.err');
! parse_error_check('t/borked2.wt', 't/test.out/borked2.err');
! parse_error_check('t/borked3.wt', 't/test.out/borked3.err');
! parse_error_check('t/borked4.wt', 't/test.out/borked4.err');
! parse_error_check('t/borked5.wt', 't/test.out/borked5.err');
! parse_error_check('t/borked6.wt', 't/test.out/borked6.err');
! parse_error_check('t/borked7.wt', 't/test.out/borked7.err');
! parse_error_check('t/borked8.wt', 't/test.out/borked8.err');
sub parse_error_check {
! my $wtscript = shift;
! my $check_file = shift;
eval {
--- 68,100 ----
}
! # 36-43: check error handling for borked wtscript files
! parse_error_check(wtscript => 't/borked1.wt',
! check_file => 't/test.out/borked1.err');
! parse_error_check(wtscript => 't/borked2.wt',
! check_file => 't/test.out/borked2.err');
! parse_error_check(wtscript => 't/borked3.wt',
! check_file => 't/test.out/borked3.err');
! parse_error_check(wtscript => 't/borked4.wt',
! check_file => 't/test.out/borked4.err');
! parse_error_check(wtscript => 't/borked5.wt',
! check_file => 't/test.out/borked5.err');
! parse_error_check(wtscript => 't/borked6.wt',
! check_file => 't/test.out/borked6.err');
! {
! my $out_filter = sub {
! $_[0] =~ s/\(eval \d+\)/(eval NN)/;
! };
! parse_error_check(wtscript => 't/borked7.wt',
! check_file => 't/test.out/borked7.err',
! out_filter => $out_filter);
! }
! parse_error_check(wtscript => 't/borked8.wt',
! check_file => 't/test.out/borked8.err');
sub parse_error_check {
! my %param = @_;
! my $wtscript = $param{wtscript};
! my $check_file = $param{check_file};
! my $out_filter = $param{out_filter};
eval {
***************
*** 84,88 ****
if($@) {
my $text = $@;
! compare_output(check_file => $check_file, output_ref => \$text);
} else {
ok(0);
--- 104,112 ----
if($@) {
my $text = $@;
! my @out_filter = $out_filter ? (out_filter => $out_filter) : ();
! canonical_output(output_ref => \$text,
! @out_filter);
! compare_output(check_file => $check_file,
! output_ref => \$text);
} else {
ok(0);
|
|
From: Ilya M. <m_...@us...> - 2002-02-08 14:06:31
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t/test.out In directory usw-pr-cvs1:/tmp/cvs-serv14417/t/test.out Modified Files: borked7.err Log Message: Updated Index: borked7.err =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/test.out/borked7.err,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** borked7.err 29 Jan 2002 03:52:39 -0000 1.1 --- borked7.err 8 Feb 2002 14:06:16 -0000 1.2 *************** *** 1,5 **** HTTP::WebTest: wtscript parsing error Line 3: Eval error ! Bareword "code" not allowed while "strict subs" in use at (eval 42) line 2. near --- 1,5 ---- HTTP::WebTest: wtscript parsing error Line 3: Eval error ! Bareword "code" not allowed while "strict subs" in use at (eval NN) line 2. near |
|
From: Ilya M. <m_...@us...> - 2002-02-07 23:41:37
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin
In directory usw-pr-cvs1:/tmp/cvs-serv25476/lib/HTTP/WebTest/Plugin
Modified Files:
SetRequest.pm
Log Message:
Allow request params be passed as hashref
Index: SetRequest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/SetRequest.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** SetRequest.pm 2 Feb 2002 04:08:19 -0000 1.3
--- SetRequest.pm 7 Feb 2002 23:41:34 -0000 1.4
***************
*** 141,145 ****
# the application/x-www-form-urlencoded content.
my $url = URI->new('http:');
! $url->query_form(@$params);
my $query = $url->query;
--- 141,146 ----
# the application/x-www-form-urlencoded content.
my $url = URI->new('http:');
! my @params = ref($params) eq 'ARRAY' ? @$params : %$params;
! $url->query_form(@params);
my $query = $url->query;
|
|
From: Ilya M. <m_...@us...> - 2002-02-07 23:39:59
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest
In directory usw-pr-cvs1:/tmp/cvs-serv25077/lib/HTTP/WebTest
Modified Files:
Plugin.pm
Log Message:
More support for embeded Perl
Index: Plugin.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Plugin.pm 2 Feb 2002 04:08:19 -0000 1.3
--- Plugin.pm 7 Feb 2002 23:39:55 -0000 1.4
***************
*** 79,83 ****
my $ret = defined $value ? $value : $default;
! return $self->canonic_value($ret);
}
--- 79,83 ----
my $ret = defined $value ? $value : $default;
! return $self->_canonic_value($ret);
}
***************
*** 103,107 ****
if(defined $self->webtest->last_test) {
$value = $self->webtest->last_test->param($param);
! $value = $self->merge_param($value, $global_value);
} else {
$value = $global_value;
--- 103,107 ----
if(defined $self->webtest->last_test) {
$value = $self->webtest->last_test->param($param);
! $value = defined $value ? $value : $global_value;
} else {
$value = $global_value;
***************
*** 110,114 ****
my $ret = defined $value ? $value : $default;
! return $self->canonic_value($ret);
}
--- 110,114 ----
my $ret = defined $value ? $value : $default;
! return $self->_canonic_value($ret);
}
***************
*** 159,191 ****
}
! =head2 merge_params ($value, $global_value)
!
! Merges test parameter value with global test parameter value.
!
! =head3 Returns
!
! A merged test parameter value.
!
! =cut
!
! sub merge_param {
! my $self = shift;
! my $value = shift;
! my $global_value = shift;
!
! return defined $value ? $value : $global_value;
! }
!
! =head2 canonic_value ($value)
!
! =head3 Returns
!
! If C<$value> is a reference on subroutine then calls this subroutine
! and returns value returned by subroutine. Otherwise just returns
! C<$value>.
!
! =cut
!
! sub canonic_value {
my $self = shift;
my $value = shift;
--- 159,165 ----
}
! # searches passed data structure for code references and replaces them
! # with value returned by referenced subs
! sub _canonic_value {
my $self = shift;
my $value = shift;
***************
*** 195,198 ****
--- 169,180 ----
}
+ if(ref($value) eq 'ARRAY') {
+ $value = [ map $self->_canonic_value($_), @$value ];
+ } elsif(ref($value) eq 'HASH') {
+ for my $key (keys %$value) {
+ $value->{$key} = $self->_canonic_value($value->{$key});
+ }
+ }
+
return $value;
}
***************
*** 305,309 ****
if $@;
! $self->$method($param, $self->canonic_value($value), @args);
}
--- 287,291 ----
if $@;
! $self->$method($param, $self->_canonic_value($value), @args);
}
***************
*** 511,520 ****
die "HTTP::WebTest: parameter '$param' is neither a hash nor a list with even number of elements"
unless $ok;
-
- my $check = $self->check_list($param, $value);
- $check &&= ((@$value % 2) == 0);
- $check ||= ref($value) eq 'HASH';
-
- return $check;
}
--- 493,496 ----
|
|
From: Ilya M. <m_...@us...> - 2002-02-07 23:34:28
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t
In directory usw-pr-cvs1:/tmp/cvs-serv23394/t
Modified Files:
02-generic.t 01-api.t
Log Message:
Updated tests, removed tests for test params validation for now
Index: 02-generic.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/02-generic.t,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** 02-generic.t 24 Jan 2002 12:26:13 -0000 1.1.1.1
--- 02-generic.t 7 Feb 2002 23:34:25 -0000 1.2
***************
*** 18,22 ****
use vars qw($HOSTNAME $PORT $URL);
! BEGIN { plan tests => 13 }
# init tests
--- 18,22 ----
use vars qw($HOSTNAME $PORT $URL);
! BEGIN { plan tests => 16 }
# init tests
***************
*** 316,319 ****
--- 316,353 ----
tests => $tests,
check_file => 't/test.out/short-url');
+ }
+
+ # 14-16: subroutines as value of test parameter
+ {
+ my $tests = [ { url => sub { abs_url($URL, '/test-file1') } },
+ { url => sub { abs_url($URL, '/status-forbidden') } }
+ ];
+
+ check_webtest(webtest => $WEBTEST,
+ server_url => $URL,
+ tests => $tests,
+ check_file => 't/test.out/subparam1');
+
+ $tests = [ { url => abs_url($URL, '/show-request'),
+ params => sub { [ qw(a b c d) ] },
+ text_require => [ 'Query: <a=b&c=d>',
+ sub { 'Method: <GET>' } ] }
+ ];
+
+ check_webtest(webtest => $WEBTEST,
+ server_url => $URL,
+ tests => $tests,
+ check_file => 't/test.out/subparam2');
+
+ $tests = [ { url => abs_url($URL, '/show-request'),
+ params => sub { my %h = ( qw(a b c d) ); \%h },
+ text_require => [ 'Query: <a=b&c=d>',
+ sub { 'Method: <GET>' } ] }
+ ];
+
+ check_webtest(webtest => $WEBTEST,
+ server_url => $URL,
+ tests => $tests,
+ check_file => 't/test.out/subparam2');
}
Index: 01-api.t
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/t/01-api.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** 01-api.t 28 Jan 2002 09:49:56 -0000 1.4
--- 01-api.t 7 Feb 2002 23:34:25 -0000 1.5
***************
*** 16,20 ****
use vars qw($HOSTNAME $PORT $URL);
! BEGIN { plan tests => 16 }
# init test
--- 16,20 ----
use vars qw($HOSTNAME $PORT $URL);
! BEGIN { plan tests => 13 }
# init test
***************
*** 75,146 ****
}
! # 9: test validate_params
! {
! my $tests = [ { url => [] },
! { url => 'http://test.org',
! method => 'invalid' },
! { url => 'http://this.uri.is/good',
! method => 'GET' },
! { method => 'post' },
! { auth => [1, 2] },
! { pauth => {} },
! { auth => [3] },
! { params => { a => 'b' } },
! { params => 1 },
! { ignore_case => '' },
! { ignore_case => 'Yes' },
! { ignore_case => 'nO' } ];
!
! my $res = '';
! for my $test (@$tests) {
! my %checks = $WEBTEST->validate_params($test);
!
! # order of keys in hashes is different in various versions of
! # Perl so we sort hash values by key to make sure that this
! # test works on all versions of Perl
! for my $param (sort keys %checks) {
! my $result = $checks{$param};
! $res .= "$param\n";
! $res .= "Comment: " . $result->comment . "\n";
! $res .= "Ok: " . ($result->ok ? 'yes' : 'no') . "\n";
! }
!
! $res .= "\n";
! }
!
! compare_output(output_ref => \$res,
! check_file => 't/test.out/check-params');
! }
!
! # 10-11: check how webtest handles broken tests
! {
! my $tests = [ { url => [] } ];
!
! # no bad global params
! check_webtest(webtest => $WEBTEST,
! server_url => $URL,
! tests => $tests,
! check_file => 't/test.out/broken-test');
!
! # some bad global params
! eval {
! my $opts = { plugins => '',
! mail_addresses => '',
! mail => {},
! mail_server => {},
! mail_from => [] };
! $WEBTEST->run_tests($tests, $opts);
! };
! if($@) {
! my $res = $@;
! $res =~ s/(at )\S+( line )\d+(\.)$/$1SomeFile$2SomeLine$3/;
! compare_output(output_ref => \$res,
! check_file => 't/test.out/check-global-params');
! } else {
! ok(0);
! }
! }
!
! # 12-13: parse wt script
{
my $data = read_file('t/simple.wt');
--- 75,79 ----
}
! # 9-10: parse wt script
{
my $data = read_file('t/simple.wt');
***************
*** 151,155 ****
}
! # 14: run tests defined in wt script
{
generate_wscript(file => 't/real.wt', server_url => $URL);
--- 84,88 ----
}
! # 11: run tests defined in wt script
{
generate_wscript(file => 't/real.wt', server_url => $URL);
***************
*** 164,168 ****
}
! # 15-16: test num_fail and num_succeed
{
my $tests = [ { url => abs_url($URL, '/test-file1') },
--- 97,101 ----
}
! # 12-13: test num_fail and num_succeed
{
my $tests = [ { url => abs_url($URL, '/test-file1') },
|
|
From: Ilya M. <m_...@us...> - 2002-02-07 23:34:28
|
Update of /cvsroot/http-webtest/HTTP-WebTest/t/test.out
In directory usw-pr-cvs1:/tmp/cvs-serv23394/t/test.out
Added Files:
subparam2 subparam1
Removed Files:
check-params check-global-params broken-test
Log Message:
Updated tests, removed tests for test params validation for now
--- NEW FILE: subparam2 ---
Failed Succeeded Test Name
0 3 *** no name ***
URL: http://http.web.test/show-request?a=b&c=d
STATUS CODE CHECK
200 OK SUCCEED
REQUIRED TEXT
Query: <a=b&c=d> SUCCEED
Method: <GET> SUCCEED
Total web tests failed: 0 succeeded: 3
--- NEW FILE: subparam1 ---
Failed Succeeded Test Name
0 1 *** no name ***
1 0 *** no name ***
URL: http://http.web.test/test-file1
STATUS CODE CHECK
200 OK SUCCEED
URL: http://http.web.test/status-forbidden
STATUS CODE CHECK
403 Forbidden FAIL
Total web tests failed: 1 succeeded: 1
--- check-params DELETED ---
--- check-global-params DELETED ---
--- broken-test DELETED ---
|
|
From: Ilya M. <m_...@us...> - 2002-02-07 23:33:13
|
Update of /cvsroot/http-webtest/HTTP-WebTest In directory usw-pr-cvs1:/tmp/cvs-serv23047 Modified Files: TODO MANIFEST Log Message: Updated Index: TODO =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/TODO,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** TODO 2 Feb 2002 04:08:19 -0000 1.3 --- TODO 7 Feb 2002 23:33:09 -0000 1.4 *************** *** 3,24 **** My current TODO: ! * fix tests which were broken by test parameter validation API change * update plugin writer guide with info about new test parameter validation API - * write more tests from test parameter validation - - * write cookbook - * resurrect all parameter checks from old HTTP::WebTest * generate index of test parameters in a reference - * reread all docs to check if it makes any sense - * add pointers on ::HarnessReport in HTTP::WebTest docs - - * embeded Perl in wtscripts * polish local mode tests - they are *very* non portable now --- 3,18 ---- My current TODO: ! * document usage of embeded Perl in wtscript files ! ! * test broken tests diagnostics * update plugin writer guide with info about new test parameter validation API * resurrect all parameter checks from old HTTP::WebTest * generate index of test parameters in a reference * add pointers on ::HarnessReport in HTTP::WebTest docs * polish local mode tests - they are *very* non portable now Index: MANIFEST =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/MANIFEST,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** MANIFEST 29 Jan 2002 03:54:19 -0000 1.3 --- MANIFEST 7 Feb 2002 23:33:09 -0000 1.4 *************** *** 75,81 **** t/test.out/borked7.err t/test.out/borked8.err - t/test.out/broken-test - t/test.out/check-global-params - t/test.out/check-params t/test.out/cookie1 t/test.out/cookie2 --- 75,78 ---- *************** *** 100,103 **** --- 97,102 ---- t/test.out/size t/test.out/status + t/test.out/subparam1 + t/test.out/subparam2 t/test.out/test-harness t/test.out/test_name |
|
From: Ilya M. <m_...@us...> - 2002-02-02 04:08:33
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin
In directory usw-pr-cvs1:/tmp/cvs-serv10555/lib/HTTP/WebTest/Plugin
Modified Files:
TextMatchTest.pm SetRequest.pm ResponseTimeTest.pm Loader.pm
HarnessReport.pm DefaultReport.pm Cookies.pm
ContentSizeTest.pm Apache.pm
Log Message:
Test parameters validation API have been changed. All plugins have
been fixed to conform new API. This change is required for proper
support of embeded Perl in wtscript files.
Index: TextMatchTest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/TextMatchTest.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** TextMatchTest.pm 2002/01/24 12:26:33 1.1.1.1
--- TextMatchTest.pm 2002/02/02 04:08:19 1.2
***************
*** 76,84 ****
sub param_types {
! return { qw(ignore_case yesno
! text_forbid list
! text_require list
! regex_forbid list
! regex_require list) };
}
--- 76,84 ----
sub param_types {
! return q(ignore_case yesno
! text_forbid list
! text_require list
! regex_forbid list
! regex_require list);
}
***************
*** 88,91 ****
--- 88,95 ----
# response content
my $content = $self->webtest->last_response->content;
+
+ $self->validate_params(qw(ignore_case
+ text_forbid text_require
+ regex_forbid regex_require));
# ignore case or not?
Index: SetRequest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/SetRequest.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** SetRequest.pm 2002/01/28 06:32:02 1.2
--- SetRequest.pm 2002/02/02 04:08:19 1.3
***************
*** 89,123 ****
sub param_types {
! return { qw(url uri
! method string
! params hashlist
! auth list
! proxies hashlist
! pauth list) };
! }
!
! sub validate_params {
! my $self = shift;
! my $params = shift;
!
! my %checks = $self->SUPER::validate_params($params);
!
! if(exists $checks{method}) {
! $checks{method} &&=
! $self->test_result($params->{method} =~ /^(?:GET|POST)$/i ? 1 : 0,
! 'Request method should be either GET or POST.');
! }
! if(exists $checks{auth}) {
! $checks{auth} &&=
! $self->test_result(@{$params->{auth}} == 2,
! 'Parameter auth should have two elements.');
! }
! if(exists $checks{pauth}) {
! $checks{pauth} &&=
! $self->test_result(@{$params->{pauth}} == 2,
! 'Parameter auth should have two elements.');
! }
!
! return %checks;
}
--- 89,98 ----
sub param_types {
! return q(url uri
! method scalar('^(?:GET|POST)$')
! params hashlist
! auth list('scalar','scalar')
! proxies hashlist
! pauth list('scalar','scalar'));
}
***************
*** 130,133 ****
--- 105,111 ----
# get request object
my $request = $self->webtest->last_request;
+
+ $self->validate_params(qw(url method params
+ auth proxies pauth));
# get various params we handle
Index: ResponseTimeTest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/ResponseTimeTest.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** ResponseTimeTest.pm 2002/01/24 12:26:30 1.1.1.1
--- ResponseTimeTest.pm 2002/02/02 04:08:19 1.2
***************
*** 45,50 ****
sub param_types {
! return { qw(min_rtime string
! max_rtime string) };
}
--- 45,50 ----
sub param_types {
! return q(min_rtime scalar
! max_rtime scalar);
}
***************
*** 54,57 ****
--- 54,59 ----
# response time
my $rtime = $self->webtest->last_response_time;
+
+ $self->validate_params(qw(min_rtime max_rtime));
# response time limits
Index: Loader.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/Loader.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** Loader.pm 2002/01/24 12:26:32 1.1.1.1
--- Loader.pm 2002/02/02 04:08:19 1.2
***************
*** 45,53 ****
sub param_types {
! return { qw(plugins list) };
}
sub start_tests {
my $self = shift;
my $plugins = $self->global_test_param('plugins');
--- 45,55 ----
sub param_types {
! return q(plugins list);
}
sub start_tests {
my $self = shift;
+
+ $self->global_validate_params(qw(plugins));
my $plugins = $self->global_test_param('plugins');
Index: HarnessReport.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/HarnessReport.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** HarnessReport.pm 2002/01/24 12:26:30 1.1.1.1
--- HarnessReport.pm 2002/02/02 04:08:19 1.2
***************
*** 54,57 ****
--- 54,59 ----
my @results = @{$self->webtest->last_test->results};
+ $self->validate_params(qw(test_name));
+
my $test_name = $self->test_param('test_name');
my $url = 'N/A';
Index: DefaultReport.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/DefaultReport.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** DefaultReport.pm 2002/01/28 06:32:02 1.2
--- DefaultReport.pm 2002/02/02 04:08:19 1.3
***************
*** 102,126 ****
sub param_types {
! return { %{ shift->SUPER::param_types },
! qw(default_report yesno
! test_name string
! show_html yesno
! show_cookies yesno
! terse string) };
! }
!
! sub validate_params {
! my $self = shift;
! my $params = shift;
!
! my %checks = $self->SUPER::validate_params($params);
!
! if(exists $checks{terse}) {
! $checks{terse} &&=
! $self->test_result($params->{terse} =~ /^(?:no|summary|failed_only)$/i ? 1 : 0,
! 'Parameter terse can be either no, summary or failed_only.');
! }
!
! return %checks;
}
--- 102,111 ----
sub param_types {
! return shift->SUPER::param_types . "\n" .
! q(default_report yesno
! test_name scalar
! show_html yesno
! show_cookies yesno
! terse scalar('^(?:no|summary|failed_only)$') );
}
***************
*** 131,134 ****
--- 116,121 ----
my $self = shift;
+ $self->global_validate_params(qw(default_report));
+
return unless $self->global_yesno_test_param('default_report', 1);
***************
*** 142,147 ****
--- 129,139 ----
my $self = shift;
+ $self->global_validate_params(qw(default_report));
+
return unless $self->global_yesno_test_param('default_report', 1);
+ $self->validate_params(qw(test_name show_html
+ show_cookies terse));
+
# get test params we handle
my $test_name = $self->test_param('test_name');
***************
*** 234,237 ****
--- 226,231 ----
sub end_tests {
my $self = shift;
+
+ $self->global_validate_params(qw(default_report));
return unless $self->global_yesno_test_param('default_report', 1);
Index: Cookies.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/Cookies.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** Cookies.pm 2002/01/24 12:26:29 1.1.1.1
--- Cookies.pm 2002/02/02 04:08:19 1.2
***************
*** 225,232 ****
sub param_types {
! return { qw(accept_cookies yesno
! send_cookies yesno
! cookie list
! cookies list) };
}
--- 225,232 ----
sub param_types {
! return q(accept_cookies yesno
! send_cookies yesno
! cookie list
! cookies list);
}
***************
*** 235,238 ****
--- 235,241 ----
sub prepare_request {
my $self = shift;
+
+ $self->validate_params(qw(accept_cookies send_cookies
+ cookies cookie));
my $accept_cookies = $self->yesno_test_param('accept_cookies', 1);
Index: ContentSizeTest.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/ContentSizeTest.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** ContentSizeTest.pm 2002/01/24 12:26:32 1.1.1.1
--- ContentSizeTest.pm 2002/02/02 04:08:19 1.2
***************
*** 45,50 ****
sub param_types {
! return { qw(min_bytes string
! max_bytes string) };
}
--- 45,50 ----
sub param_types {
! return q(min_bytes scalar
! max_bytes scalar);
}
***************
*** 54,57 ****
--- 54,59 ----
# response content length
my $nbytes = length $self->webtest->last_response->content;
+
+ $self->validate_params(qw(min_bytes max_bytes));
# size limits
Index: Apache.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/Apache.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Apache.pm 2002/01/28 06:32:02 1.2
--- Apache.pm 2002/02/02 04:08:19 1.3
***************
*** 222,256 ****
sub param_types {
! return { qw(file_path list
! include_file_path list
! apache_dir string
! apache_loglevel string
! apache_exec string
! apache_options string
! apache_max_wait string
! error_log string
! ignore_error_log yesno
! mail_server string
! mail_addresses string) };
! }
!
! sub validate_params {
! my $self = shift;
! my $params = shift;
!
! my %checks = $self->SUPER::validate_params($params);
!
! if(exists $checks{file_path}) {
! $checks{file_path} &&=
! $self->test_result(@{$params->{file_path}} == 2,
! 'Parameter file_path should have two elements.');
! }
! if(exists $checks{include_file_path}) {
! $checks{include_file_path} &&=
! $self->test_result((@{$params->{include_file_path}} % 2) == 0,
! 'Parameter include_file_path should have even number of elements.');
! }
!
! return %checks;
}
--- 222,236 ----
sub param_types {
! return q(file_path list('scalar','scalar')
! include_file_path hashlist
! apache_dir scalar
! apache_loglevel scalar
! apache_exec scalar
! apache_options scalar
! apache_max_wait scalar
! error_log scalar
! ignore_error_log yesno
! mail_server scalar
! mail_addresses scalar);
}
***************
*** 289,292 ****
--- 269,277 ----
my $request = $self->webtest->last_request;
+ $self->global_validate_params(qw(apache_dir apache_loglevel
+ apache_exec apache_options
+ apache_max_wait error_log));
+ $self->validate_params(qw(file_path include_file_path));
+
# get various params we handle
my $apache_dir = $self->global_test_param('apache_dir');
***************
*** 352,355 ****
--- 337,342 ----
my $self = shift;
+ $self->validate_params(qw(ignore_error_log));
+
# get various params we handle
my $ignore_error_log = $self->yesno_test_param('ignore_error_log');
***************
*** 469,472 ****
--- 456,461 ----
my $config = join '', <$fh_in>; # Slurp entire file
$fh_in->close;
+
+ $self->global_validate_params(qw(mail_server mail_addresses));
# get test params we use
|
|
From: Ilya M. <m_...@us...> - 2002-02-02 04:08:26
|
Update of /cvsroot/http-webtest/HTTP-WebTest In directory usw-pr-cvs1:/tmp/cvs-serv10555 Modified Files: TODO Changes Log Message: Test parameters validation API have been changed. All plugins have been fixed to conform new API. This change is required for proper support of embeded Perl in wtscript files. Index: TODO =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/TODO,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** TODO 2002/01/28 07:11:05 1.2 --- TODO 2002/02/02 04:08:19 1.3 *************** *** 3,6 **** --- 3,13 ---- My current TODO: + * fix tests which were broken by test parameter validation API change + + * update plugin writer guide with info about new test parameter + validation API + + * write more tests from test parameter validation + * write cookbook Index: Changes =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/Changes,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Changes 2002/01/29 03:52:40 1.10 --- Changes 2002/02/02 04:08:19 1.11 *************** *** 11,17 **** ENHANCEMENTS: ! * Improve syntax error reporting in parser of wtscript files ! * Support for embeded Perl in wtscript files in parser 1.99_03 Mon Jan 28 2002 --- 11,23 ---- ENHANCEMENTS: ! * Improve syntax error reporting in parser of wtscript files. ! * Support for embeded Perl in wtscript files in parser. ! ! INCOMPATIBILITIES: ! ! * Test parameters validation API have been changed. All plugins have ! been fixed to conform new API. This change is required for proper ! support of embeded Perl in wtscript files. 1.99_03 Mon Jan 28 2002 |
|
From: Ilya M. <m_...@us...> - 2002-02-02 04:08:26
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest
In directory usw-pr-cvs1:/tmp/cvs-serv10555/lib/HTTP/WebTest
Modified Files:
ReportPlugin.pm Plugin.pm API.pm
Log Message:
Test parameters validation API have been changed. All plugins have
been fixed to conform new API. This change is required for proper
support of embeded Perl in wtscript files.
Index: ReportPlugin.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/ReportPlugin.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** ReportPlugin.pm 2002/01/24 12:26:28 1.1.1.1
--- ReportPlugin.pm 2002/02/02 04:08:19 1.2
***************
*** 113,122 ****
# declare some supported test params
sub param_types {
! return { qw(output_ref stringref
! fh_out anything
! mail_addresses list
! mail string
! mail_server string
! mail_from string) };
}
--- 113,123 ----
# declare some supported test params
sub param_types {
! return q(output_ref stringref
! fh_out anything
! mail_addresses list('scalar','...')
! mail scalar
! mail_server scalar
! mail_from scalar
! test_name scalar);
}
***************
*** 148,151 ****
--- 149,154 ----
my $self = shift;
+ $self->global_validate_params(qw(output_ref fh_out));
+
my $output_ref = $self->global_test_param('output_ref');
my $fh_out = $self->global_test_param('fh_out');
***************
*** 213,216 ****
--- 216,222 ----
sub end_tests {
my $self = shift;
+
+ $self->global_validate_params(qw(mail_addresses mail
+ mail_server mail_from));
my $mail_addresses = $self->global_test_param('mail_addresses');
Index: Plugin.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Plugin.pm 2002/01/28 06:32:02 1.2
--- Plugin.pm 2002/02/02 04:08:19 1.3
***************
*** 77,82 ****
my $value = $self->webtest->global_test_param($param);
! return $default unless defined $value;
! return $value;
}
--- 77,83 ----
my $value = $self->webtest->global_test_param($param);
! my $ret = defined $value ? $value : $default;
!
! return $self->canonic_value($ret);
}
***************
*** 107,112 ****
}
! return $default unless defined $value;
! return $value;
}
--- 108,114 ----
}
! my $ret = defined $value ? $value : $default;
!
! return $self->canonic_value($ret);
}
***************
*** 157,161 ****
}
! =head2 merge_params ($param, $value, $global_value)
Merges test parameter value with global test parameter value.
--- 159,163 ----
}
! =head2 merge_params ($value, $global_value)
Merges test parameter value with global test parameter value.
***************
*** 175,178 ****
--- 177,201 ----
}
+ =head2 canonic_value ($value)
+
+ =head3 Returns
+
+ If C<$value> is a reference on subroutine then calls this subroutine
+ and returns value returned by subroutine. Otherwise just returns
+ C<$value>.
+
+ =cut
+
+ sub canonic_value {
+ my $self = shift;
+ my $value = shift;
+
+ if(ref($value) eq 'CODE') {
+ $value = $value->();
+ }
+
+ return $value;
+ }
+
=head2 test_result ($ok, $comment)
***************
*** 197,230 ****
}
! =head2 validate_params ($params)
! Checks test parameters.
! =head3 Returns
! A hash. The keys are the test parameters and the values are
! L<HTTP::WebTest::TestResult|HTTP::WebTest::TestResult> objects.
=cut
sub validate_params {
my $self = shift;
! my $params = shift;
! my %param_types = %{$self->param_types};
! my %checks = ();
! while(my($param, $type) = each %param_types) {
! my $method = 'check_' . $type;
! my $value = $params->{$param};
! next unless defined $value;
! my $ok = $self->$method($value);
! my $message = "Parameter $param should be of $type type.";
! $checks{$param} = $self->test_result($ok, $message);
}
! return %checks;
}
=head2 param_types ()
--- 220,311 ----
}
! # helper method used by validate_params and by global_validate_params
! # to validate values of test parameters
! sub _validate_params {
! my $self = shift;
! my %params = @_;
! my %param_types = grep $_ =~ /\S/, split /\s+/, $self->param_types;
! while(my($param, $value) = each %params) {
! next unless defined $value;
! my $type = $param_types{$param};
! die "HTTP::WebTest: unknown test parameter '$param'"
! unless defined $type;
!
! $self->validate_value($param, $value, $type);
! }
! }
!
! =head2 validate_params (@params)
+ Checks test parameters listed in C<@params>. Throws exception if any
+ of them are invalid.
+
=cut
sub validate_params {
my $self = shift;
! my @params = @_;
! my %params = ();
! for my $param (@params) {
! $params{$param} = $self->test_param($param);
! }
! $self->_validate_params(%params);
! }
!
! =head2 global_validate_params (@params)
!
! Checks global test parameters listed in C<@params>. Throws exception
! if any of them are invalid.
!
! =cut
!
! sub global_validate_params {
! my $self = shift;
! my @params = @_;
!
! my %params = ();
! for my $param (@params) {
! $params{$param} = $self->global_test_param($param);
}
! $self->_validate_params(%params);
}
+ =head2 validate_value($param, $value, $type)
+
+ Checks if C<$value> of test parameter C<$param> has type <$type>.
+
+ =head3 Exceptions
+
+ Dies if check is not successful.
+
+ =cut
+
+ sub validate_value {
+ my $self = shift;
+ my $param = shift;
+ my $value = shift;
+ my $type = shift;
+
+ # parse param type specification
+ my($method, $args) = $type =~ /^ (\w+) (?: \( (.*?) \) )? $/x;
+ die "HTTP::WebTest: bad type specification '$type'"
+ unless defined $method;
+ $method = 'check_' . $method;
+
+ # get additional arguments for type validation sub
+ $args = '' unless defined $args;
+ my @args = eval " ( $args ) ";
+ die "HTTP::WebTest: can't eval args '$args': $@"
+ if $@;
+
+ $self->$method($param, $self->canonic_value($value), @args);
+ }
+
=head2 param_types ()
***************
*** 235,244 ****
=head3 Returns
! An hash reference. Keys are names of test parameters which are
! supported by plugin. Values are their type.
=cut
! sub param_types { {} }
=head2 check_anything ($value)
--- 316,329 ----
=head3 Returns
! A string which looks like:
!
! 'param1 type1
! param2 type2
! param3 type3(optional,args)
! param4 type4'
=cut
! sub param_types { '' }
=head2 check_anything ($value)
***************
*** 247,253 ****
type.
! =head3 Returns
!
! Always true.
=cut
--- 332,336 ----
type.
! This is NOOP operation.
=cut
***************
*** 255,302 ****
sub check_anything { 1 }
! =head2 check_list ($value)
Method which checks test parameter if it is value is of C<list>
! type.
! =head3 Returns
! True if C<$value> is an array reference. False otherwise.
=cut
sub check_list {
my $self = shift;
my $value = shift;
! return ref($value) eq 'ARRAY';
}
! =head2 check_string ($value)
! Method which checks test parameter if it is value is of C<string>
! type.
! =head3 Returns
! True if C<$value> is a string. False otherwise.
=cut
! sub check_string {
my $self = shift;
my $value = shift;
! return not ref($value);
}
! =head2 check_stringref ($value)
Method which checks test parameter if it is value is of C<stringref>
! type.
! =head3 Returns
! True if C<$value> is a string reference. False otherwise.
=cut
--- 338,446 ----
sub check_anything { 1 }
! =head2 check_list ($param, $value, @optional_spec)
Method which checks test parameter if it is value is of C<list>
! type. That is it is a reference on an array.
! Optional list C<@optional_spec> can define specification on allowed
! elements of list. It can be either
! ('TYPE_1', 'TYPE_2', ..., 'TYPE_N')
+ or
+
+ ('TYPE_1', 'TYPE_2', ..., 'TYPE_M', '...')
+
+ First specification requires list value of test parameter to contain
+ C<N> elements. First element of list should be of should C<TYPE_1>
+ type, second element of list should of C<TYPE_2> type, ..., N-th
+ element of list should be of C<TYPE_N> type.
+
+ Second specification requires list value of test parameter to contain
+ at least C<N> elements. First element of list should be of should
+ C<TYPE_1> type, second element of list should of C<TYPE_2> type, ...,
+ M-th element of list should be of C<TYPE_M> type, all following
+ elements should be of C<TYPE_M> type.
+
+ =head3 Exceptions
+
+ Dies if checks is not successful.
+
=cut
sub check_list {
my $self = shift;
+ my $param = shift;
my $value = shift;
+ my @spec = @_;
! die "HTTP::WebTest: parameter '$param' is not a list"
! unless ref($value) eq 'ARRAY';
!
! return unless @spec;
!
! my @list = @$value;
! my $prev_type = undef;
! for my $i (0 .. @list - 1) {
! my $type = shift @spec;
!
! die "HTTP::WebTest: too many elements in list parameter '$param'"
! unless defined $type;
!
! if($type eq '...') {
! $type = $prev_type;
! push @spec, '...';
! }
!
! my $elem = $list[$i];
!
! $self->validate_value("$param\[$i\]", $elem, $type);
!
! $prev_type = $type;
! }
!
! shift @spec if defined $spec[1] and $spec[1] eq '...';
!
! die "HTTP::WebTest: too few elements in list parameter '$param'"
! if @spec;
}
! =head2 check_scalar ($param, $value, $optional_regexp)
! Method which checks test parameter if it is value is of C<scalar>
! type. That is it is usual Perl scalar and is not a reference.
! If C<$optional_regexp> is specified also checks value of parameter
! using this regual expression.
! =head3 Exceptions
!
! Dies if check is not successful.
=cut
! sub check_scalar {
my $self = shift;
+ my $param = shift;
my $value = shift;
+ my $optional_regexp = shift;
! die "HTTP::WebTest: parameter '$param' is not a scalar"
! unless not ref($value);
!
! return unless defined $optional_regexp;
!
! die "HTTP::WebTest: parameter '$param' doesn't match regexp '$optional_regexp'"
! unless $value =~ /$optional_regexp/i;
}
! =head2 check_stringref ($param, $value)
Method which checks test parameter if it is value is of C<stringref>
! type. That is it is a reference on scalar.
! =head3 Exceptions
! Dies if check is not successful.
=cut
***************
*** 304,320 ****
sub check_stringref {
my $self = shift;
my $value = shift;
! return ref($value) eq 'SCALAR';
}
! =head2 check_uri ($value)
Method which checks test parameter if it is value is of C<uri>
! type.
! =head3 Returns
! True if C<$value> is an URI. False otherwise.
=cut
--- 448,466 ----
sub check_stringref {
my $self = shift;
+ my $param = shift;
my $value = shift;
! die "HTTP::WebTest: parameter '$param' is not a scalar reference"
! unless ref($value) eq 'SCALAR';
}
! =head2 check_uri ($param, $value)
Method which checks test parameter if it is value is of C<uri>
! type. That is it either scalar or L<URI|URI> object.
! =head3 Exceptions
! Dies if check is not successful.
=cut
***************
*** 322,342 ****
sub check_uri {
my $self = shift;
my $value = shift;
! my $check = $self->check_string($value);
! $check ||= (defined ref($value) and UNIVERSAL::isa($value, 'URI'));
! return $check;
}
! =head2 check_hashlist ($value)
Method which checks test parameter if it is value is of C<hashlist>
! type.
! =head3 Returns
! True if C<$value> is a hash reference or an array reference which
! points to array containing even number of elements. False otherwise.
=cut
--- 468,494 ----
sub check_uri {
my $self = shift;
+ my $param = shift;
my $value = shift;
! my $ok = 1;
! eval { $self->check_scalar($param, $value) };
! if($@) {
! $ok = 0
! unless defined ref($value) and UNIVERSAL::isa($value, 'URI');
! }
! die "HTTP::WebTest: parameter '$param' is not a URI"
! unless $ok;
}
! =head2 check_hashlist ($param, $value)
Method which checks test parameter if it is value is of C<hashlist>
! type. That is it is either a hash reference or an array reference
! which points to array containing even number of elements.
! =head3 Exceptions
! Dies if check is not successful.
=cut
***************
*** 344,350 ****
sub check_hashlist {
my $self = shift;
my $value = shift;
! my $check = $self->check_list($value);
$check &&= ((@$value % 2) == 0);
$check ||= ref($value) eq 'HASH';
--- 496,516 ----
sub check_hashlist {
my $self = shift;
+ my $param = shift;
my $value = shift;
! my $ok = 1;
! eval { $self->check_list($param, $value) };
! if($@) {
! $ok = 0
! unless ref($value) eq 'HASH';
! } else {
! $ok = 0
! unless (@$value % 2) == 0;
! }
!
! die "HTTP::WebTest: parameter '$param' is neither a hash nor a list with even number of elements"
! unless $ok;
!
! my $check = $self->check_list($param, $value);
$check &&= ((@$value % 2) == 0);
$check ||= ref($value) eq 'HASH';
***************
*** 352,364 ****
return $check;
}
-
- =head2 check_yesno ($value)
! Method which checks test parameter if it is value is of C<yesno>
! type.
! =head3 Returns
! True if C<$value> is either C<yes> or C<no>. False otherwise.
=cut
--- 518,527 ----
return $check;
}
! =head2 check_yesno ($param, $value)
! Same as
! check_scalar($param, $value, '^(?:yes|no)$');
=cut
***************
*** 366,372 ****
sub check_yesno {
my $self = shift;
my $value = shift;
! return $value =~ /^(?:yes|no)$/i;
}
--- 529,536 ----
sub check_yesno {
my $self = shift;
+ my $param = shift;
my $value = shift;
! check_scalar($param, $value, '^(?:yes|no)$');
}
Index: API.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/API.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** API.pm 2002/01/28 07:11:05 1.3
--- API.pm 2002/02/02 04:08:19 1.4
***************
*** 103,119 ****
$self->_global_test_params($params);
- # validate global test parameters
- my %checks = $self->validate_params($params);
- # be sure that checks are sorted by param name
- my @broken = grep { not $_->ok } map $checks{$_}, sort keys %checks;
-
- # is is hard to report errors nicely (i.e. via report plugins)
- # here because plugins are not initialized yet. Just die right now
- # if there are any bad global test parameters
- if(@broken) {
- my $die = join "\n", 'HTTP::WebTest:', map $_->comment, @broken;
- die $die;
- }
-
# start tests hook
for my $plugin (@{$self->plugins}) {
--- 103,106 ----
***************
*** 515,567 ****
$self->_global_test_params($params);
! # validate test params
! my %checks = ($self->validate_params($test->params),
! $self->validate_params($params));
! # be sure that checks are sorted by param name
! my @broken = grep { not $_->ok } map $checks{$_}, sort keys %checks;
!
! if(@broken) {
! $self->last_test->reset;
! $self->last_results([ [ 'Test parameters error', @broken ] ]);
! } else {
!
! # create request (note that actual url is more likely to be
! # set in plugins)
! my $request = HTTP::Request->new('GET' => 'http://localhost/');
! $self->last_request($request);
! # set request object with plugins
! for my $plugin (@{$self->plugins}) {
! if($plugin->can('prepare_request')) {
! $plugin->prepare_request;
! }
}
! # measure current time
! my $time1 = time;
! # get response
! my $response = $self->user_agent->request($request);
! $self->last_response($response);
! # measure current time
! my $time2 = time;
! # calculate response time
! $self->last_response_time($time2 - $time1);
! # init results
! my @results = ();
! # check response with plugins
! for my $plugin (@{$self->plugins}) {
! if($plugin->can('check_response')) {
! push @results, $plugin->check_response;
! }
}
-
- $self->last_results(\@results);
}
# report test results
for my $plugin (@{$self->plugins}) {
--- 502,542 ----
$self->_global_test_params($params);
! # create request (note that actual url is more likely to be
! # set in plugins)
! my $request = HTTP::Request->new('GET' => 'http://localhost/');
! $self->last_request($request);
! # set request object with plugins
! for my $plugin (@{$self->plugins}) {
! if($plugin->can('prepare_request')) {
! $plugin->prepare_request;
}
+ }
! # measure current time
! my $time1 = time;
! # get response
! my $response = $self->user_agent->request($request);
! $self->last_response($response);
! # measure current time
! my $time2 = time;
! # calculate response time
! $self->last_response_time($time2 - $time1);
! # init results
! my @results = ();
! # check response with plugins
! for my $plugin (@{$self->plugins}) {
! if($plugin->can('check_response')) {
! push @results, $plugin->check_response;
}
}
+ $self->last_results(\@results);
+
# report test results
for my $plugin (@{$self->plugins}) {
***************
*** 593,625 ****
return wantarray ? @conv : $conv[0];
- }
-
- =head2 validate_params ($params)
-
- Validates test parameters.
-
- =head3 Returns
-
- A hash with results of checks. The keys are the test parameters and
- the values are L<HTTP::WebTest::TestResult|HTTP::WebTest::TestResult>
- objects.
-
- =cut
-
- sub validate_params {
- my $self = shift;
- my $params = shift;
-
- my %checks = ();
-
- # check params with all plugins
- for my $plugin (@{$self->plugins}) {
- if(my $validate_params = $plugin->can('validate_params')) {
- %checks = (%checks,
- $plugin->$validate_params($params));
- }
- }
-
- return %checks;
}
--- 568,571 ----
|
|
From: Ilya M. <m_...@us...> - 2002-01-30 16:47:21
|
Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest In directory usw-pr-cvs1:/tmp/cvs-serv14838 Modified Files: Cookbook.pod Log Message: Minor fix Index: Cookbook.pod =================================================================== RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Cookbook.pod,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Cookbook.pod 2002/01/28 10:59:30 1.5 --- Cookbook.pod 2002/01/30 16:47:13 1.6 *************** *** 1,5 **** =head1 NAME ! HTTP::WebTest::Cookbook - recipes of tests for every day =head1 SYNOPSIS --- 1,5 ---- =head1 NAME ! HTTP::WebTest::Cookbook - Recipes of tests for every day =head1 SYNOPSIS |
