File Coverage

lib/XML/Compile/RPC/Util.pm
Criterion Covered Total %
statement 53 53 100.0
branch 6 10 60.0
condition 1 2 50.0
subroutine 12 12 100.0
pod 8 8 100.0
total 80 85 94.1


line stmt bran cond sub pod time code
1             # Copyrights 2009-2013 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 2     2   158411 use warnings;
  2         6  
  2         65  
6 2     2   9 use strict;
  2         5  
  2         78  
7              
8             package XML::Compile::RPC::Util;
9 2     2   11 use vars '$VERSION';
  2         3  
  2         95  
10             $VERSION = '0.17';
11              
12 2     2   9 use base 'Exporter';
  2         3  
  2         1626  
13              
14             our @EXPORT = qw/
15             struct_to_hash
16             struct_to_rows
17             struct_from_rows
18             struct_from_hash
19              
20             rpcarray_values
21             rpcarray_from
22              
23             fault_code
24             fault_from
25             /;
26              
27              
28             sub struct_to_hash($)
29 3     3 1 28 { my $s = shift;
30 3         5 my %h;
31              
32 3 50       5 foreach my $member ( @{$s->{member} || []} )
  3         15  
33 7         8 { my ($type, $value) = %{$member->{value}};
  7         19  
34 7         22 $h{$member->{name}} = $value;
35             }
36              
37 3         9 \%h;
38             }
39              
40              
41             sub struct_to_rows($)
42 1     1 1 717 { my $s = shift;
43 1         1 my @r;
44              
45 1 50       2 foreach my $member ( @{$s->{member} || []} )
  1         5  
46 3         3 { my ($type, $value) = %{$member->{value}};
  3         7  
47 3         13 push @r, [ $member->{name}, $type, $value ];
48             }
49              
50 1         5 @r;
51             }
52              
53              
54             sub struct_from_rows(@)
55 2     2 1 1014 { my @members = map { +{name => $_->[0], value => {$_->[1] => $_->[2]}}} @_;
  5         33  
56 2         11 +{ struct => {member => \@members} };
57             }
58              
59              
60             sub struct_from_hash($$)
61 1     1 1 1923 { my ($type, $hash) = @_;
62 3 50       14 my @members = map { +{name => $_, value => {$type => $hash->{$_}}} }
  1         13  
63 1         3 sort keys %{$hash || {}};
64 1         5 +{ struct => {member => \@members} };
65             }
66              
67              
68             sub rpcarray_values($)
69 1     1 1 1969 { my $rpca = shift;
70 1         2 my @v;
71 1 50       2 foreach ( @{$rpca->{data}{value} || []} )
  1         7  
72 3         8 { my ($type, $value) = %$_;
73 3         7 push @v, $value;
74             }
75 1         8 @v;
76             }
77              
78              
79             sub rpcarray_from($@)
80 1     1 1 2 { my $type = shift;
81 1         2 my @values = map { +{$type => $_} } @_;
  3         9  
82 1         12 +{array => {data => {value => \@values}}};
83             }
84              
85              
86             sub fault_code($)
87 2     2 1 752 { my $h = struct_to_hash shift->{value}{struct};
88 2   50     7 my $fc = $h->{faultCode} || -1;
89 2 100       11 wantarray ? ($fc, $h->{faultString}) : $fc;
90             }
91              
92              
93             sub fault_from($$)
94 1     1 1 349 { my ($rc, $msg) = @_;
95 1         5 my @rows = ([faultCode => int => $rc], [faultString => string => $msg]);
96 1         5 +{fault => {value => struct_from_rows(@rows)}};
97             }
98              
99             1;