File Coverage

blib/lib/VSGDR/UnitTest/TestSet/Representation/XML.pm
Criterion Covered Total %
statement 32 292 10.9
branch 0 94 0.0
condition 0 21 0.0
subroutine 11 25 44.0
pod 0 13 0.0
total 43 445 9.6


line stmt bran cond sub pod time code
1             package VSGDR::UnitTest::TestSet::Representation::XML;
2              
3 1     1   1326 use 5.010;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         21  
5 1     1   6 use warnings;
  1         2  
  1         30  
6              
7              
8             #our \$VERSION = '1.01';
9              
10              
11             #TODO 1. Add support for test method attributes eg new vs2010 exceptions ala : -[ExpectedSqlException(MessageNumber = nnnnn, Severity = x, MatchFirstError = false, State = y)]
12              
13 1     1   6 use parent qw(VSGDR::UnitTest::TestSet::Representation) ;
  1         2  
  1         7  
14              
15 1     1   64 use English;
  1         2  
  1         8  
16 1     1   1777 use XML::Simple;
  1         9997  
  1         5  
17              
18 1     1   72 use VSGDR::UnitTest::TestSet;
  1         2  
  1         34  
19 1     1   5 use VSGDR::UnitTest::TestSet::Test;
  1         2  
  1         22  
20              
21 1     1   5 use Data::Dumper ;
  1         3  
  1         41  
22 1     1   6 use Carp ;
  1         2  
  1         60  
23              
24              
25 1     1   4 use vars qw($AUTOLOAD );
  1         2  
  1         3573  
