File Coverage

blib/lib/VSGDR/UnitTest/TestSet/Representation.pm
Criterion Covered Total %
statement 23 64 35.9
branch 0 18 0.0
condition 0 6 0.0
subroutine 8 13 61.5
pod 0 4 0.0
total 31 105 29.5


line stmt bran cond sub pod time code
1             package VSGDR::UnitTest::TestSet::Representation;
2              
3 1     1   20 use 5.010;
  1         5  
4 1     1   5 use strict;
  1         2  
  1         25  
5 1     1   7 use warnings;
  1         1  
  1         34  
6              
7              
8             #our \$VERSION = '1.02';
9              
10              
11 1     1   5 use parent qw(Clone) ;
  1         2  
  1         5  
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   4448 use IO::File;
  1         9577  
  1         154  
17              
18 1     1   995 use Data::Dumper ;
  1         7338  
  1         60  
19 1     1   6 use Carp ;
  1         1  
  1         55  
20              
21 1     1   5 use vars qw($AUTOLOAD );
  1         2  
  1         533  
22              
23             my %Types = ('XML' => 1
24             ,'NET::CS' => 1
25             ,'NET::VB' => 1
26             ,'XLS' => 1
27             ,'NET2::CS' => 1
28             ,'NET2::VB' => 1
29             ) ;
30              
31              
32             sub new {
33              
34 0     0 0   local $_ = undef ;
35              
36 0           my $invocant = shift ;
37 0   0       my $class = ref($invocant) || $invocant ;
38              
39 0           my @elems = @_ ;
40 0           my $self = bless {}, $class ;
41            
42 0           $self->_init(@elems) ;
43 0           return $self ;
44             }
45              
46              
47             sub _init {
48              
49 0     0     local $_ = undef ;
50              
51 0           my $self = shift ;
52 0   0       my $class = ref($self) || $self ;
53              
54 0           return ;
55            
56             }
57              
58              
59             sub make {
60              
61 0     0 0   local $_ = undef ;
62 0           my $self = shift ;
63              
64 0 0         my $objectType = $_[0]->{TYPE} or croak 'No Representation type' ;
65 0 0         croak "Invalid Representation language type " unless exists $Types{$objectType };
66 0           ( my $objectTypePathFileName = ${objectType} ) =~ s{::}{/}xg ;
67 0           require "VSGDR/UnitTest/TestSet/Representation/${objectTypePathFileName}.pm";
68 0           return "VSGDR::UnitTest::TestSet::Representation::${objectType}"->new(@_) ;
69              
70             }
71              
72             ## default standard implementations of code below..............
73             ##XLS has to override them.
74             ## ======================================================
75             sub serialise {
76 0 0   0 0   my $self = shift or croak 'no self' ;
77 0 0         my $file = shift or croak 'no file' ;
78 0 0         my $object = shift or croak 'no object';
79            
80 0           my $code = $self->deparse($object);
81            
82 0           my $data;
83 0           my $fh = new IO::File "> ${file}" ;
84 0 0         if (defined ${fh} ) {
85 0           print ${fh} $code;
86 0           $fh->close;
87             }
88             else {
89 0           croak "Unable to write to ${file}.";
90             }
91 0           return ;
92             }
93             ## ======================================================
94             sub deserialise {
95              
96 0 0   0 0   my $self = shift or croak 'no self' ;
97 0 0         my $file = shift or croak 'no file' ;
98 0           my $data;
99 0           my $fh = new IO::File;
100 0 0         if ($fh->open("< ${file}")) {
101 0           { local $/ = undef ; $data = <$fh> ; }
  0            
  0            
102 0           $fh->close;
103             }
104             else {
105 0           croak "Unable to read from ${file}.";
106             }
107 0           my $object = $self->parse($data);
108 0           return ${object} ;
109             }
110             ## ======================================================
111              
112              
113             1 ;
114