package VSGDR::UnitTest::TestSet::Representation::XLS; use 5.010; use strict; use warnings; our $VERSION = '1.02'; use parent qw(VSGDR::UnitTest::TestSet::Representation) ; #TODO 1. Add support for test method attributes eg new vs2010 exceptions ala : -[ExpectedSqlException(MessageNumber = nnnnn, Severity = x, MatchFirstError = false, State = y)] use English; use Spreadsheet::WriteExcel; use Spreadsheet::ParseExcel; use List::MoreUtils qw/:all/; use VSGDR::UnitTest::TestSet; use VSGDR::UnitTest::TestSet::Test; use Data::Dumper ; use Carp ; use vars qw($AUTOLOAD); my $test_No ; #our $wks_test ; my $G_ln ; sub _init { local $_ = undef ; my $self = shift ; my $class = ref($self) || $self ; my $ref = shift or croak "no arg"; my ${Caller} = $$ref{NAMESPACE}; return ; } ## ====================================================== ## could alias this *Here::blue = \$There::green; ##let's not - harder to understand and will alias other member of the typeglobs sub serialise { my $self = shift or croak 'no self' ; return $self->writeSpreadsheet(@_) ; } ## ====================================================== sub deserialise { my $self = shift or croak 'no self' ; return $self->readSpreadsheet(@_) ; } ## ====================================================== # dummy implementations ## ====================================================== sub code { my $self = shift or croak 'no self' ; carp 'Dummy method - may you want serialise'; return ""; } ## ====================================================== sub parse { my $self = shift or croak 'no self' ; carp 'Dummy method - may you want deserialise'; return ""; } ## ====================================================== sub readSpreadsheet { my $self = shift or croak 'no self' ; my $file = shift or croak 'no file' ; my $parser = Spreadsheet::ParseExcel->new(); my $workbook = $parser->Parse($file); my $worksheet = $workbook->worksheet('TestGlobals') or croak 'no TestGlobals worksheet' ; my %Globals = ( TESTNAMESPACE => $worksheet->get_cell(1,0)->value() , TESTCLASS => $worksheet->get_cell(1,1)->value() ) ; #warn Dumper %Globals ; my $testSet = VSGDR::UnitTest::TestSet->new( { NAMESPACE => $Globals{TESTNAMESPACE} , CLASSNAME => $Globals{TESTCLASS} } ) ; my @header = $testSet->allConditionAttributeNames() ; my %header_pos = () ; for ( my $i = 0; $i <= $#header; $i++) { $header_pos{$header[$i]} = $i } ; $worksheet = $workbook->worksheet('TestGlobalConditions') or croak 'no TestGlobalConditions worksheet' ; #warn $worksheet->row_range() ; my ($row_min,$row_max) = $worksheet->row_range(); my $testInitialiseAction = defined $worksheet->get_cell(0,1) ? $worksheet->get_cell(0,1)->value() : undef ; my %testSetActions ; my @testConditions ; my $row = 1 ; if ($testInitialiseAction) { $testSetActions{'testInitializeAction'} = 1 ; $testSet->initializeAction('testInitializeAction') ; my $ra_testGlobalConditions = $self->gatherTestSetConditions($worksheet,'testInitializeAction',\@header,\%header_pos,$row,$row_max) ; $testSet->initializeConditions($ra_testGlobalConditions); } else { $testSet->initializeConditions([]); } my $testCleanupAction = undef ; for ( my $r = $row; $r <= $row_max; $r++ ) { if ( defined ($worksheet->get_cell($r,1)) and ($worksheet->get_cell($r,1)->value() eq 'testCleanupAction') ) { $testCleanupAction = 1 ; $row = $r+1 ; last ; } } if ($testCleanupAction) { $testSetActions{'testCleanupAction'} = 1 ; $testSet->cleanupAction('testCleanupAction') ; my $ra_testGlobalConditions = $self->gatherTestSetConditions($worksheet,'testCleanupAction',\@header,\%header_pos,$row,$row_max) ; $testSet->cleanupConditions($ra_testGlobalConditions); } else { $testSet->cleanupConditions([]); } # $testSet->tests([]); my @testObjects = () ; for ( my $wi = 2 ; $wi < $workbook->worksheet_count() ; $wi++ ) { my $worksheet = $workbook->worksheet($wi) ; my $testName = $worksheet->get_cell(0,1)->value() ; my ($row_min,$row_max) = $worksheet->row_range(); my %TA = ( PretestAction => 'null' , TestAction => 'null' , PosttestAction => 'null' ) ; my @preTestConditions = () ; my @testConditions = () ; my @postTestConditions = () ; my $row = 1 ; my ($firstRow,$actionType) = $self->find_next_set($worksheet,$row,$row_max) ; #warn Dumper ($firstRow,$actionType) ; $row = $firstRow +1 ; $TA{$actionType} = "${testName}_${actionType}" ; if ( ${actionType} eq 'PretestAction' ) { @preTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } if ( ${actionType} eq 'TestAction' ) { @testConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } if ( ${actionType} eq 'PosttestAction' ) { @postTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } ($firstRow,$actionType) = $self->find_next_set($worksheet,$row,$row_max) ; if ( defined $firstRow ) { #warn Dumper ($firstRow,$actionType) ; $row = $firstRow +1 ; $TA{$actionType} = "${testName}_${actionType}" ; if ( ${actionType} eq 'PretestAction' ) { @preTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } if ( ${actionType} eq 'TestAction' ) { @testConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } if ( ${actionType} eq 'PosttestAction' ) { @postTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } } ($firstRow,$actionType) = $self->find_next_set($worksheet,$row,$row_max) ; if ( defined $firstRow ) { #warn Dumper ($firstRow,$actionType) ; $row = $firstRow +1 ; $TA{$actionType} = "${testName}_${actionType}" ; if ( ${actionType} eq 'PretestAction' ) { @preTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } if ( ${actionType} eq 'TestAction' ) { @testConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } if ( ${actionType} eq 'PosttestAction' ) { @postTestConditions = $self->gatherConditions($worksheet,"${testName}_${actionType}",\@header,\%header_pos,$row,$row_max) ; } } my $testObject = VSGDR::UnitTest::TestSet::Test->new( { TESTNAME => $testName , TESTACTIONDATANAME => "${testName}Data" , PRETESTACTION => $TA{PretestAction} , TESTACTION => $TA{TestAction} , POSTTESTACTION => $TA{PosttestAction} } ) ; $testObject->preTest_conditions( \@preTestConditions ) ; $testObject->test_conditions( \@testConditions ) ; $testObject->postTest_conditions( \@postTestConditions ) ; if ( scalar(@preTestConditions)) { $testSetActions{$testObject->testName() . "_PretestAction"} = 1 ; } ; if ( scalar(@testConditions)) { $testSetActions{$testObject->testName() . "_TestAction"} = 1 ; } ; if ( scalar(@postTestConditions)) { $testSetActions{$testObject->testName() . "_PosttestAction"} = 1 ; } ; push @testObjects, $testObject ; } $testSet->tests(\@testObjects) ; # $testSet->actions(\%testSetActions) ; #warn Dumper $testSet ; return $testSet; } sub find_next_set { my $self = shift or croak 'no self' ; my $wks = shift or croak 'no worksheet' ; my $row = shift or croak 'no start row' ; my $row_max = shift or croak 'no max row' ; my $retRow = undef ; my $retVal = undef ; for (my $r = $row; $r <= $row_max; $r++) { if ( defined $wks->get_cell($r,1) and $wks->get_cell($r,1)->value() =~ m{^(?:Pre|Post|)TestAction}ix ) { $retRow = $r ; $retVal = $wks->get_cell($r,1)->value() ; last; } } return ($retRow,$retVal) ; } sub gatherTestSetConditions { my $self = shift or croak 'no self' ; my $wks = shift or croak 'no worksheet' ; my $testAction = shift or croak 'no action'; my $ra_header = shift or croak 'no headers' ; my $rh_header_cols = shift or croak 'no header cols' ; my $row = shift or croak 'no start row' ; my $row_max = shift or croak 'no max row' ; my @testGlobalConditions = () ; my $TYPECOL = 2 ; for (my $r = $row; $r <= $row_max; $r++ ) { last if defined $wks->get_cell($r,0) ; last if ( defined $wks->get_cell($r,0) and $wks->get_cell($r,0)->value() ) ; last if not defined $wks->get_cell($r,$TYPECOL) ; last if ( defined $wks->get_cell($r,$TYPECOL) and $wks->get_cell($r,$TYPECOL)->value() eq '' ) ; my $testconditiontype = $wks->get_cell($r,$TYPECOL)->value() ; my @populatedColumns = map { $_ - $TYPECOL } grep { defined $wks->get_cell($r,$_) and $wks->get_cell($r,$_)->value() ne '' } ( $TYPECOL+1 .. $TYPECOL + scalar(@{$ra_header}) ) ; my @populatedVals = map { $wks->get_cell($r,$_ + $TYPECOL)->value() } @populatedColumns ; my @populatedColumnsHeaders = map { $ra_header->[$_] } @populatedColumns ; my @populatedColumnsHeadersHASH = map { uc "CONDITION${_}" } @populatedColumnsHeaders ; my @constructor = zip( @populatedColumnsHeadersHASH,@populatedVals ); my %constructor = @constructor ; $constructor{TESTCONDITIONTYPE} = $testconditiontype ; $constructor{CONDITIONTESTACTIONNAME} = $testAction ; my $testConditionObject = VSGDR::UnitTest::TestSet::Test::TestCondition->make(\%constructor) ; push @testGlobalConditions, $testConditionObject ; } return (\@testGlobalConditions) ; } sub gatherConditions { my $self = shift or croak 'no self' ; my $wks = shift or croak 'no worksheet' ; my $testAction = shift or croak 'no action'; my $ra_header = shift or croak 'no headers' ; my $rh_header_cols = shift or croak 'no header cols' ; my $row = shift or croak 'no start row' ; my $row_max = shift or croak 'no max row' ; my @testGlobalConditions = () ; my $TYPECOL = 2 ; for (my $r = $row; $r <= $row_max; $r++ ) { last if defined $wks->get_cell($r,1) ; last if ( defined $wks->get_cell($r,1) and $wks->get_cell($r,1)->value() ) ; last if not defined $wks->get_cell($r,$TYPECOL) ; last if ( defined $wks->get_cell($r,$TYPECOL) and $wks->get_cell($r,$TYPECOL)->value() eq '' ) ; my $testconditiontype = $wks->get_cell($r,$TYPECOL)->value() ; my @populatedColumns = map { $_ - $TYPECOL } grep { defined $wks->get_cell($r,$_) and $wks->get_cell($r,$_)->value() ne '' } ( $TYPECOL+1 .. $TYPECOL + scalar(@{$ra_header}) ) ; my @populatedVals = map { $wks->get_cell($r,$_ + $TYPECOL)->value() } @populatedColumns ; my @populatedColumnsHeaders = map { $ra_header->[$_] } @populatedColumns ; my @populatedColumnsHeadersHASH = map { uc "CONDITION${_}" } @populatedColumnsHeaders ; my @constructor = zip( @populatedColumnsHeadersHASH,@populatedVals ); my %constructor = @constructor ; $constructor{TESTCONDITIONTYPE} = $testconditiontype ; $constructor{CONDITIONTESTACTIONNAME} = $testAction ; #warn Dumper %constructor ; my $testConditionObject = VSGDR::UnitTest::TestSet::Test::TestCondition->make(\%constructor) ; push @testGlobalConditions, $testConditionObject ; } return (@testGlobalConditions) ; } sub representationType { my $self = shift; return 'XLS' ; } sub writeSpreadsheet { my $self = shift or croak 'no self' ; my $filename = shift or croak 'no file' ; my $testSet = shift or croak 'no test' ; my $colOffset = 2 ; my @header = $testSet->allConditionAttributeNames() ; my %header_pos = () ; for ( my $i = 0; $i <= $#header; $i++) { $header_pos{$header[$i]} = $i } ; my $workbook = Spreadsheet::WriteExcel->new(${filename}); my $format1 = $workbook->add_format(); $format1->set_bold(); my $wks_globals = $workbook->add_worksheet('TestGlobals'); $wks_globals->write_row(0,0,['TestNameSpace','TestClass'],$format1) ; $wks_globals->write_row(1,0,[ $testSet->nameSpace() , $testSet->className() ] ) ; my $wks_globalconditions = $workbook->add_worksheet('TestGlobalConditions'); $G_ln = 0 ; $wks_globalconditions->write_row($G_ln, 0, ['TestInitializeAction'],$format1); $wks_globalconditions->write_row($G_ln, 1, [$testSet->initializeAction()]); $wks_globalconditions->write_row($G_ln, $colOffset, \@header,$format1); if ( $testSet->initializeAction() ) { $G_ln++; my $ra_Conditions = $testSet->initializeConditions(); $self->printConditions( $wks_globalconditions,\@header, \%header_pos, $ra_Conditions) ; } $G_ln++;$G_ln++; $wks_globalconditions->write_row($G_ln, 0, ['TestCleanupAction'],$format1); $wks_globalconditions->write_row($G_ln, 1, [$testSet->cleanupAction()]); $wks_globalconditions->write_row($G_ln, $colOffset, \@header,$format1); if ( $testSet->cleanupAction() ) { $G_ln++; my $ra_Conditions = $testSet->cleanupConditions(); $self->printConditions( $wks_globalconditions,\@header, \%header_pos, $ra_Conditions) ; } my $ra_tests = $testSet->tests() ; my $wks_test = undef ; $test_No = 0 ; for my $test (@$ra_tests) { $test_No++ ; $wks_test = $workbook->add_worksheet("Test ${test_No}"); $G_ln = 0 ; $wks_test->write_row($G_ln, 0, [ 'Test Name '],$format1); $wks_test->write_row($G_ln, 1, [ $test->testName() ]); my $ra_Conditions = undef ; if ( $test->preTestAction() ne 'null' ) { $wks_test->write_row($G_ln, $colOffset, \@header,$format1); $G_ln++; $wks_test->write_row($G_ln, 1, ['PretestAction'],$format1); $G_ln++; $ra_Conditions = $test->preTest_conditions(); $self->printConditions( $wks_test,\@header, \%header_pos, $ra_Conditions) ; } $G_ln++; $wks_test->write_row($G_ln, $colOffset, \@header,$format1); $G_ln++; $wks_test->write_row($G_ln, 1, ['TestAction'],$format1); $G_ln++; $ra_Conditions = $test->test_conditions(); $self->printConditions( $wks_test,\@header, \%header_pos, $ra_Conditions) ; $G_ln++; if ( $test->postTestAction() ne 'null' ) { $wks_test->write_row($G_ln, $colOffset, \@header,$format1); $G_ln++; $wks_test->write_row($G_ln, 1, ['PosttestAction'],$format1); $G_ln++; $ra_Conditions = $test->postTest_conditions(); $self->printConditions( $wks_test,\@header, \%header_pos, $ra_Conditions) ; $G_ln++; } } $workbook->close(); return "" ; #$workbook ; } sub printConditions { local $_ = undef ; my $self = shift or croak 'no self' ; my $wks = shift or croak 'no worksheet'; my $ra_header = shift or croak 'no header' ; my $rh_header_pos = shift or croak 'no header' ; my $ra_Conditions = shift or croak 'no conditions' ; my %conditionVals = map { $_ => undef } @{$ra_header} ; my $colOffset = 2 ; for my $condition (@$ra_Conditions) { my @attrs = $condition->testConditionAttributes(); my @attrvals = () ; #warn Dumper @attrs ; for my $attr ( grep { $_ !~ m{^conditionTestActionName$}x } @attrs ) { ( my $fixedName = $attr ) =~ s{^condition}{}ix; $conditionVals{$fixedName} = $condition->${attr}() ; $attrvals[$rh_header_pos->{$fixedName}] = $condition->${attr}() ; } $attrvals[$rh_header_pos->{'Type'}] = $condition->testConditionType() ; #warn "hello\n"; #warn $condition->testConditionType(); #warn Dumper @attrvals; $wks->write_row($G_ln, $colOffset, \@attrvals); $G_ln++; } return ; } sub flatten { return map { @$_} @_ } ; 1 ; __DATA__