|
From: <jgr...@us...> - 2003-08-22 21:20:43
|
Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv11061/tests
Modified Files:
TestHTML.script TestHTML.tst
Log Message:
Infrastructure for testing HTML forms for configuration options in place, one complete example of the POP3 port testing, changing, and error message generation: 8 lines of code
Index: TestHTML.script
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestHTML.script,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** TestHTML.script 21 Aug 2003 01:22:12 -0000 1.3
--- TestHTML.script 21 Aug 2003 13:58:18 -0000 1.4
***************
*** 32,41 ****
# URL <url> Set the URL that is to be fetched
# GET Gets the last set URL
- # FORM <id>/ENDFORM Set form elements (foo=bar) and submit the form
- # POST/ENDPOST Contains a block of data to be POSTed
# MATCH <data> Match the return from last URL fetch against the data
# MATCH/ENDMATCH Encloses a block of test to find in the return from the last URL fetch
# CODE/ENDCODE Arbitrary code that should be executed
# INPUTIS a b Assert that form item a has value b
#
# Expect that the following are available to you within the MATCH/ENDMATCH block
--- 32,43 ----
# URL <url> Set the URL that is to be fetched
# GET Gets the last set URL
# MATCH <data> Match the return from last URL fetch against the data
# MATCH/ENDMATCH Encloses a block of test to find in the return from the last URL fetch
# CODE/ENDCODE Arbitrary code that should be executed
# INPUTIS a b Assert that form item a has value b
+ # SETINPUT a b Sets the form item a to value b
+ # SUBMIT a Finds the form with input a and submits it
+ # SETSUBMIT a b Just like doing SETINPUT a b followed by SUBMIT a
+ # CONFIGIS a b Verify that config item a has value b
#
# Expect that the following are available to you within the MATCH/ENDMATCH block
***************
*** 46,50 ****
# $sk The current HTML UI session key
# $version Same as $h->version()
- # @forms All HTML forms in the last content downloaded
# Test the simplest functionality of the HTML interface
--- 48,51 ----
***************
*** 188,194 ****
# TODO Check history days change
# TODO Check change timeout
- # TODO Check change POP3 port
! INPUTIS pop3_port 110
# TODO Check change separator
--- 189,203 ----
# TODO Check history days change
# TODO Check change timeout
! # Check change POP3 port
!
! INPUTIS pop3_port 110
! CONFIGIS pop3_port 110
! SETSUBMIT pop3_port 111
! INPUTIS pop3_port 111
! CONFIGIS pop3_port 111
! SETSUBMIT pop3_port 0
! MATCH The POP3 listen port must be a number between 1 and 65535
! INPUTIS pop3_port 111
# TODO Check change separator
Index: TestHTML.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestHTML.tst,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** TestHTML.tst 21 Aug 2003 01:22:12 -0000 1.7
--- TestHTML.tst 21 Aug 2003 13:58:18 -0000 1.8
***************
*** 47,56 ****
my @forms;
! # Helper function that finds an input with a specific name
! # in the @forms collection and returns or sets its value
! sub form_input
{
! my ( $name, $value ) = @_;
foreach my $form (@forms) {
--- 47,57 ----
my @forms;
! # Helper function that finds a form in @forms with the
! # named input element, returns the form object and input
! # element if found or undef
! sub find_form
{
! my ( $name ) = @_;
foreach my $form (@forms) {
***************
*** 58,63 ****
if ( defined( $input ) ) {
! $input->value( $value ) if defined( $value );
! return $input->value();
}
}
--- 59,63 ----
if ( defined( $input ) ) {
! return ( $form, $input );
}
}
***************
*** 65,68 ****
--- 65,100 ----
test_assert( 0, "Unable to find form element '$name'" );
+ return ( undef, undef );
+ }
+
+ # Helper function that finds the form with a specific input
+ # by name and returns an HTTP::Request to submit the form
+
+ sub form_submit
+ {
+ my ( $name ) = @_;
+
+ my ( $form ) = find_form( $name );
+
+ if ( defined( $form ) ) {
+ return $form->click;
+ } else {
+ return undef;
+ }
+ }
+
+ # Helper function that finds an input with a specific name
+ # in the @forms collection and returns or sets its value
+
+ sub form_input
+ {
+ my ( $name, $value ) = @_;
+ my ( $form, $input ) = find_form( $name );
+
+ if ( defined( $form ) ) {
+ $input->value( $value ) if defined( $value );
+ return $input->value();
+ }
+
return undef;
}
***************
*** 159,162 ****
--- 191,196 ----
close $ureader;
+ $uwriter->autoflush(1);
+
$h->config_( 'port', $port );
$h->start();
***************
*** 172,175 ****
--- 206,215 ----
last;
}
+
+ if ( $command =~ /__GETCONFIG (.+)/ ) {
+ my $value = $c->parameter( $1 );
+ print $uwriter "OK $value\n";
+ next;
+ }
}
}
***************
*** 188,198 ****
--- 228,243 ----
use LWP::Simple;
+ use LWP::UserAgent;
use URI::URL;
use String::Interpolate 'interpolate';
+ my $ua = new LWP::UserAgent;
+
our $url;
our $content;
open SCRIPT, "<TestHTML.script";
+ # The commands in this loop are documented in TestHTML.script
+
while ( my $line = <SCRIPT> ) {
$line =~ s/^[\t ]+//g;
***************
*** 205,218 ****
$line = interpolate( $line );
! if ( $line =~ /^URL (.+)$/ ) {
$url = url( $1 );
next;
}
! if ( $line =~ /^INPUTIS (.+) (.+)$/ ) {
test_assert_equal( form_input( $1 ), $2 );
next;
}
if ( $line =~ /^GET$/ ) {
$content = get($url);
--- 250,289 ----
$line = interpolate( $line );
! if ( $line =~ /^URL +(.+)$/ ) {
$url = url( $1 );
next;
}
! if ( $line =~ /^CONFIGIS +([^ ]+) (.+)$/ ) {
! my ( $option, $expected ) = ( $1, $2 );
! print $dwriter "__GETCONFIG $option\n";
! my $reply = <$ureader>;
! test_assert( $reply =~ /OK (.+)/ );
! test_assert_equal( $1, $expected );
! next;
! }
!
! if ( $line =~ /^INPUTIS +([^ ]+) (.+)$/ ) {
test_assert_equal( form_input( $1 ), $2 );
next;
}
+ if ( $line =~ /^(SETINPUT|SETSUBMIT) +([^ ]+) (.+)$/ ) {
+ form_input( $2, $3 );
+ next if ( $line =~ /^SETINPUT/ );
+ }
+
+ # Note drop through here from previous if
+
+ if ( $line =~ /^(SET)?SUBMIT +([^ ]+)/ ) {
+ my $request = form_submit( $2 );
+ if ( defined( $request ) ) {
+ my $response = $ua->request( $request );
+ $content = $response->content;
+ @forms = HTML::Form->parse( $content, "http://127.0.0.1:$port" );
+ }
+ next;
+ }
+
if ( $line =~ /^GET$/ ) {
$content = get($url);
***************
*** 221,225 ****
}
! if ( $line =~ /^MATCH (.+)$/ ) {
test_assert_regexp( $content, "\Q$1\E" );
next;
--- 292,296 ----
}
! if ( $line =~ /^MATCH +(.+)$/ ) {
test_assert_regexp( $content, "\Q$1\E" );
next;
|