File Coverage

blib/lib/VSGDR/UnitTest/TestSet/Representation/XLS.pm
Criterion Covered Total %
statement 38 309 12.3
branch 0 136 0.0
condition 0 21 0.0
subroutine 13 26 50.0
pod 0 12 0.0
total 51 504 10.1


line stmt bran cond sub pod time code
1             package VSGDR::UnitTest::TestSet::Representation::XLS;
2              
3 1     1   1741 use 5.010;
  1         3  
4 1     1   6 use strict;
  1         2  
  1         22  
5 1     1   5 use warnings;
  1         2  
  1         37  
6              
7              
8             #our \$VERSION = '1.02';
9              
10              
11 1     1   6 use parent qw(VSGDR::UnitTest::TestSet::Representation) ;
  1         2  
  1         9  
12              
13             #TODO 1. Add support for test method attributes eg new vs2010 exceptions ala : -[ExpectedSqlException(MessageNumber = nnnnn, Severity = x, MatchFirstError = false, State = y)]
14              
15              
16 1     1   999 use English;
  1         3668  
  1         8  
17 1     1   2961 use Spreadsheet::WriteExcel;
  1         90369  
  1         48  
18 1     1   1359 use Spreadsheet::ParseExcel;
  1         49853  
  1         38  
19 1     1   926 use List::MoreUtils qw/:all/;
  1         12025  
  1         7  
20              
21 1     1   4160 use VSGDR::UnitTest::TestSet;
  1         2  
  1         50  
22 1     1   6 use VSGDR::UnitTest::TestSet::Test;
  1         2  
  1         22  
23              
24 1     1   6 use Data::Dumper ;
  1         3  
  1         47  
25 1     1   6 use Carp ;
  1         2  
  1         100  
26              
27              
28 1     1   4 use vars qw($AUTOLOAD);
  1         3  
  1         3326  
