File Coverage

blib/lib/Google/Ads/SOAP/Typelib/ComplexType.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             # Copyright 2012, Google Inc. All Rights Reserved.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14             #
15             # Custom complex type object with patched logic to properly:
16             # - Serialize/Deserialize objects with xsi:type
17             # - Properly include namespaces when attributes are inherited from different
18             # namespaces.
19             # - Include built-in XPath search capabilities.
20             # - Add the ability to transform from and to hashes.
21             # This module is based on SOAP::WSDL::XSD::Typelib::ComplexType, with some
22             # overriden methods via inheritance.
23              
24             package Google::Ads::SOAP::Typelib::ComplexType;
25              
26 2     2   920 use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
  2         6  
  2         168  
27              
28 2     2   15 no warnings qw(redefine);
  2         6  
  2         119  
29 2     2   14 no strict qw(refs);
  2         6  
  2         80  
30 2     2   13 use version;
  2         6  
  2         18  
31              
32             # Loading patched packages first.
33 2     2   440 use Google::Ads::Common::XPathSAXParser;
  0            
  0            
34              
35             use Carp;
36             use Class::Load;
37             use Data::Dumper;
38             use Scalar::Util qw(blessed);
39             use SOAP::WSDL::Expat::Base;
40             use SOAP::WSDL::Expat::MessageParser;
41             use SOAP::WSDL::XSD::Typelib::ComplexType;
42              
43             # Silencing annoying third-party library warnings.
44             $SIG{__WARN__} = sub {
45             warn @_
46             unless $_[0] =~ /Tie::Hash::FIELDS|Cache::RemovalStrategy|XPath\/
47             Node\/Element|XMLSchemaSOAP1_2::as_dateTime/;
48             };
49              
50             # Patching of the WSDL library to include xsi:type attribute for
51             # elements that inherit other complex elements like ManualCPC.
52             sub serialize_attr {
53             my ($self, $args) = @_;
54             my $result = q{};
55             if ($xml_attr_of{${$_[0]}}) {
56             $result = $xml_attr_of{${$_[0]}}->serialize();
57             }
58              
59             # PATCH to include xsi:type when necessary.
60             if ($args->{xsitype}) {
61             $result = $result . " xsi:type=\"$args->{xsitype}\" ";
62             }
63             # END OF PATCH
64              
65             if ($args->{xsitypens}) {
66             $result = $result . " xmlns:$args->{xsitypens}->{name}=\"" .
67             "$args->{xsitypens}->{value}\" ";
68             }
69              
70             return $result;
71             }
72              
73             # Redefining complex type factory method to allow subclasses to be passed to
74             # attribute setters, so for example a
75             # set_operations(\@{ARRAY_OF_SUBCLASSES_OF_OPERATION}) can be performed.
76             sub _factory {
77             my $class = shift;
78              
79             $ELEMENTS_FROM->{$class} = shift;
80             $ATTRIBUTES_OF->{$class} = shift;
81             $CLASSES_OF->{$class} = shift;
82             $NAMES_OF->{$class} = shift;
83              
84             while (my ($name, $attribute_ref) = each %{$ATTRIBUTES_OF->{$class}}) {
85             my $type = $CLASSES_OF->{$class}->{$name}
86             or croak "No class given for $name";
87             Class::Load::is_class_loaded($type)
88             or eval { Class::Load::load_class $type } or croak $@;
89             my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
90             my $method_name = $name;
91             $method_name =~ s{[\.\-]}{_}xmsg;
92             *{"$class\::set_$method_name"} = sub {
93             if (not $#_) {
94             delete $attribute_ref->{${$_[0]}};
95             return;
96             }
97             my $is_ref = ref $_[1];
98             $attribute_ref->{${$_[0]}} =
99             ($is_ref)
100             ? ($is_ref eq 'ARRAY')
101             ? $is_list
102             ? $type->new({value => $_[1]})
103             : [
104             map {
105             ref $_
106             ? ref $_ eq 'HASH'
107             ?
108             # PATCH Call custom hash to object subroutine
109             # that correctly handles xsi_type.
110             _hash_to_object($type, $_)
111             :
112             # An isa type comparison is needed to check
113             # for the right type.
114             $_->isa($type)
115             ?
116             # END OF PATCH
117             $_
118             : croak "cannot use " .
119             ref($_) . " reference as value for" .
120             " $name - $type required"
121             : $type->new({value => $_})
122             } @{$_[1]}]
123             : $is_ref eq 'HASH' ?
124             # PATCH Call custom hash to object subroutine that correctly
125             # handles xsi_type.
126             do {
127             _hash_to_object($type, $_[1]);
128             }
129             :
130             # END OF PATCH
131             blessed $_[1] && $_[1]->isa($type)
132             ? $_[1]
133             : die croak "cannot use $is_ref reference as value for " .
134             "$name - $type required"
135             : defined $_[1] ? $type->new({value => $_[1]})
136             : ();
137             return;
138             };
139              
140             *{"$class\::add_$method_name"} = sub {
141             warn "attempting to add empty value to " . ref $_[0]
142             if not defined $_[1];
143              
144             if (not exists $attribute_ref->{${$_[0]}}) {
145             $attribute_ref->{${$_[0]}} = $_[1];
146             return;
147             }
148              
149             if (not ref $attribute_ref->{${$_[0]}} eq 'ARRAY') {
150             $attribute_ref->{${$_[0]}} = [$attribute_ref->{${$_[0]}}, $_[1]];
151             return;
152             }
153              
154             push @{$attribute_ref->{${$_[0]}}}, $_[1];
155             return;
156             };
157             }
158              
159             *{"$class\::new"} = sub {
160             my $self = bless \(my $o = Class::Std::Fast::ID()), $_[0];
161              
162             if (exists $_[1]->{xmlattr}) {
163             $self->attr(delete $_[1]->{xmlattr});
164             }
165              
166             # Iterate over keys of arguments and call set appropriate field in class
167             map {
168             ($ATTRIBUTES_OF->{$class}->{$_})
169             ? do {
170             my $method = "set_$_";
171             $method =~ s{[\.\-]}{_}xmsg;
172             $self->$method($_[1]->{$_});
173             }
174             :
175             # PATCH Ignoring xsi_type as a regular attribute of a given HASH since
176             # is treated specially later.
177             $_ =~ m{ \A
178             xmlns|xsi_type
179             }xms
180             ? ()
181             : do {
182             croak "Unknown field $_ in $class.\nValid fields are:\n" .
183             join(', ', @{$ELEMENTS_FROM->{$class}}) . "\n" .
184             "Structure given:\n" . Dumper($_[1]);
185             };
186             # END PATCH
187             } keys %{$_[1]};
188             return $self;
189             };
190              
191             *{"$class\::_serialize"} = sub {
192             my $ident = ${$_[0]};
193             my $option_ref = $_[1];
194              
195             return \join q{}, map {
196             my $element = $ATTRIBUTES_OF->{$class}->{$_}->{$ident};
197              
198             if (defined $element) {
199             $element = [$element] if not ref $element eq 'ARRAY';
200             my $name = $NAMES_OF->{$class}->{$_} || $_;
201             my $target_namespace = $_[0]->get_xmlns();
202             map {
203             if ($_->isa('SOAP::WSDL::XSD::Typelib::Element'))
204             {
205             ($target_namespace ne $_->get_xmlns())
206             ? $_->serialize({name => $name, qualified => 1})
207             : $_->serialize({name => $name});
208             } else {
209             if (!defined $ELEMENT_FORM_QUALIFIED_OF->{$class}
210             or $ELEMENT_FORM_QUALIFIED_OF->{$class})
211             {
212             if (
213             exists $option_ref->{xmlns_stack}
214             && (scalar @{$option_ref->{xmlns_stack}} >= 2)
215             && ($option_ref->{xmlns_stack}->[-1] ne
216             $option_ref->{xmlns_stack}->[-2]))
217             {
218             join q{},
219             $_->start_tag({
220             name => $name,
221             xmlns => $option_ref->{xmlns_stack}->[-1],
222             %{$option_ref}}
223             ),
224             $_->serialize($option_ref),
225             $_->end_tag({name => $name, %{$option_ref}});
226             } else {
227             # PATCH Determine if xsi:type is required.
228             my $refname = ref($_);
229             my $classname = $CLASSES_OF->{$class}->{$name};
230             if ($classname && $classname ne ref($_)) {
231             my $xsitypens = {};
232             if ($option_ref->{xmlns_stack}->[-1] ne $_->get_xmlns()) {
233             $xsitypens->{name} = "xns";
234             $xsitypens->{value} = $_->get_xmlns();
235             $option_ref->{xsitypens} = $xsitypens;
236             }
237             my $package_name = ref($_);
238             $package_name =~ /^.*::(.*)$/;
239             my $xsi_type = $1;
240             $option_ref->{xsitype} =
241             ($xsitypens->{name} ? $xsitypens->{name} . ":" : "") .
242             "$xsi_type";
243             } else {
244             delete $option_ref->{xsitype};
245             }
246              
247             # Checks to see if namespace is required because it is an
248             # inherited attribute on a different namespace.
249             my $class_isa = $class . "::ISA";
250             my @class_parents = @$class_isa;
251             my $requires_namespace = 0;
252             foreach my $parent (@class_parents) {
253             my %parent_elements =
254             map { $_ => 1 } @{$ELEMENTS_FROM->{$parent}};
255             my $parent_has_element = exists($parent_elements{$name});
256              
257             if ($parent_has_element) {
258             my $parent_xns;
259             eval "\$parent_xns = " . $parent . "::get_xmlns()";
260             if ($parent_xns ne $option_ref->{xmlns_stack}->[-1]) {
261             $requires_namespace = 1;
262             }
263             }
264             }
265              
266             if ($requires_namespace) {
267             join q{},
268             $_->start_tag({
269             name => $name,
270             xmlns => $_->get_xmlns(),
271             %{$option_ref}}
272             ),
273             $_->serialize($option_ref),
274             $_->end_tag({name => $name, %{$option_ref}});
275             } else {
276             join q{}, $_->start_tag({name => $name, %{$option_ref}}),
277             $_->serialize($option_ref),
278             $_->end_tag({name => $name, %{$option_ref}});
279             }
280             # END PATCH
281             }
282             } else {
283             my $set_xmlns = delete $option_ref->{xmlns};
284              
285             join q{},
286             $_->start_tag({
287             name => $name,
288             %{$option_ref},
289             (!defined $set_xmlns) ? (xmlns => "") : ()}
290             ),
291             $_->serialize({%{$option_ref}, xmlns => ""}),
292             $_->end_tag({name => $name, %{$option_ref}});
293             }
294             }
295             } @{$element};
296             } else {
297             q{};
298             }
299             } (@{$ELEMENTS_FROM->{$class}});
300             };
301              
302             if (!$class->isa('SOAP::WSDL::XSD::Typelib::AttributeSet')) {
303             *{"$class\::serialize"} =
304             \&SOAP::WSDL::XSD::Typelib::ComplexType::__serialize_complex;
305             }
306             }
307              
308             # Added to support hash to object serialization.
309             # A special xsi_type attribute name has been reserved to specify subtype of
310             # the object been passed when using hashes.
311             # PATCH This entire method was added to the class.
312             sub _hash_to_object {
313             my ($type, $hash) = @_;
314              
315             if ($hash->{"xsi_type"}) {
316             my $base_type = $type;
317             my $xsi_type = $hash->{"xsi_type"};
318             $type = substr($type, 0, rindex($type, "::") + 2) . $xsi_type;
319             eval("require $type");
320             die croak "xsi_type $xsi_type not found" if $@;
321             my $instance = $type->new($hash);
322             die croak "xsi_type $xsi_type must inherit from " . "$type"
323             if not $instance->isa($base_type);
324             return $instance;
325             } else {
326             return $type->new($hash);
327             }
328             }
329             # END PATCH
330              
331             # Redefining as_hash_ref method to correctly map all object properties to a
332             # hash structure.
333             sub as_hash_ref {
334             my $self = $_[0];
335             my $attributes_ref = $self->__get_object_attributes($self);
336              
337             my $hash_of_ref = {};
338             if ($_[0]->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')) {
339             $hash_of_ref->{value} = $_[0]->get_value();
340             } else {
341             foreach my $attribute (keys %{$attributes_ref}) {
342             next if not defined $attributes_ref->{$attribute}->{${$_[0]}};
343             my $value = $attributes_ref->{$attribute}->{${$_[0]}};
344             # PATCH normalizing the attribute name
345             $attribute =~ s/__/./g;
346             # END PATCH
347             $hash_of_ref->{$attribute} =
348             blessed $value
349             ? $value->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
350             ? $value->get_value()
351             # PATCH returning the value no need to recurse
352             : $value
353             # END PATCH
354             : ref $value eq 'ARRAY' ? [
355             map {
356             $_->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
357             ? $_->get_value()
358             # PATCH returning the object no need to recurse
359             : $_
360             # END PATCH
361             } @{$value}]
362             : die "Neither blessed obj nor list ref";
363             }
364             }
365              
366             no warnings "once";
367             return $hash_of_ref if $_[1] or $AS_HASH_REF_WITHOUT_ATTRIBUTES;
368              
369             if (exists $xml_attr_of{${$_[0]}}) {
370             $hash_of_ref->{xmlattr} = $xml_attr_of{${$_[0]}}->as_hash_ref();
371             }
372              
373             return $hash_of_ref;
374             }
375              
376             # PATCH To retrieve object attributes mapping including inherited.
377             sub __get_object_attributes {
378             my $self = shift;
379             my $object = shift;
380             my @types = (ref $object);
381             my %attributes;
382              
383             while (my $type = pop(@types)) {
384             eval("require $type");
385             my $type_bases_name = $type . "::ISA";
386             push @types, @$type_bases_name;
387             my $attributes_ref = $ATTRIBUTES_OF->{$type};
388             for my $key (keys %$attributes_ref) {
389             my $value = $attributes_ref->{$key};
390             if (not exists $attributes{$key}) {
391             $attributes{$key} = $value;
392             }
393             }
394             }
395             return \%attributes;
396             }
397             # END PATCH
398              
399             # PATCH To retrieve attributes xml names including inherited.
400             sub __get_object_names {
401             my $object = $_[1];
402             my @types = (ref $object);
403             my %names;
404              
405             while (my $type = pop(@types)) {
406             eval("require $type");
407             my $type_bases_name = $type . "::ISA";
408             push @types, @$type_bases_name;
409             my $names_ref = $NAMES_OF{$type};
410             for my $key (keys %$names_ref) {
411             my $value = $names_ref->{$key};
412             if (not exists $names{$key}) {
413             $names{$key} = $value;
414             }
415             }
416             }
417             return \%names;
418             }
419             # END PATCH
420              
421             # PATCH Method for the client to find objects in the tree based on an a partial
422             # support of XPath expressions.
423             sub find {
424             my ($self, $xpath_expr) = @_;
425              
426             my $parser_node =
427             Google::Ads::Common::XPathSAXParser::get_node_from_object($self);
428              
429             my @return_list = ();
430             if (defined $parser_node) {
431             my $node_set = $parser_node->find($xpath_expr);
432             foreach my $node ($node_set->get_nodelist()) {
433             my $soap_object =
434             Google::Ads::Common::XPathSAXParser::get_object_from_node($node);
435             if (defined $soap_object) {
436             push @return_list, $soap_object;
437             }
438             }
439             }
440              
441             return \@return_list;
442             }
443             # END PATCH
444              
445             # PATCH Setting an alias of find -> valueof for backwards compatibility with
446             # the old version of the client library.
447             no warnings "once";
448             *Google::Ads::SOAP::ComplexType::valueof =
449             \&Google::Ads::SOAP::ComplexType::find;
450             # END PATCH
451              
452             # PATCH Overloading hash casting routine for ComplexType, so all complex types
453             # can behave as hashes.
454             use overload (
455             '%{}' => 'as_hash_ref',
456             fallback => 1,
457             );
458             # END PATCH