File Coverage

blib/lib/VSGDR/UnitTest/TestSet/Resx.pm
Criterion Covered Total %
statement 26 97 26.8
branch 0 38 0.0
condition 0 6 0.0
subroutine 9 20 45.0
pod 0 10 0.0
total 35 171 20.4


line stmt bran cond sub pod time code
1             package VSGDR::UnitTest::TestSet::Resx;
2              
3 1     1   1196 use 5.010;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         24  
5 1     1   6 use warnings;
  1         2  
  1         32  
6              
7              
8             #our \$VERSION = '1.01';
9              
10              
11 1     1   6 use parent qw(Clone) ;
  1         2  
  1         7  
12              
13 1     1   53 use XML::Simple;
  1         3  
  1         6  
14 1     1   754 use XML::Quote qw(:all);
  1         706  
  1         144  
15              
16 1     1   36 use Data::Dumper ;
  1         3  
  1         46  
17 1     1   5 use Carp ;
  1         2  
  1         60  
18              
19 1     1   5 use vars qw($AUTOLOAD);
  1         2  
  1         1007  
20              
21              
22             #TODO: 1. Fix more stuff for vs2010 gdr tests.
23              
24              
25             sub new {
26              
27 0     0 0   local $_ = undef ;
28              
29 0           my $invocant = shift ;
30 0   0       my $class = ref($invocant) || $invocant ;
31              
32 0           my @elems = @_ ;
33 0           my $self = bless {}, $class ;
34              
35 0           $self->_init(@elems) ;
36 0           return $self ;
37             }
38              
39              
40             sub _init {
41              
42 0     0     local $_ = undef ;
43              
44 0           my $self = shift ;
45 0   0       my $class = ref($self) || $self ;
46 0           return ;
47              
48             }
49              
50             sub scripts {
51 0 0   0 0   my $self = shift or croak 'no self';
52 0           my $scripts ;
53 0 0         $scripts = shift if @_;
54 0 0         if ( defined $scripts ) {
55 0           $self->{SCRIPTS} = $scripts ;
56             }
57 0           return $self->{SCRIPTS} ;
58             }
59              
60              
61             ## ======================================================
62             sub serialise {
63 0 0   0 0   my $self = shift or croak 'no self' ;
64 0 0         my $file = shift or croak 'no file' ;
65 0 0         my $object = shift or croak 'no object';
66            
67 0           my $code = $self->deparse($object);
68            
69 0           my $data;
70 0           my $fh = new IO::File "> ${file}" ;
71 0 0         if (defined ${fh} ) {
72 0           print ${fh} $code;
73 0           $fh->close;
74             }
75             else {
76 0           croak "Unable to write to ${file}.";
77             }
78 0           return ;
79             }
80             ## ======================================================
81             sub deserialise {
82              
83 0 0   0 0   my $self = shift or croak 'no self' ;
84 0 0         my $file = shift or croak 'no file' ;
85 0           my $data;
86 0           my $fh = new IO::File;
87 0 0         if ($fh->open("< ${file}")) {
88 0           { local $/ = undef ; $data = <$fh> ; }
  0            
  0            
89 0           $fh->close;
90             }
91             else {
92 0           croak "Unable to read from ${file}.";
93             }
94 0           my $object = $self->parse($data);
95 0           return ${object} ;
96             }
97             ## ======================================================
98              
99              
100             sub parse {
101              
102 0 0   0 0   my $self = shift or croak 'no self' ;
103 0           my $code = shift ;
104              
105 0 0         if ( defined $code ) {
106 0           my $ref = XMLin($code,ForceArray=>['data'] );
107 0           my %res = () ;
108 0           foreach my $k ( keys %{$ref->{data}} ) {
  0            
109 0           ( my $newKey = $k ) =~ s{\.SqlScript$}{}x ;
110 0 0         if ( ref($ref->{data}->{$k}->{value}) ne 'HASH' ) {
111 0           $res{$newKey} = $ref->{data}->{$k}->{value} ;
112             }
113             else {
114             # warn 'Something strange with XMLin again' ;
115             }
116             }
117 0           $self->{SCRIPTS} = \%res ;
118             };
119            
120 0           return $self->{SCRIPTS} ;
121             }
122              
123             sub deparse {
124 0 0   0 0   my $self = shift or croak 'no self' ;
125 0           my $code = shift ;
126              
127             return $self->xmlHeader() .
128 0           $self->xmlTests($self->{SCRIPTS}) .
129             $self->xmlFooter() ;
130              
131             }
132              
133             sub xmlTests {
134 0 0   0 0   my $self = shift or croak 'no self' ;
135 0 0         my $resSet = shift or croak 'no resources' ; # ref to a has containing test name - sql pairs
136              
137 0           my $result = "" ;
138              
139 0           foreach my $k ( keys %$resSet) {
140 0           $result .= ' '. "\n";
141             # $result .= " \n" ;
142 0           $result .= " " ;
143 0           $result .= xml_quote_min($$resSet{$k}) ;
144             # $result .= xml_quote($$resSet{$k}) ;
145 0           $result .= "\n" ;
146 0           $result .= " \n" ;
147             }
148 0           return $result ;
149             }
150              
151             sub xmlHeader {
152 0 0   0 0   my $self = shift or croak 'no self' ;
153 0           return <<'EOH';
154            
155            
156            
215            
216            
217            
218            
219            
220            
221            
222            
223            
224            
225            
226            
227            
228            
229            
230            
231            
232            
233            
234            
235            
236            
237            
238            
239            
240            
241            
242            
243            
244            
245            
246            
247            
248            
249            
250            
251            
252            
253            
254            
255            
256            
257            
258            
259            
260            
261            
262             text/microsoft-resx
263            
264            
265             2.0
266            
267            
268             System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089
269            
270            
271             System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089
272            
273             EOH
274             #'
275             }
276              
277             sub xmlHeaderMoreUnfortunateStuffToHaveToHandle {
278 0 0   0 0   my $self = shift or croak 'no self' ;
279 0           return <<'EOF';
280            
281             Press to configure
282            
283            
284             Press to configure
285            
286            
287            
288             AAEAAAD/////AQAAAAAAAAAMAgAAAE5TeXN0ZW0uRGF0YSwgVmVyc2lvbj00LjAuMC4wLCBDdWx0dXJl
289             PW5ldXRyYWwsIFB1YmxpY0tleVRva2VuPWI3N2E1YzU2MTkzNGUwODkFAQAAABNTeXN0ZW0uRGF0YS5E
290             YXRhU2V0AwAAABdEYXRhU2V0LlJlbW90aW5nVmVyc2lvbglYbWxTY2hlbWELWG1sRGlmZkdyYW0DAQEO
291             U3lzdGVtLlZlcnNpb24CAAAACQMAAAAGBAAAAL8SPD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0i
292             dXRmLTE2Ij8+DQo8eHM6c2NoZW1hIGlkPSJOZXdEYXRhU2V0IiB4bWxucz0iIiB4bWxuczp4cz0iaHR0
293             cDovL3d3dy53My5vcmcvMjAwMS9YTUxTY2hlbWEiIHhtbG5zOm1zZGF0YT0idXJuOnNjaGVtYXMtbWlj
294             cm9zb2Z0LWNvbTp4bWwtbXNkYXRhIj4NCiAgPHhzOmVsZW1lbnQgbmFtZT0iTmV3RGF0YVNldCIgbXNk
295             YXRhOklzRGF0YVNldD0idHJ1ZSIgbXNkYXRhOlVzZUN1cnJlbnRMb2NhbGU9InRydWUiPg0KICAgIDx4
296             czpjb21wbGV4VHlwZT4NCiAgICAgIDx4czpjaG9pY2UgbWluT2NjdXJzPSIwIiBtYXhPY2N1cnM9InVu
297             Ym91bmRlZCI+DQogICAgICAgIDx4czplbGVtZW50IG5hbWU9IlRhYmxlIj4NCiAgICAgICAgICA8eHM6
298             Y29tcGxleFR5cGU+DQogICAgICAgICAgICA8eHM6c2VxdWVuY2U+DQogICAgICAgICAgICAgIDx4czpl
299             bGVtZW50IG5hbWU9IkNvbHVtbjEiIHR5cGU9InhzOmludCIgbXNkYXRhOnRhcmdldE5hbWVzcGFjZT0i
300             IiBtaW5PY2N1cnM9IjAiIC8+DQogICAgICAgICAgICA8L3hzOnNlcXVlbmNlPg0KICAgICAgICAgIDwv
301             eHM6Y29tcGxleFR5cGU+DQogICAgICAgIDwveHM6ZWxlbWVudD4NCiAgICAgICAgPHhzOmVsZW1lbnQg
302             bmFtZT0iVGFibGUxIj4NCiAgICAgICAgICA8eHM6Y29tcGxleFR5cGU+DQogICAgICAgICAgICA8eHM6
303             c2VxdWVuY2U+DQogICAgICAgICAgICAgIDx4czplbGVtZW50IG5hbWU9IlBlcnNvbklkIiB0eXBlPSJ4
304             czppbnQiIG1zZGF0YTp0YXJnZXROYW1lc3BhY2U9IiIgbWluT2NjdXJzPSIwIiAvPg0KICAgICAgICAg
305             ICAgICA8eHM6ZWxlbWVudCBuYW1lPSJUaXRsZUlkIiB0eXBlPSJ4czppbnQiIG1zZGF0YTp0YXJnZXRO
306             YW1lc3BhY2U9IiIgbWluT2NjdXJzPSIwIiAvPg0KICAgICAgICAgICAgICA8eHM6ZWxlbWVudCBuYW1l
307             PSJOYW1lU3VmZml4SWQiIHR5cGU9InhzOmludCIgbXNkYXRhOnRhcmdldE5hbWVzcGFjZT0iIiBtaW5P
308             Y2N1cnM9IjAiIC8+DQogICAgICAgICAgICAgIDx4czplbGVtZW50IG5hbWU9IlN1cm5hbWUiIHR5cGU9
309             InhzOnN0cmluZyIgbXNkYXRhOnRhcmdldE5hbWVzcGFjZT0iIiBtaW5PY2N1cnM9IjAiIC8+DQogICAg
310             ICAgICAgICAgIDx4czplbGVtZW50IG5hbWU9IkZvcmVuYW1lIiB0eXBlPSJ4czpzdHJpbmciIG1zZGF0
311             YTp0YXJnZXROYW1lc3BhY2U9IiIgbWluT2NjdXJzPSIwIiAvPg0KICAgICAgICAgICAgICA8eHM6ZWxl
312             bWVudCBuYW1lPSJPdGhlcm5hbWUiIHR5cGU9InhzOnN0cmluZyIgbXNkYXRhOnRhcmdldE5hbWVzcGFj
313             ZT0iIiBtaW5PY2N1cnM9IjAiIC8+DQogICAgICAgICAgICAgIDx4czplbGVtZW50IG5hbWU9IlNleCIg
314             dHlwZT0ieHM6c3RyaW5nIiBtc2RhdGE6dGFyZ2V0TmFtZXNwYWNlPSIiIG1pbk9jY3Vycz0iMCIgLz4N
315             CiAgICAgICAgICAgICAgPHhzOmVsZW1lbnQgbmFtZT0iRGVsZXRlZCIgdHlwZT0ieHM6Ym9vbGVhbiIg
316             bXNkYXRhOnRhcmdldE5hbWVzcGFjZT0iIiBtaW5PY2N1cnM9IjAiIC8+DQogICAgICAgICAgICAgIDx4
317             czplbGVtZW50IG5hbWU9IkNMb2FkSWQiIHR5cGU9InhzOmludCIgbXNkYXRhOnRhcmdldE5hbWVzcGFj
318             ZT0iIiBtaW5PY2N1cnM9IjAiIC8+DQogICAgICAgICAgICAgIDx4czplbGVtZW50IG5hbWU9IkNTcmNJ
319             ZCIgdHlwZT0ieHM6aW50IiBtc2RhdGE6dGFyZ2V0TmFtZXNwYWNlPSIiIG1pbk9jY3Vycz0iMCIgLz4N
320             CiAgICAgICAgICAgICAgPHhzOmVsZW1lbnQgbmFtZT0iVUxvYWRJZCIgdHlwZT0ieHM6aW50IiBtc2Rh
321             dGE6dGFyZ2V0TmFtZXNwYWNlPSIiIG1pbk9jY3Vycz0iMCIgLz4NCiAgICAgICAgICAgICAgPHhzOmVs
322             ZW1lbnQgbmFtZT0iVVNyY0lkIiB0eXBlPSJ4czppbnQiIG1zZGF0YTp0YXJnZXROYW1lc3BhY2U9IiIg
323             bWluT2NjdXJzPSIwIiAvPg0KICAgICAgICAgICAgICA8eHM6ZWxlbWVudCBuYW1lPSJVUHJvY0lkIiB0
324             eXBlPSJ4czppbnQiIG1zZGF0YTp0YXJnZXROYW1lc3BhY2U9IiIgbWluT2NjdXJzPSIwIiAvPg0KICAg
325             ICAgICAgICAgICA8eHM6ZWxlbWVudCBuYW1lPSJEb0JpcnRoIiB0eXBlPSJ4czpkYXRlVGltZSIgbXNk
326             YXRhOnRhcmdldE5hbWVzcGFjZT0iIiBtaW5PY2N1cnM9IjAiIC8+DQogICAgICAgICAgICAgIDx4czpl
327             bGVtZW50IG5hbWU9IkluZGl2aWR1YWxJZCIgdHlwZT0ieHM6aW50IiBtc2RhdGE6dGFyZ2V0TmFtZXNw
328             YWNlPSIiIG1pbk9jY3Vycz0iMCIgLz4NCiAgICAgICAgICAgIDwveHM6c2VxdWVuY2U+DQogICAgICAg
329             ICAgPC94czpjb21wbGV4VHlwZT4NCiAgICAgICAgPC94czplbGVtZW50Pg0KICAgICAgPC94czpjaG9p
330             Y2U+DQogICAgPC94czpjb21wbGV4VHlwZT4NCiAgPC94czplbGVtZW50Pg0KPC94czpzY2hlbWE+BgUA
331             AACAATxkaWZmZ3I6ZGlmZmdyYW0geG1sbnM6bXNkYXRhPSJ1cm46c2NoZW1hcy1taWNyb3NvZnQtY29t
332             OnhtbC1tc2RhdGEiIHhtbG5zOmRpZmZncj0idXJuOnNjaGVtYXMtbWljcm9zb2Z0LWNvbTp4bWwtZGlm
333             ZmdyYW0tdjEiIC8+BAMAAAAOU3lzdGVtLlZlcnNpb24EAAAABl9NYWpvcgZfTWlub3IGX0J1aWxkCV9S
334             ZXZpc2lvbgAAAAAICAgIAgAAAAAAAAD//////////ws=
335            
336            
337             EOF
338             }
339              
340             sub xmlFooter {
341 0 0   0 0   my $self = shift or croak 'no self' ;
342 0           return <<'EOF';
343            
344             True
345            
346            
347             EOF
348             }
349              
350              
351             1 ;
352              
353              
354             __DATA__