29              
30              
31             my $test_No ;
32             #our $wks_test ;
33             my $G_ln ;
34              
35              
36             sub _init {
37              
38 0     0     local $_ = undef ;
39              
40 0           my $self = shift ;
41 0   0       my $class = ref($self) || $self ;
42 0 0         my $ref = shift or croak "no arg";
43              
44              
45 0           my ${Caller} = $$ref{NAMESPACE};
46            
47 0           return ;
48            
49             }
50              
51             ## ======================================================
52             ## could alias this *Here::blue = \$There::green;
53             ##let's not - harder to understand and will alias other member of the typeglobs
54             sub serialise {
55 0 0   0 0   my $self = shift or croak 'no self' ;
56 0           return $self->writeSpreadsheet(@_) ;
57             }
58             ## ======================================================
59             sub deserialise {
60 0 0   0 0   my $self = shift or croak 'no self' ;
61 0           return $self->readSpreadsheet(@_) ;
62             }
63             ## ======================================================
64             # dummy implementations
65             ## ======================================================
66             sub code {
67 0 0   0 0   my $self = shift or croak 'no self' ;
68 0           carp 'Dummy method - may you want serialise';
69 0           return "";
70             }
71             ## ======================================================
72             sub parse {
73 0 0   0 0   my $self = shift or croak 'no self' ;
74 0           carp 'Dummy method - may you want deserialise';
75 0           return "";
76             }
77             ## ======================================================
78              
79             sub readSpreadsheet {
80              
81 0 0   0 0   my $self = shift or croak 'no self' ;
82 0 0         my $file = shift or croak 'no file' ;
83            
84 0           my $parser = Spreadsheet::ParseExcel->new();
85 0           my $workbook = $parser->Parse($file);
86              
87 0 0         my $worksheet = $workbook->worksheet('TestGlobals') or croak 'no TestGlobals worksheet' ;
88              
89 0           my %Globals = ( TESTNAMESPACE => $worksheet->get_cell(1,0)->value()
90             , TESTCLASS => $worksheet->get_cell(1,1)->value()
91             ) ;
92              
93             #warn Dumper %Globals ;
94            
95             my $testSet = VSGDR::UnitTest::TestSet->new( { NAMESPACE => $Globals{TESTNAMESPACE}
96             , CLASSNAME => $Globals{TESTCLASS}
97             }
98 0           ) ;
99              
100              
101 0           my @header = $testSet->allConditionAttributeNames() ;
102 0           my %header_pos = () ;
103 0           for ( my $i = 0; $i <= $#header; $i++) { $header_pos{$header[$i]} = $i } ;
  0            
104              
105 0 0         $worksheet = $workbook->worksheet('TestGlobalConditions') or croak 'no TestGlobalConditions worksheet' ;
106              
107             #warn $worksheet->row_range() ;
108 0           my ($row_min,$row_max) = $worksheet->row_range();
109 0 0         my $testInitialiseAction = defined $worksheet->get_cell(0,1) ? $worksheet->get_cell(0,1)->value()
110             : undef ;
111              
112 0           my %testSetActions ;
113             my @testConditions ;
114              
115 0           my $row = 1 ;
116 0 0         if ($testInitialiseAction) {
117 0           $testSetActions{'testInitializeAction'} = 1 ;
118 0           $testSet->initializeAction('testInitializeAction') ;
119 0           my $ra_testGlobalConditions = $self->gatherTestSetConditions($worksheet,'testInitializeAction',\@header,\%header_pos,$row,$row_max) ;
120 0           $testSet->initializeConditions($ra_testGlobalConditions);
121             }
122             else {
123 0           $testSet->initializeConditions([]);
124             }
125              
126 0           my $testCleanupAction = undef ;
127 0           for ( my $r = $row; $r <= $row_max; $r++ ) {
128 0 0 0       if ( defined ($worksheet->get_cell($r,1)) and ($worksheet->get_cell($r,1)->value() eq 'testCleanupAction') ) {
129 0           $testCleanupAction = 1 ;
130 0           $row = $r+1 ;
131 0           last ;
132             }
133             }
134            
135 0 0         if ($testCleanupAction) {
136 0           $testSetActions{'testCleanupAction'} = 1 ;
137 0           $testSet->cleanupAction('testCleanupAction') ;
138 0           my $ra_testGlobalConditions = $self->gatherTestSetConditions($worksheet,'testCleanupAction',\@header,\%header_pos,$row,$row_max) ;
139 0           $testSet->cleanupConditions($ra_testGlobalConditions);
140             }
141             else {
142 0           $testSet->cleanupConditions([]);
143             }
144              
145             # $testSet->tests([]);
146              
147 0           my @testObjects = () ;
148            
149 0           for ( my $wi = 2 ; $wi < $workbook->worksheet_count() ; $wi++ ) {
150 0           my $worksheet = $workbook->worksheet($wi) ;
151 0           my $testName = $worksheet->get_cell(0,1)->value() ;
152              
153 0           my ($row_min,$row_max) = $worksheet->row_range();
154              
155 0           my %TA = ( PretestAction => 'null'
156             , TestAction => 'null'
157             , PosttestAction => 'null'
158             ) ;
159              
160 0           my @preTestConditions = () ;
161 0           my @testConditions = () ;
162 0           my @postTestConditions = () ;
163              
164 0           my $row = 1 ;
165            
166 0           my ($firstRow,$actionType) = $self->find_next_set($worksheet,$row,$row_max) ;
167             #warn Dumper ($firstRow,$actionType) ;
168 0           $row = $firstRow +1 ;
169 0           $TA{$actionType} = "${testName}_${actionType}" ;
170            
171 0 0         if ( ${actionType} eq 'PretestAction' ) {
172 0           @preTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
173             }
174 0 0         if ( ${actionType} eq 'TestAction' ) {
175 0           @testConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
176             }
177 0 0         if ( ${actionType} eq 'PosttestAction' ) {
178 0           @postTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
179             }
180              
181 0           ($firstRow,$actionType) = $self->find_next_set($worksheet,$row,$row_max) ;
182            
183 0 0         if ( defined $firstRow ) {
184             #warn Dumper ($firstRow,$actionType) ;
185              
186 0           $row = $firstRow +1 ;
187 0           $TA{$actionType} = "${testName}_${actionType}" ;
188              
189 0 0         if ( ${actionType} eq 'PretestAction' ) {
190 0           @preTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
191             }
192 0 0         if ( ${actionType} eq 'TestAction' ) {
193 0           @testConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
194             }
195 0 0         if ( ${actionType} eq 'PosttestAction' ) {
196 0           @postTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
197             }
198             }
199 0           ($firstRow,$actionType) = $self->find_next_set($worksheet,$row,$row_max) ;
200 0 0         if ( defined $firstRow ) {
201             #warn Dumper ($firstRow,$actionType) ;
202              
203 0           $row = $firstRow +1 ;
204 0           $TA{$actionType} = "${testName}_${actionType}" ;
205              
206 0 0         if ( ${actionType} eq 'PretestAction' ) {
207 0           @preTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
208             }
209 0 0         if ( ${actionType} eq 'TestAction' ) {
210 0           @testConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
211             }
212 0 0         if ( ${actionType} eq 'PosttestAction' ) {
213 0           @postTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ;
214             }
215             }
216              
217             my $testObject = VSGDR::UnitTest::TestSet::Test->new( { TESTNAME => $testName
218             , TESTACTIONDATANAME => "${testName}Data"
219             , PRETESTACTION => $TA{PretestAction}
220             , TESTACTION => $TA{TestAction}
221             , POSTTESTACTION => $TA{PosttestAction}
222 0           } ) ;
223            
224 0           $testObject->preTest_conditions( \@preTestConditions ) ;
225 0           $testObject->test_conditions( \@testConditions ) ;
226 0           $testObject->postTest_conditions( \@postTestConditions ) ;
227              
228 0 0         if ( scalar(@preTestConditions)) { $testSetActions{$testObject->testName() . "_PretestAction"} = 1 ; } ;
  0            
229 0 0         if ( scalar(@testConditions)) { $testSetActions{$testObject->testName() . "_TestAction"} = 1 ; } ;
  0            
230 0 0         if ( scalar(@postTestConditions)) { $testSetActions{$testObject->testName() . "_PosttestAction"} = 1 ; } ;
  0            
231              
232 0           push @testObjects, $testObject ;
233              
234             }
235              
236              
237 0           $testSet->tests(\@testObjects) ;
238             # $testSet->actions(\%testSetActions) ;
239             #warn Dumper $testSet ;
240 0           return $testSet;
241             }
242              
243              
244             sub find_next_set {
245 0 0   0 0   my $self = shift or croak 'no self' ;
246 0 0         my $wks = shift or croak 'no worksheet' ;
247 0 0         my $row = shift or croak 'no start row' ;
248 0 0         my $row_max = shift or croak 'no max row' ;
249              
250 0           my $retRow = undef ;
251 0           my $retVal = undef ;
252              
253 0           for (my $r = $row; $r <= $row_max; $r++) {
254 0 0 0       if ( defined $wks->get_cell($r,1) and $wks->get_cell($r,1)->value() =~ m{^(?:Pre|Post|)TestAction}ix ) {
255 0           $retRow = $r ;
256 0           $retVal = $wks->get_cell($r,1)->value() ;
257 0           last;
258             }
259             }
260              
261 0           return ($retRow,$retVal) ;
262             }
263              
264             sub gatherTestSetConditions {
265              
266 0 0   0 0   my $self = shift or croak 'no self' ;
267 0 0         my $wks = shift or croak 'no worksheet' ;
268 0 0         my $testAction = shift or croak 'no action';
269 0 0         my $ra_header = shift or croak 'no headers' ;
270 0 0         my $rh_header_cols = shift or croak 'no header cols' ;
271 0 0         my $row = shift or croak 'no start row' ;
272 0 0         my $row_max = shift or croak 'no max row' ;
273              
274 0           my @testGlobalConditions = () ;
275              
276 0           my $TYPECOL = 2 ;
277 0           for (my $r = $row; $r <= $row_max; $r++ ) {
278              
279 0 0         last if defined $wks->get_cell($r,0) ;
280 0 0 0       last if ( defined $wks->get_cell($r,0) and $wks->get_cell($r,0)->value() ) ;
281              
282 0 0         last if not defined $wks->get_cell($r,$TYPECOL) ;
283 0 0 0       last if ( defined $wks->get_cell($r,$TYPECOL) and $wks->get_cell($r,$TYPECOL)->value() eq '' ) ;
284              
285 0           my $testconditiontype = $wks->get_cell($r,$TYPECOL)->value() ;
286            
287 0 0         my @populatedColumns = map { $_ - $TYPECOL } grep { defined $wks->get_cell($r,$_) and $wks->get_cell($r,$_)->value() ne '' } ( $TYPECOL+1 .. $TYPECOL + scalar(@{$ra_header}) ) ;
  0            
  0            
  0            
288 0           my @populatedVals = map { $wks->get_cell($r,$_ + $TYPECOL)->value() } @populatedColumns ;
  0            
289              
290 0           my @populatedColumnsHeaders = map { $ra_header->[$_] } @populatedColumns ;
  0            
291 0           my @populatedColumnsHeadersHASH = map { uc "CONDITION${_}" } @populatedColumnsHeaders ;
  0            
292              
293 0           my @constructor = zip( @populatedColumnsHeadersHASH,@populatedVals );
294 0           my %constructor = @constructor ;
295              
296 0           $constructor{TESTCONDITIONTYPE} = $testconditiontype ;
297 0           $constructor{CONDITIONTESTACTIONNAME} = $testAction ;
298            
299 0           my $testConditionObject = VSGDR::UnitTest::TestSet::Test::TestCondition->make(\%constructor) ;
300 0           push @testGlobalConditions, $testConditionObject ;
301             }
302              
303 0           return (\@testGlobalConditions) ;
304             }
305              
306              
307             sub gatherConditions {
308              
309 0 0   0 0   my $self = shift or croak 'no self' ;
310 0 0         my $wks = shift or croak 'no worksheet' ;
311 0 0         my $testAction = shift or croak 'no action';
312 0 0         my $ra_header = shift or croak 'no headers' ;
313 0 0         my $rh_header_cols = shift or croak 'no header cols' ;
314 0 0         my $row = shift or croak 'no start row' ;
315 0 0         my $row_max = shift or croak 'no max row' ;
316              
317 0           my @testGlobalConditions = () ;
318              
319 0           my $TYPECOL = 2 ;
320 0           for (my $r = $row; $r <= $row_max; $r++ ) {
321              
322 0 0         last if defined $wks->get_cell($r,1) ;
323 0 0 0       last if ( defined $wks->get_cell($r,1) and $wks->get_cell($r,1)->value() ) ;
324              
325 0 0         last if not defined $wks->get_cell($r,$TYPECOL) ;
326 0 0 0       last if ( defined $wks->get_cell($r,$TYPECOL) and $wks->get_cell($r,$TYPECOL)->value() eq '' ) ;
327              
328 0           my $testconditiontype = $wks->get_cell($r,$TYPECOL)->value() ;
329            
330 0 0         my @populatedColumns = map { $_ - $TYPECOL } grep { defined $wks->get_cell($r,$_) and $wks->get_cell($r,$_)->value() ne '' } ( $TYPECOL+1 .. $TYPECOL + scalar(@{$ra_header}) ) ;
  0            
  0            
  0            
331 0           my @populatedVals = map { $wks->get_cell($r,$_ + $TYPECOL)->value() } @populatedColumns ;
  0            
332              
333 0           my @populatedColumnsHeaders = map { $ra_header->[$_] } @populatedColumns ;
  0            
334 0           my @populatedColumnsHeadersHASH = map { uc "CONDITION${_}" } @populatedColumnsHeaders ;
  0            
335              
336 0           my @constructor = zip( @populatedColumnsHeadersHASH,@populatedVals );
337 0           my %constructor = @constructor ;
338              
339 0           $constructor{TESTCONDITIONTYPE} = $testconditiontype ;
340 0           $constructor{CONDITIONTESTACTIONNAME} = $testAction ;
341            
342             #warn Dumper %constructor ;
343              
344 0           my $testConditionObject = VSGDR::UnitTest::TestSet::Test::TestCondition->make(\%constructor) ;
345 0           push @testGlobalConditions, $testConditionObject ;
346             }
347              
348 0           return (@testGlobalConditions) ;
349             }
350              
351              
352             sub representationType {
353 0     0 0   my $self = shift;
354 0           return 'XLS' ;
355             }
356              
357              
358             sub writeSpreadsheet {
359 0 0   0 0   my $self = shift or croak 'no self' ;
360 0 0         my $filename = shift or croak 'no file' ;
361 0 0         my $testSet = shift or croak 'no test' ;
362              
363 0           my $colOffset = 2 ;
364              
365 0           my @header = $testSet->allConditionAttributeNames() ;
366 0           my %header_pos = () ;
367 0           for ( my $i = 0; $i <= $#header; $i++) { $header_pos{$header[$i]} = $i } ;
  0            
368              
369 0           my $workbook = Spreadsheet::WriteExcel->new(${filename});
370              
371 0           my $format1 = $workbook->add_format();
372 0           $format1->set_bold();
373              
374              
375 0           my $wks_globals = $workbook->add_worksheet('TestGlobals');
376 0           $wks_globals->write_row(0,0,['TestNameSpace','TestClass'],$format1) ;
377 0           $wks_globals->write_row(1,0,[ $testSet->nameSpace()
378             , $testSet->className()
379             ]
380             ) ;
381              
382 0           my $wks_globalconditions = $workbook->add_worksheet('TestGlobalConditions');
383            
384 0           $G_ln = 0 ;
385 0           $wks_globalconditions->write_row($G_ln, 0, ['TestInitializeAction'],$format1);
386 0           $wks_globalconditions->write_row($G_ln, 1, [$testSet->initializeAction()]);
387 0           $wks_globalconditions->write_row($G_ln, $colOffset, \@header,$format1);
388              
389 0 0         if ( $testSet->initializeAction() ) {
390 0           $G_ln++;
391 0           my $ra_Conditions = $testSet->initializeConditions();
392 0           $self->printConditions( $wks_globalconditions,\@header, \%header_pos, $ra_Conditions) ;
393             }
394              
395 0           $G_ln++;$G_ln++;
  0            
396              
397 0           $wks_globalconditions->write_row($G_ln, 0, ['TestCleanupAction'],$format1);
398 0           $wks_globalconditions->write_row($G_ln, 1, [$testSet->cleanupAction()]);
399 0           $wks_globalconditions->write_row($G_ln, $colOffset, \@header,$format1);
400 0 0         if ( $testSet->cleanupAction() ) {
401 0           $G_ln++;
402 0           my $ra_Conditions = $testSet->cleanupConditions();
403 0           $self->printConditions( $wks_globalconditions,\@header, \%header_pos, $ra_Conditions) ;
404             }
405              
406              
407 0           my $ra_tests = $testSet->tests() ;
408 0           my $wks_test = undef ;
409            
410 0           $test_No = 0 ;
411 0           for my $test (@$ra_tests) {
412 0           $test_No++ ;
413 0           $wks_test = $workbook->add_worksheet("Test ${test_No}");
414 0           $G_ln = 0 ;
415 0           $wks_test->write_row($G_ln, 0, [ 'Test Name '],$format1);
416 0           $wks_test->write_row($G_ln, 1, [ $test->testName() ]);
417 0           my $ra_Conditions = undef ;
418 0 0         if ( $test->preTestAction() ne 'null' ) {
419 0           $wks_test->write_row($G_ln, $colOffset, \@header,$format1);
420 0           $G_ln++;
421 0           $wks_test->write_row($G_ln, 1, ['PretestAction'],$format1);
422 0           $G_ln++;
423 0           $ra_Conditions = $test->preTest_conditions();
424 0           $self->printConditions( $wks_test,\@header, \%header_pos, $ra_Conditions) ;
425             }
426              
427 0           $G_ln++;
428 0           $wks_test->write_row($G_ln, $colOffset, \@header,$format1);
429 0           $G_ln++;
430 0           $wks_test->write_row($G_ln, 1, ['TestAction'],$format1);
431 0           $G_ln++;
432 0           $ra_Conditions = $test->test_conditions();
433 0           $self->printConditions( $wks_test,\@header, \%header_pos, $ra_Conditions) ;
434 0           $G_ln++;
435              
436 0 0         if ( $test->postTestAction() ne 'null' ) {
437 0           $wks_test->write_row($G_ln, $colOffset, \@header,$format1);
438 0           $G_ln++;
439 0           $wks_test->write_row($G_ln, 1, ['PosttestAction'],$format1);
440 0           $G_ln++;
441 0           $ra_Conditions = $test->postTest_conditions();
442 0           $self->printConditions( $wks_test,\@header, \%header_pos, $ra_Conditions) ;
443 0           $G_ln++;
444             }
445             }
446            
447 0           $workbook->close();
448 0           return "" ; #$workbook ;
449              
450             }
451              
452              
453             sub printConditions {
454            
455 0     0 0   local $_ = undef ;
456              
457            
458 0 0         my $self = shift or croak 'no self' ;
459 0 0         my $wks = shift or croak 'no worksheet';
460 0 0         my $ra_header = shift or croak 'no header' ;
461 0 0         my $rh_header_pos = shift or croak 'no header' ;
462 0 0         my $ra_Conditions = shift or croak 'no conditions' ;
463            
464 0           my %conditionVals = map { $_ => undef } @{$ra_header} ;
  0            
  0            
465              
466 0           my $colOffset = 2 ;
467            
468 0           for my $condition (@$ra_Conditions) {
469 0           my @attrs = $condition->testConditionAttributes();
470 0           my @attrvals = () ;
471             #warn Dumper @attrs ;
472 0           for my $attr ( grep { $_ !~ m{^conditionTestActionName$}x } @attrs ) {
  0            
473 0           ( my $fixedName = $attr ) =~ s{^condition}{}ix;
474 0           $conditionVals{$fixedName} = $condition->${attr}() ;
475 0           $attrvals[$rh_header_pos->{$fixedName}] = $condition->${attr}() ;
476             }
477 0           $attrvals[$rh_header_pos->{'Type'}] = $condition->testConditionType() ;
478             #warn "hello\n";
479             #warn $condition->testConditionType();
480             #warn Dumper @attrvals;
481 0           $wks->write_row($G_ln, $colOffset, \@attrvals);
482 0           $G_ln++;
483             }
484            
485 0           return ;
486             }
487              
488 0     0 0   sub flatten { return map { @$_} @_ } ;
  0            
489              
490             1 ;
491              
492             __DATA__