26              
27              
28              
29             sub _init {
30              
31 0     0     local $_ = undef ;
32              
33 0           my $self = shift ;
34 0   0       my $class = ref($self) || $self ;
35 0 0         my $ref = shift or croak "no arg";
36              
37              
38 0           my ${Caller} = $$ref{NAMESPACE};
39            
40 0           return ;
41            
42             }
43              
44             ## ======================================================
45              
46             sub parse {
47              
48 0 0   0 0   my $self = shift or croak 'no self' ;
49 0 0         my $code = shift or croak 'no code' ;
50            
51 0           my $ref = XMLin($code);
52              
53 0           my %testSetActions ;
54             #warn Dumper $ref ;
55             #exit;
56             my @testConditions ;
57              
58 0           my %Globals = map { $$ref{TestGlobals}{$_} =~ s/^\s*(.*?)\s*$/$1/x;
59 0           { uc($_) => $$ref{TestGlobals}{$_}
  0            
60             }
61             }
62 0           keys %{$$ref{TestGlobals}} ;
  0            
63            
64             #print Dumper %Globals ;
65             #exit;
66             my $testSet = VSGDR::UnitTest::TestSet->new( { NAMESPACE => $Globals{TESTNAMESPACE}
67             , CLASSNAME => $Globals{TESTCLASS}
68             }
69 0           ) ;
70             #print Dumper $testSet ;
71             #exit;
72 0           my $ra_testGlobalConditions = () ;
73            
74             #print Dumper $$ref{TestGlobalConditions} ;
75             #exit;
76              
77             # {TestGlobalConditions}{TestInitializeConditions}
78             # {TestGlobalConditions}{TestCleanupConditions}
79              
80 0 0 0       if ( defined ($$ref{TestGlobalConditions})
81             and defined ($$ref{TestGlobalConditions}{TestInitializeAction})
82             ) {
83 0           $testSet->initializeAction('testInitializeAction') ;
84 0           $testSetActions{'testInitializeAction'} = 1 ;
85             }
86 0 0 0       if ( defined ($$ref{TestGlobalConditions})
      0        
87             and defined ($$ref{TestGlobalConditions}{TestInitializeConditions})
88             and defined ($$ref{TestGlobalConditions}{TestInitializeConditions}{TestInitializeCondition})
89             ) {
90 0           $testSet->initializeAction('testInitializeAction') ;
91 0           $testSetActions{'testInitializeAction'} = 1 ;
92 0           my $condition = $$ref{TestGlobalConditions}{TestInitializeConditions}{TestInitializeCondition} ;
93             #print Dumper $condition ;
94 0           $ra_testGlobalConditions = $self->gatherTestSetConditions($condition) ;
95             #print Dumper @testGlobalConditions ;
96 0           $testSet->initializeConditions($ra_testGlobalConditions);
97             }
98             else {
99 0           $testSet->initializeConditions([]);
100             }
101              
102 0 0 0       if ( defined ($$ref{TestGlobalConditions})
103             and defined ($$ref{TestGlobalConditions}{TestCleanupAction})
104             ) {
105 0           $testSet->cleanupAction('testCleanupAction') ;
106 0           $testSetActions{'testTestCleanup'} = 1 ;
107             }
108 0 0 0       if ( defined ($$ref{TestGlobalConditions})
      0        
109             and defined ($$ref{TestGlobalConditions}{TestCleanupConditions})
110             and defined ($$ref{TestGlobalConditions}{TestCleanupConditions}{TestCleanupCondition})
111             ) {
112 0           $testSet->cleanupAction('testCleanupAction') ;
113 0           $testSetActions{'testCleanupAction'} = 1 ;
114 0           my $condition = $$ref{TestGlobalConditions}{TestCleanupConditions}{TestCleanupCondition} ;
115             #print Dumper $condition ;
116 0           $ra_testGlobalConditions = $self->gatherTestSetConditions($condition) ;
117             #print Dumper @testGlobalConditions ;
118 0           $testSet->cleanupConditions($ra_testGlobalConditions);
119             }
120             else {
121 0           $testSet->cleanupConditions([]);
122             }
123            
124             #############################################
125              
126 0           my @testObjects = () ;
127              
128 0 0         if ( ref($$ref{Tests}{Test}) eq 'HASH' ) {
    0          
129 0           my $test = $$ref{Tests}{Test} ;
130 0           my $testObject = $self->createTest($test,\%testSetActions) ;
131 0           push @testObjects, $testObject ;
132             }
133             elsif ( ref($$ref{Tests}{Test}) eq 'ARRAY' ) {
134 0           foreach my $test (@{$$ref{Tests}{Test}}) {
  0            
135 0           my $testObject = $self->createTest($test,\%testSetActions) ;
136 0           push @testObjects, $testObject ;
137             }
138             }
139             #print Dumper $testSet;
140 0           $testSet->tests(\@testObjects) ;
141             # $testSet->actions({}) ;
142             # $testSet->actions(\%testSetActions) ;
143             #print Dumper $testSet ;
144 0           return $testSet;
145             }
146              
147             sub createTest {
148 0     0 0   local $_ = undef ;
149 0 0         my $self = shift or croak 'no self' ;
150 0 0         my $test = shift or croak 'no test arg' ;
151 0 0         my $rh_testSetActions = shift or croak 'no test set actions' ;
152              
153 0           ( my $testName = $$test{TestName} ) =~ s/^\s*(.*?)\s*$/$1/x;
154 0           ( my $testActions = $$test{TestActions} ) ;
155 0           ( my $testActionData = $$test{TestActions}{TestActionData} ) ;
156              
157 0           ( my $preTestConditions = $$test{TestActions}{TestActionData}{PretestConditions}{TestCondition} ) ;
158 0           ( my $testConditions = $$test{TestActions}{TestActionData}{TestConditions}{TestCondition} ) ;
159 0           ( my $postTestConditions= $$test{TestActions}{TestActionData}{PosttestConditions}{TestCondition} ) ;
160              
161              
162 0           my ${TestActionDataName} = $$testActionData{TestActionDataName};
163 0           my ${PreTestAction} = $$testActionData{PretestAction};
164 0           my ${TestAction} = $$testActionData{TestAction};
165 0           my ${PostTestAction} = $$testActionData{PosttestAction};
166              
167 0           my $testObject = VSGDR::UnitTest::TestSet::Test->new( { TESTNAME => $testName
168             , TESTACTIONDATANAME => ${TestActionDataName}
169             , PRETESTACTION => ${PreTestAction}
170             , TESTACTION => ${TestAction}
171             , POSTTESTACTION => ${PostTestAction}
172             } ) ;
173              
174 0           my @preTestConditions = $self->gatherConditions(${preTestConditions}) ;
175 0           my @testConditions = $self->gatherConditions(${testConditions}) ;
176 0           my @postTestConditions = $self->gatherConditions(${postTestConditions}) ;
177              
178 0           my @Conditions = flatten ([@preTestConditions,@testConditions,@postTestConditions]);
179             # $testObject->conditions( \@Conditions ) ;
180              
181 0           $testObject->preTest_conditions( \@preTestConditions ) ;
182 0           $testObject->test_conditions( \@testConditions ) ;
183 0           $testObject->postTest_conditions( \@postTestConditions ) ;
184              
185 0 0         if ( scalar(@preTestConditions)) { $$rh_testSetActions{$testObject->testName() . "_PretestAction"} = 1 ; } ;
  0            
186 0 0         if ( scalar(@testConditions)) { $$rh_testSetActions{$testObject->testName() . "_TestAction"} = 1 ; } ;
  0            
187 0 0         if ( scalar(@postTestConditions)) { $$rh_testSetActions{$testObject->testName() . "_PosttestAction"} = 1 ; } ;
  0            
188              
189 0           return $testObject ;
190            
191             }
192              
193              
194             sub gatherTestSetConditions {
195              
196 0 0   0 0   my $self = shift or croak 'no self' ;
197 0 0         my $testConditions = shift or croak 'no conditions' ;
198             #print Dumper $testConditions ;
199              
200 0           my @testGlobalConditions = () ;
201              
202              
203 0 0         if ( ref( $testConditions ) eq 'HASH' ) {
    0          
204 0           my $testCondition = $testConditions ;
205 0 0         return (\@testGlobalConditions) if not exists $$testCondition{TestConditionType};
206              
207 0           my $testConditionObject = $self->createTestCondition($testCondition) ;
208 0           push @testGlobalConditions, $testConditionObject ;
209              
210             }
211             elsif ( ref($testConditions) eq 'ARRAY' ) {
212 0 0         return (\@testGlobalConditions) if scalar(@$testConditions) == 0 ;
213              
214 0           foreach my $testCondition (@$testConditions) {
215 0           my $testConditionObject = $self->createTestCondition($testCondition) ;
216 0           push @testGlobalConditions, $testConditionObject ;
217              
218             }
219             }
220              
221 0           return (\@testGlobalConditions) ;
222             }
223              
224              
225              
226             sub createTestCondition {
227              
228 0     0 0   local $_ = undef ;
229 0 0         my $self = shift or croak 'no self' ;
230 0 0         my $testCondition = shift or croak 'no test condition' ;
231              
232 0           ( my $testconditiontype = $$testCondition{TestConditionType} ) =~ s{^\s*(.*?)\s*$}{$1}x;
233              
234 0           my @other_keys = grep {$_ ne 'TestConditionType' } keys %{$testCondition} ;
  0            
  0            
235 0           my %constructor = map { ( my $key = uc($_) ) =~ s{TEST}{}x;
  0            
236 0           ( my $val = $$testCondition{$_} ) =~ s{^\s*(.*?)\s*$}{$1}x;
237 0           $key => $val ;
238             }
239             @other_keys ;
240 0           $constructor{TESTCONDITIONTYPE} = $testconditiontype ;
241 0           my $testConditionObject = VSGDR::UnitTest::TestSet::Test::TestCondition->make(\%constructor) ;
242              
243 0           return $testConditionObject ;
244              
245             }
246              
247              
248             sub gatherConditions {
249 0 0   0 0   my $self = shift or croak 'no self' ;
250 0           my $testConditions = shift ;
251 0           my @resultTestConditions = () ;
252              
253 0 0         return @resultTestConditions unless defined $testConditions ;
254              
255 0 0         if ( ref( $testConditions ) eq 'HASH' ) {
    0          
256 0           my $testCondition = $testConditions ;
257 0           my $testConditionObject = $self->createTestCondition($testCondition) ;
258 0           push @resultTestConditions, $testConditionObject ;
259             }
260             elsif ( ref($testConditions) eq 'ARRAY' ) {
261 0           foreach my $testCondition (@$testConditions) {
262 0           my $testConditionObject = $self->createTestCondition($testCondition) ;
263 0           push @resultTestConditions, $testConditionObject ;
264             }
265             }
266 0           return @resultTestConditions ;
267             }
268              
269              
270             sub representationType {
271 0     0 0   my $self = shift;
272 0           return 'XML' ;
273             }
274              
275             sub deparse {
276 0 0   0 0   my $self = shift or croak 'no self' ;
277 0 0         my $testSet = shift or croak 'no test' ;
278              
279 0           my $p1 = ' ';
280 0           my $p2 = ' ';
281 0           my $p3 = ' ';
282 0           my $p4 = ' ';
283              
284             #warn Dumper $testSet;
285             #print Dumper $ast ;
286             #print Dumper keys %$ast;
287             #exit ;
288              
289 0           return $self->xmlHeader() .
290             $self->xmlGlobals($testSet) .
291             "${p1}\n" .
292             $self->xmlGlobalConditions($testSet) .
293             "${p1}\n" .
294             $self->xmlTests($testSet) .
295             $self->xmlFooter() ;
296              
297             }
298              
299              
300             sub xmlHeader {
301 0 0   0 0   my $self = shift or croak 'no self' ;
302 0           return <<"EOH";
303            
304            
305             EOH
306             }
307              
308             sub xmlFooter {
309 0 0   0 0   my $self = shift or croak 'no self' ;
310 0           return <<"EOF";
311            
312             EOF
313             }
314              
315             sub xmlGlobals {
316 0 0   0 0   my $self = shift or croak 'no self' ;
317 0 0         my $testSet = shift or croak 'no testSet' ;
318              
319              
320 0           my $p1 = ' ';
321 0           my $p2 = ' ';
322              
323 0           return "${p1}\n" .
324             "${p2}" . $testSet->nameSpace() ."\n" .
325             "${p2}". $testSet->className() ."\n" .
326             "${p2}". $testSet->initializeActionLiteral() ."\n" .
327             "${p2}". $testSet->cleanupActionLiteral() ."\n" .
328             "${p1}\n" ;
329             }
330              
331              
332             sub xmlGlobalConditions {
333 0     0 0   local $_ = undef;
334 0 0         my $self = shift or croak 'no self' ;
335 0 0         my $testSet = shift or croak 'no testSet' ;
336 0           my $ra_tests = $testSet->tests() ; #@{$$ast{BODY}} ;
337 0           my @tests = @$ra_tests;
338 0           my $ra_cleanupConditions = $testSet->cleanupConditions();
339 0           my $ra_initializeConditions = $testSet->initializeConditions();
340 0           my @cleanupConditions = @{$ra_cleanupConditions} ;
  0            
341 0           my @initializeConditions = @{$ra_initializeConditions} ;
  0            
342             #warn Dumper $testSet ;
343 0           my $res = "" ;
344            
345 0           my $p1 = ' ';
346 0           my $p2 = ' ';
347 0           my $p3 = ' ';
348 0           my $p4 = ' ';
349 0           my $p5 = ' ';
350 0           my $p6 = ' ';
351 0           my $p7 = ' ';
352 0           my $p8 = ' ';
353 0           my $p9 = ' ';
354              
355              
356 0 0         if ($testSet->initializeAction() ) {
357 0           $res .= "${p2}". $testSet->initializeAction() ."\n" ;
358 0           $res .= "${p3}\n" ;
359 0           foreach my $condition (@initializeConditions) {
360 0           $res .= "${p4}\n" ;
361 0           $res .= "${p5}" . $condition->testConditionType() . "\n" ;
362 0           foreach my $attr ($condition->testConditionAttributes()) {
363 0           ( my $UC_attr = $attr ) =~ s{^(.)}{\U${1}}x;
364 0 0         $UC_attr = 'Test' . $UC_attr if $UC_attr !~ m{^Test}ix ;
365 0           $res .= "${p5}<${UC_attr}>" . $condition->${attr}() . "\n" ;
366             }
367 0           $res .= "${p4}\n" ;
368             }
369 0           $res .= "${p3}\n" ;
370             }
371 0 0         if ($testSet->cleanupAction() ) {
372 0           $res .= "${p2}". $testSet->cleanupAction() ."\n" ;
373 0           $res .= "${p3}\n" ;
374 0           foreach my $condition (@cleanupConditions ) {
375 0           $res .= "${p4}\n" ;
376 0           $res .= "${p5}" . $condition->testConditionType() . "\n" ;
377 0           foreach my $attr ($condition->testConditionAttributes()) {
378 0           ( my $UC_attr = $attr ) =~ s{^(.)}{\U${1}}x;
379 0 0         $UC_attr = 'Test' . $UC_attr if $UC_attr !~ m{^Test}ix ;
380 0           $res .= "${p5}<${UC_attr}>" . $condition->${attr}() . "\n" ;
381             }
382 0           $res .= "${p4}\n" ;
383             }
384 0           $res .= "${p3}\n" ;
385             }
386              
387 0           return $res;
388              
389             }
390              
391             sub xmlTests {
392              
393 0     0 0   local $_ = undef;
394 0 0         my $self = shift or croak 'no self' ;
395 0 0         my $testSet = shift or croak 'no testSet' ;
396 0           my $ra_tests = $testSet->tests() ; #@{$$ast{BODY}} ;
397 0           my @tests = @$ra_tests;
398 0           my $ra_cleanupConditions = $testSet->cleanupConditions();
399 0           my $ra_initializeConditions = $testSet->initializeConditions();
400 0           my @cleanupConditions = @{$ra_cleanupConditions} ;
  0            
401 0           my @initializeConditions = @{$ra_initializeConditions} ;
  0            
402              
403 0           my $p1 = ' ';
404 0           my $p2 = ' ';
405 0           my $p3 = ' ';
406 0           my $p4 = ' ';
407 0           my $p5 = ' ';
408 0           my $p6 = ' ';
409 0           my $p7 = ' ';
410 0           my $p8 = ' ';
411 0           my $p9 = ' ';
412              
413 0           my $res = "${p1}\n" ;
414              
415 0           my $rh_actions = $testSet->actions();
416 0           my %actions = %{$rh_actions} ;
  0            
417 0           my %Usedactions = ();
418              
419 0           foreach my $test (@tests) {
420              
421 0           $res .= "${p3}\n" ;
422 0           $res .= "${p4}".$test->testName()."\n" ;
423 0           $res .= "${p4}\n" ;
424 0           $res .= "${p5}\n" ;
425 0           $res .= "${p6}".$test->testActionDataName()."\n" ;
426 0           $res .= "${p6}".$test->preTestAction()."\n" ;
427 0           $res .= "${p7}\n" ;
428              
429 0 0         if ( $test->preTestAction() !~ m{^null|nothing$}ix ) {
430 0           my $conditions = $test->preTest_conditions() ;
431             #print Dumper $conditions;
432 0           foreach my $condition (@$conditions) {
433 0           $res .= "${p8}\n" ;
434 0           $res .= "${p9}" . $condition->testConditionType() . "\n" ;
435 0           foreach my $attr ($condition->testConditionAttributes()) {
436 0           ( my $UC_attr = $attr ) =~ s{^(.)}{\U${1}}x;
437 0 0         $UC_attr = 'Test' . $UC_attr if $UC_attr !~ m{^Test}ix ;
438 0           $res .= "${p9}<${UC_attr}>" . $condition->${attr}() . "\n" ;
439             }
440 0           $res .= "${p8}\n" ;
441             }
442 0           $Usedactions{$test->preTestAction()}{PROCESSED} = 1;
443             }
444 0           $res .= "${p7}\n" ;
445              
446 0           $res .= "${p6}".$test->testAction()."\n" ;
447 0           $res .= "${p7}\n";
448 0 0         if ( $test->testAction() !~ m{^null|nothing$}ix ) {
449 0           my $conditions = $test->test_conditions() ;
450 0           foreach my $condition (@$conditions) {
451 0           $res .= "${p8}\n" ;
452 0           $res .= "${p9}" . $condition->testConditionType() . "\n" ;
453 0           foreach my $attr ($condition->testConditionAttributes()) {
454 0           ( my $UC_attr = $attr ) =~ s{^(.)}{\U${1}}x;
455 0 0         $UC_attr = 'Test' . $UC_attr if $UC_attr !~ m{^Test}ix ;
456 0           $res .= "${p9}<${UC_attr}>" . $condition->${attr}() . "\n" ;
457             }
458 0           $res .= "${p8}\n" ;
459             }
460 0           $Usedactions{$test->testAction()}{PROCESSED} = 1;
461             }
462 0           $res .= "${p7}\n" ;
463              
464 0           $res .= "${p6}".$test->postTestAction()."\n" ;
465 0           $res .= "${p7}\n";
466 0 0         if ( $test->postTestAction() !~ m{^null|nothing$}ix ) {
467 0           my $conditions = $test->postTest_conditions() ;
468 0           foreach my $condition (@$conditions) {
469 0           $res .= "${p8}\n" ;
470 0           $res .= "${p9}" . $condition->testConditionType() . "\n" ;
471            
472 0           foreach my $attr ($condition->testConditionAttributes()) {
473 0           ( my $UC_attr = $attr ) =~ s{^(.)}{\U${1}}x;
474 0 0         $UC_attr = 'Test' . $UC_attr if $UC_attr !~ m{^Test}ix ;
475 0           $res .= "${p9}<${UC_attr}>" . $condition->${attr}() . "\n" ;
476             }
477 0           $res .= "${p8}\n" ;
478             }
479 0           $Usedactions{$test->postTestAction()}{PROCESSED} = 1;
480             }
481 0           $res .= "${p7}\n";
482 0           $res .= "${p5}\n" ;
483              
484 0           $res .= "${p4}\n" ;
485 0           $res .= "${p3}\n" ;
486              
487 0           } $res .= "${p1}\n" ;
488              
489 0           return $res;
490             }
491              
492              
493 0     0 0   sub flatten { return map {@$_} @_ } ;
  0            
494              
495             1 ;
496              
497             __DATA__