File Coverage

blib/lib/VSGDR/UnitTest/TestSet/Test/TestCondition.pm
Criterion Covered Total %
statement 17 66 25.7
branch 0 24 0.0
condition 0 3 0.0
subroutine 6 17 35.2
pod 0 9 0.0
total 23 119 19.3


line stmt bran cond sub pod time code
1             package VSGDR::UnitTest::TestSet::Test::TestCondition;
2              
3 1     1   1383 use 5.010;
  1         3  
4 1     1   5 use strict;
  1         1  
  1         17  
5 1     1   3 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              
14 1     1   6 use Data::Dumper ;
  1         8  
  1         39  
15 1     1   5 use Carp ;
  1         2  
  1         49  
16              
17              
18 1     1   5 use vars qw($AUTOLOAD );
  1         2  
  1         683  
19              
20             my %Types = (ScalarValue=> 1
21             ,EmptyResultSet=> 1
22             ,ExecutionTime=> 1
23             ,Inconclusive=> 1
24             ,NotEmptyResultSet=> 1
25             ,RowCount=> 1
26             ,Checksum=>1
27             ,ExpectedSchema=>1
28             );
29              
30             sub make {
31              
32 0     0 0   local $_ = undef ;
33 0           my $self = shift ;
34 0 0         my $objectType = $_[0]->{TESTCONDITIONTYPE} or croak 'No object type' ;
35 0 0         croak "Invalid Test Condition Type" unless exists $Types{$objectType };
36            
37 0           require "VSGDR/UnitTest/TestSet/Test/TestCondition/${objectType}.pm";
38 0           return "VSGDR::UnitTest::TestSet::Test::TestCondition::${objectType}"->new(@_) ;
39              
40             }
41              
42             sub new {
43              
44 0     0 0   local $_ = undef ;
45              
46 0           my $invocant = shift ;
47 0   0       my $class = ref($invocant) || $invocant ;
48              
49 0           my @elems = @_ ;
50 0           my $self = bless {}, $class ;
51            
52 0           $self->_init(@elems) ;
53 0           return $self ;
54             }
55              
56              
57             sub ok_field {
58 0     0 0   my $self = shift;
59 0           my $attr = shift;
60 0           return $self->{OK_FIELDS}->{$attr} ;
61             }
62              
63             sub commentifyName {
64 0     0 0   my $self = shift;
65 0 0         my $commentChars = shift or croak 'No Chars' ;
66 0           return <<"EOF";
67             ${commentChars}
68 0           ${commentChars}@{[$self->conditionName()]}
69             ${commentChars}
70             EOF
71             }
72              
73             sub testAction {
74 0     0 0   my $self = shift;
75 0           my $ta = $self->{CONDITIONTESTACTIONNAME} ;
76 0           return $ta;
77             }
78              
79             sub testConditionAttributes {
80 0     0 0   my $self = shift;
81 0           return keys %{$self->{OK_FIELDS}} ;
  0            
82             }
83             sub testConditionAttributeType {
84 0     0 0   my $self = shift;
85 0 0         my $attr = shift or croak 'no attribute' ;
86 0 0         croak 'bad attribute'unless $self->ok_field($attr) ;
87             #warn Dumper $self->{OK_FIELDS_TYPE} ;
88 0           return $self->{OK_FIELDS_TYPE}->{$attr} ;
89             }
90              
91             sub testConditionAttributeName {
92 0     0 0   my $self = shift;
93 0 0         my $attr = shift or croak 'no attribute' ;
94 0 0         croak 'bad attribute'unless $self->ok_field($attr) ;
95 0           ( my $n = $attr ) =~ s{^condition}{}x;
96 0           return $n ;
97             }
98              
99             sub conditionISEnabled {
100 0     0 0   local $_ = undef ;
101 0           my $self = shift ;
102 0 0         if ( $self->conditionEnabled() =~ m{\A 1 \z}ix ) {
    0          
103 0           return scalar 1 ;
104             }
105             elsif ( $self->conditionEnabled() =~ m{\A True \z}ix ) {
106 0           return scalar 1 ;
107             }
108             else {
109 0           return scalar 0 ;
110             }
111             }
112              
113              
114              
115              
116       0     sub DESTROY {}
117              
118             sub AUTOLOAD {
119 0     0     my $self = shift;
120 0           my $attr = $AUTOLOAD;
121             #warn Dumper $attr ;
122 0           $attr =~ s{.*::}{}x;
123 0 0         return unless $attr =~ m{[^A-Z]}x; # skip DESTROY and all-cap methods
124             #warn Dumper $attr ;
125             #warn Dumper $ok_field{$attr} ;
126             #warn Dumper %ok_field;
127 0 0         croak "invalid attribute method: ->$attr()" unless $self->ok_field($attr);
128            
129 0           my $UC_ATTR = uc $attr ;
130            
131 0 0         $self->{$UC_ATTR} = shift if @_;
132 0           return $self->{$UC_ATTR};
133             }
134              
135              
136             1 ;
137              
138             __DATA__