Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest
In directory sc8-pr-cvs1:/tmp/cvs-serv3018/lib/HTTP/WebTest
Modified Files:
Parser.pm
Log Message:
Can write wtscript files now
Index: Parser.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Parser.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** Parser.pm 22 Aug 2002 07:21:50 -0000 1.18
--- Parser.pm 25 Jan 2003 17:46:27 -0000 1.19
***************
*** 278,281 ****
--- 278,358 ----
}
+ =head2 write_test ($params_aref)
+
+ Given a set of test parameters generates text representation of the
+ test.
+
+ =head3 Returns
+
+ The test text.
+
+ =cut
+
+ sub write_test {
+ my $class = shift;
+ my($params_aref) = @_;
+ my %params = @$params_aref;
+
+ my $wtscript = '';
+
+ $wtscript .= _write_param_value('test_name',
+ $params{test_name} || 'N/A',
+ '');
+
+ for(my $i = 0; $i < @$params_aref/2; $i ++) {
+ my $param = $params_aref->[2 * $i];
+ my $value = $params_aref->[2 * $i + 1];
+ $wtscript .= _write_param_value($params_aref->[2 * $i],
+ $params_aref->[2 * $i + 1],
+ ' ' x 4);
+ }
+
+ $wtscript .= "end_test\n";
+
+ return $wtscript;
+ }
+
+ sub _write_param_value {
+ my($param, $value, $indent) = @_;
+
+ my $wtscript = "$indent$param = ";
+ my $value_indent = ' ' x length($wtscript);
+ $wtscript .= _write_value($value, $value_indent) . "\n";
+
+ return $wtscript;
+ }
+
+ sub _write_value {
+ my($value, $indent) = @_;
+
+ my $wtscript = '';
+ if(UNIVERSAL::isa($value, 'ARRAY')) {
+ $wtscript .= "(\n";
+ for my $subvalue (@$value) {
+ my $subindent = "$indent ";
+ $wtscript .= $subindent;
+ $wtscript .= _write_value($subvalue, $subindent);
+ $wtscript .= "\n";
+ }
+ $wtscript .= "$indent)";
+ } else {
+ $wtscript .= _write_scalar($value);
+ }
+
+ return $wtscript;
+ }
+
+ sub _write_scalar {
+ my($scalar) = @_;
+
+ if($scalar =~ /[()'"{}]/ or $scalar =~ /=>/) {
+ my $q_scalar = $scalar;
+ $q_scalar =~ s/(['\\])/\\$1/g;
+ return "'" . $q_scalar . "'";
+ } else {
+ return $scalar;
+ }
+ }
+
=head1 COPYRIGHT
|
