File Coverage

blib/lib/Net/Amazon/MechanicalTurk/DataStructure.pm
Criterion Covered Total %
statement 6 127 4.7
branch 0 68 0.0
condition 0 33 0.0
subroutine 2 15 13.3
pod 0 8 0.0
total 8 251 3.1


line stmt bran cond sub pod time code
1             package Net::Amazon::MechanicalTurk::DataStructure;
2 20     20   96 use strict;
  20         39  
  20         660  
3 20     20   93 use warnings;
  20         37  
  20         34141  
4              
5             our $VERSION = '1.00';
6              
7             sub wrap {
8 0     0 0   my ($class, $data) = @_;
9             visit($data, sub {
10 0     0     my ($key, $value, $nodes) = @_;
11 0 0         if (ref($value)) {
12 0           bless($value, $class);
13             }
14 0           });
15             }
16              
17             sub fromProperties {
18             # Assume static call if 1st arg is not this class
19 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
20 0           my $data = {};
21 0           my $props = shift;
22            
23 0           while (my ($fullKey,$value) = each %$props) {
24 0           my $nodeRef = \$data;
25 0           foreach my $key (split(/\./, $fullKey)) {
26 0 0         if (UNIVERSAL::isa(${$nodeRef}, "HASH")) {
  0 0          
  0 0          
27 0           $nodeRef = \${$nodeRef}->{$key};
  0            
28             }
29             elsif (UNIVERSAL::isa(${$nodeRef}, "ARRAY")) {
30 0 0 0       if ($key !~ /^\d+$/ or $key < 1) {
31 0           Carp::croak("Can't convert key $fullKey to data structure.");
32             }
33 0           $nodeRef = \${$nodeRef}->[$key-1];
  0            
34             }
35             elsif ($key =~ /^\d+$/) {
36 0           ${$nodeRef} = [];
  0            
37 0           $nodeRef = \${$nodeRef}->[$key-1];
  0            
38             }
39             else {
40 0           ${$nodeRef} = {};
  0            
41 0           $nodeRef = \${$nodeRef}->{$key};
  0            
42             }
43             }
44 0           ${$nodeRef} = $value;
  0            
45             }
46            
47 0           return $data;
48             }
49              
50             sub toProperties {
51             # Assume static call if 1st arg is not this class
52 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
53 0           my $self = shift;
54 0           my $props = {};
55             eachFlattenedProperty($self, sub {
56 0     0     my ($key, $value) = @_;
57 0           $props->{$key} = $value;
58 0           });
59 0           return $props;
60             }
61              
62             sub eachFlattenedProperty {
63             # Assume static call if 1st arg is not this class
64 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
65 0           my ($self, $block) = @_;
66 0 0         return unless defined($self);
67 0           _eachFlattenedProperty(undef, $self, 0, $block);
68             }
69              
70             sub _eachFlattenedProperty {
71 0     0     my ($key, $value, $parentIsHash, $block) = @_;
72 0 0         if (UNIVERSAL::isa($value, "ARRAY")) {
    0          
73 0           for (my $i=0; $i<=$#{$value}; $i++) {
  0            
74 0           _eachFlattenedProperty($key.".".($i+1), $value->[$i], 0, $block);
75             }
76             }
77             elsif (UNIVERSAL::isa($value, "HASH")) {
78 0           while (my ($subKey,$subValue) = each %$value) {
79 0           my $newKey = $subKey;
80 0 0         if (defined($key)) {
81 0 0         $newKey = ($parentIsHash) ? "${key}.1.${subKey}" : "${key}.${subKey}";
82             }
83 0           _eachFlattenedProperty($newKey, $subValue, 1, $block);
84             }
85             }
86             else {
87 0           $block->($key, $value);
88             }
89             }
90              
91             sub visit {
92             # Assume static call if 1st arg is not this class
93 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
94 0           my ($self, $block, $orderKeys) = @_;
95 0           _visit(undef, $self, [], $block, $orderKeys);
96             }
97              
98             sub _visit {
99 0     0     my ($key, $value, $nodes, $block, $orderKeys) = @_;
100 0 0         return unless defined($value);
101            
102 0           $block->($key, $value, $nodes);
103 0           push(@$nodes, $value);
104 0 0         if (UNIVERSAL::isa($value, "HASH")) {
    0          
105 0 0         if ($orderKeys) {
106 0           foreach my $k (sort keys %$value) {
107 0           _visit($k, $value->{$k}, $nodes, $block, $orderKeys);
108             }
109             }
110             else {
111 0           while (my ($k,$v) = each %{$value}) {
  0            
112 0           _visit($k, $v, $nodes, $block, $orderKeys);
113             }
114             }
115             }
116             elsif (UNIVERSAL::isa($value, "ARRAY")) {
117 0           for (my $i=0; $i<=$#{$value}; $i++) {
  0            
118 0           _visit($i, $value->[$i], $nodes, $block, $orderKeys);
119             }
120             }
121 0           pop(@$nodes);
122             }
123              
124             sub toString {
125             # Assume static call if 1st arg is not this class
126 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
127 0           my $self = shift;
128 0           my $message = "<<" . ref($self) . ">>";
129             visit($self, sub {
130 0     0     my ($key, $value, $nodes) = @_;
131 0 0         if (!defined($key)) {
132 0           return;
133             }
134 0 0 0       if (!UNIVERSAL::isa($value, "ARRAY") && !UNIVERSAL::isa($value, "HASH")) {
135 0           $message .= "\n" . (" " x ($#{$nodes}*2)) . "[$key]" . " " . $value;
  0            
136             }
137             else {
138 0           $message .= "\n" . (" " x ($#{$nodes}*2)) . "[$key]";
  0            
139             }
140 0           }, 1);
141 0           return $message;
142             }
143              
144             sub getFirst {
145             # Assume static call if 1st arg is not this class
146 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
147 0           my $self = shift;
148 0           my $result = get($self, @_);
149 0 0         if (UNIVERSAL::isa($result, "ARRAY")) {
150 0 0         return ($#{$result} >= 0) ? $result->[0] : undef;
  0            
151             }
152             else {
153 0           return $result;
154             }
155             }
156              
157             sub get {
158             # Assume static call if 1st arg is not this class
159 0 0 0 0 0   shift if ($#_ >= 0 and $_[0] eq "Net::Amazon::MechanicalTurk::DataStructure");
160 0           my $self = shift;
161              
162 0           my @matches;
163 0 0         if ($#_ == 0) {
164 0 0         if (UNIVERSAL::isa($_[0], "ARRAY")) {
165 0           @matches = @$_[0];
166             }
167             else {
168 0           @matches = split /\./, $_[0];
169             }
170             }
171             else {
172 0           @matches = @_;
173             }
174              
175 0           my $node = $self;
176 0           my $i = 0;
177 0           while ($i <= $#matches) {
178 0           my $match = $matches[$i];
179 0 0         if (UNIVERSAL::isa($node, "ARRAY")) {
    0          
180             # numeric indices are 1 based
181 0 0         if ($match =~ /^\d+$/) {
  0 0          
182 0 0 0       if ($match < 1 or $match > ($#{$node}+1)) {
  0            
183 0           return undef;
184             }
185 0           $node = $node->[$match-1];
186 0           $i++;
187             }
188             elsif ($#{$node} >= 0) {
189 0           $node = $node->[0];
190             }
191             else {
192 0           return undef;
193             }
194             }
195             elsif (UNIVERSAL::isa($node, "HASH")) {
196 0 0         if (!exists $node->{$match}) {
197 0 0 0       if ($match =~ /^\d+$/ and $match == 1) {
198             # handle case where data structure has
199             # a hash containing a hash
200             # but get supplied an index of 1
201             # family.1.kid.1
202             # { family => { kid => ['k1', 'k2' ] }
203             # allows get to read properties produced
204             # by toProperties
205 0           $i++;
206             }
207             else {
208 0           return undef;
209             }
210             }
211             else {
212 0           $node = $node->{$match};
213 0           $i++;
214             }
215             }
216             else {
217 0           return undef;
218             }
219             }
220              
221 0           return $node;
222             }
223              
224             return 1;