#!/bin/perl use strict; use warnings; use 5.010; use version ; our $VERSION = qv('1.0.4'); use autodie qw(:all); no indirect ':fatal'; use Carp; use VSGDR::UnitTest::TestSet::Test; use VSGDR::UnitTest::TestSet::Test::TestCondition; use VSGDR::UnitTest::TestSet::Representation; use VSGDR::UnitTest::TestSet::Resx; use Getopt::Euclid qw( :vars ); use List::MoreUtils qw{firstidx} ; use Data::Dumper; #use Smart::Comments ; use File::Basename; my %ValidParserMakeArgs = ( vb => "NET::VB" , cs => "NET::CS" , xls => "XLS" , xml => "XML" ) ; my %ValidParserMakeArgs2 = ( vb => "NET2::VB" , cs => "NET2::CS" ) ; ### get and validate parameters croak 'no input file' unless defined($opt_infile); croak 'no output file' unless defined($opt_outfile); my $version = $opt_version ; my $inFile = $opt_infile ; my $outFile = $opt_outfile ; (my $inpfx = $inFile) =~ s{^(.*)[.][^.]*$}{$1}smx; (my $insfx = $inFile) =~ s/^.*\.//g; croak 'Invalid input file' unless defined $insfx ; $insfx = lc $insfx ; (my $outpfx = $outFile) =~ s{^(.*)[.][^.]*$}{$1}smx; (my $outsfx = $outFile) =~ s/^.*\.//g; croak 'Invalid output file' unless defined $outsfx ; $outsfx = lc $outsfx ; my $outResxFile = "${outpfx}.resx" ; croak 'Invalid input file' unless exists $ValidParserMakeArgs{$insfx} ; croak 'Invalid output file' unless exists $ValidParserMakeArgs{$outsfx} ; ### check output files can be written to # yes so it's a race-condition anyway croak 'Output resource file cannot be written to' unless -f $outResxFile or ! -e $outResxFile ; ### build parsers my %Parsers = () ; $Parsers{${insfx}} = VSGDR::UnitTest::TestSet::Representation->make( { TYPE => $ValidParserMakeArgs{${insfx}} } ); # if input is in a .net language, add in a .net2 parser to the list if ( firstidx { $_ eq ${insfx} } ['cs','vb'] != -1 ) { $Parsers{"${insfx}2"} = VSGDR::UnitTest::TestSet::Representation->make( { TYPE => $ValidParserMakeArgs2{${insfx}} } ); } # if output is needed in ssdt unit test format add in a .net2 parser to the list if ($version == 1) { $Parsers{${outsfx}} = VSGDR::UnitTest::TestSet::Representation->make( { TYPE => $ValidParserMakeArgs{${outsfx}} } ); } else { $Parsers{"${outsfx}2"} = VSGDR::UnitTest::TestSet::Representation->make( { TYPE => $ValidParserMakeArgs2{${outsfx}} } ); } ### build internal representations of input my $o_resx = VSGDR::UnitTest::TestSet::Resx->new() ; my $testSet = undef ; eval { $testSet = $Parsers{$insfx}->deserialise($inFile); } ; if ( not defined $testSet ) { if ( exists $Parsers{"${insfx}2"}) { eval { $testSet = $Parsers{$insfx}->deserialise($inFile); } } else { croak 'Parsing failed.'; } } my $resx_data = ''; { $/ = undef ; open (my $aa, "<", "${inpfx}.resx"); $resx_data = <$aa> ; close $aa ;} ; my $rh_testScripts = $o_resx->parse($resx_data) ; my $ra_tests = $testSet->tests() ; ### filter input to output my $newTestSet = VSGDR::UnitTest::TestSet->new( { NAMESPACE => $testSet->className() , CLASSNAME => $testSet->className() } ) ; $newTestSet->initializeConditions($testSet->initializeConditions()) ; $newTestSet->cleanupConditions($testSet->cleanupConditions()) ; $newTestSet->tests($ra_tests) ; foreach my $re ( @opt_enable) { my $qre = qr{$re} ; foreach my $cond ( @{$newTestSet->initializeConditions()} ) { if ($cond->Name() =~ m{$qre} ) { $cond->conditionEnabled('True') ; say STDERR "Enabled @{[ $cond->conditionName() ]}"; } } foreach my $cond ( @{$newTestSet->cleanupConditions()} ) { if ($cond->Name() =~ m{$qre} ) { $cond->conditionEnabled('True') ; say STDERR "Enabled @{[ $cond->conditionName() ]}"; } } } foreach my $re ( @opt_disable) { my $qre = qr{$re} ; foreach my $cond ( @{$newTestSet->initializeConditions()} ) { if ($cond->Name() =~ m{$qre} ) { $cond->conditionEnabled('False') ; say STDERR "Disabled @{[ $cond->conditionName() ]}"; } } foreach my $cond ( @{$newTestSet->cleanupConditions()} ) { if ($cond->Name() =~ m{$qre} ) { $cond->conditionEnabled('False') ; say STDERR "Disabled @{[ $cond->conditionName() ]}"; } } } foreach my $test (@{$newTestSet->tests()}) { foreach my $re ( @opt_enable) { my $qre = qr{$re} ; foreach my $cond ( @{$test->preTest_conditions()} ) { if ($cond->conditionName() =~ m{$qre} ) { $cond->conditionEnabled('True') ; say STDERR "Enabled @{[ $cond->conditionName() ]}"; } } foreach my $cond ( @{$test->test_conditions()} ) { if ($cond->conditionName() =~ m{$qre} ) { $cond->conditionEnabled('True') ; say STDERR "Enabled @{[ $cond->conditionName() ]}"; } } foreach my $cond ( @{$test->postTest_conditions()} ) { if ($cond->conditionName() =~ m{$qre} ) { $cond->conditionEnabled('True') ; say STDERR "Enabled @{[ $cond->conditionName() ]}"; } } } foreach my $re ( @opt_disable) { my $qre = qr{$re} ; foreach my $cond ( @{$test->preTest_conditions()} ) { if ($cond->conditionName() =~ m{$qre} ) { $cond->conditionEnabled('False') ; say STDERR "Disabled @{[ $cond->conditionName() ]}"; } } foreach my $cond ( @{$test->test_conditions()} ) { if ($cond->conditionName() =~ m{$qre} ) { $cond->conditionEnabled('False') ; say STDERR "Disabled @{[ $cond->conditionName() ]}"; } } foreach my $cond ( @{$test->postTest_conditions()} ) { if ($cond->conditionName() =~ m{$qre} ) { $cond->conditionEnabled('False') ; say STDERR "Disabled @{[ $cond->conditionName() ]}"; } } } } unlink $outFile if -f $outFile ; if ($version == 1) { $Parsers{$outsfx}->serialise($outFile,$newTestSet); } else { $Parsers{"${outsfx}2"}->serialise($outFile,$newTestSet); } my $o_resx_clone = $o_resx->clone() ; unlink $outResxFile if -f $outResxFile ; $o_resx_clone->serialise($outResxFile,$o_resx_clone); ### end exit ; END {} __END__ =head1 NAME disableGDRTestCondition.pl - Disable/Enable Test Conditions in a GDR Unit Test file. =head1 VERSION 1.0.4 =head1 USAGE disableGDRTestCondition.pl -i -o [options] =head1 REQUIRED ARGUMENTS =over =item -i[n][file] [=] Specify input file =for Euclid: file.type: readable =item -o[ut][file] [=] Specify output file =for Euclid: file.type: writable =back =head1 OPTIONS =over =item -v[er][sion] [=] Output version type =for Euclid: outputversion.type: /[12]/ outputversion.default: 1 =item -e[n][able] [=] Specify condition name to enable ( as perl RE ) =for Euclid: enable_re.type: string repeatable =item -d[is][able] [=] Specify condition name to disable ( as perl RE ) =for Euclid: disable_re.type: string repeatable =back =head1 AUTHOR Ded MedVed. =head1 BUGS Hopefully none. =head1 COPYRIGHT Copyright (c) 2012, Ded MedVed. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html)