File Coverage

blib/lib/SOAP/WSDL/XSD/Schema.pm
Criterion Covered Total %
statement 22 27 81.4
branch 2 4 50.0
condition n/a
subroutine 7 8 87.5
pod 0 3 0.0
total 31 42 73.8


line stmt bran cond sub pod time code
1             package SOAP::WSDL::XSD::Schema;
2 2     2   778 use strict;
  2         3  
  2         65  
3 2     2   9 use warnings;
  2         2  
  2         50  
4 2     2   7 use Class::Std::Fast::Storable;
  2         2  
  2         12  
5 2     2   180 use base qw(SOAP::WSDL::Base);
  2         3  
  2         335  
6              
7             our $VERSION = 3.003;
8              
9             # child elements
10             my %attributeGroup_of :ATTR(:name :default<[]>);
11             my %attribute_of :ATTR(:name :default<[]>);
12             my %element_of :ATTR(:name :default<[]>);
13             my %group_of :ATTR(:name :default<[]>);
14             my %type_of :ATTR(:name :default<[]>);
15              
16             # attributes
17             my %attributeFormDefault_of :ATTR(:name :default);
18             my %blockDefault_of :ATTR(:name :default<()>);
19             my %elementFormDefault_of :ATTR(:name :default);
20             my %finalDefault_of :ATTR(:name :default<()>);
21             my %version_of :ATTR(:name :default<()>);
22              
23             # id
24             # name
25             # targetNamespace inherited from Base
26             # xmlns
27              
28             #
29             # attributeFormDefault = (qualified | unqualified) : unqualified
30             # blockDefault = (#all | List of (extension | restriction | substitution)) : ''
31             # elementFormDefault = (qualified | unqualified) : unqualified
32             # finalDefault = (#all | List of (extension | restriction | list | union)) : ''
33             # id = ID
34             # targetNamespace = anyURI
35             # version = token
36             # xml:lang = language
37             #
38             #
39             # alias type with all variants
40             # AUTOMETHOD is WAY too slow..
41             {
42 2     2   8 no strict qw/refs/;
  2         1  
  2         441  
43             for my $name (qw(simpleType complexType) ) {
44             *{ "set_$name" } = \&set_type;
45             *{ "get_$name" } = \&get_type;
46             *{ "push_$name" } = \&push_type;
47             *{ "find_$name" } = \&find_type;
48             }
49             }
50              
51             sub push_type {
52             # use $_[n] for performance -
53             # we're called on each and every type inside WSDL
54 44     44 0 201 push @{ $type_of{ ident $_[0]} }, $_[1];
  44         66  
55             }
56              
57             sub find_element {
58 5     5 0 488 my ($self, @args) = @_;
59 9 100       42 my @found_at = grep {
60 5         9 $_->get_targetNamespace() eq $args[0] &&
61             # warn $_->get_name() . " default NS:" . $_->get_xmlns()->{'#default'} . "\n";
62             # $_->get_xmlns()->{'#default'} eq $args[0] &&
63             $_->get_name() eq $args[1]
64             }
65 5         2 @{ $element_of{ ident $self } };
66 5         28 return $found_at[0];
67             }
68              
69             sub find_type {
70 0     0 0   my ($self, @args) = @_;
71 0 0         my @found_at = grep {
72 0           $_->get_targetNamespace() eq $args[0] &&
73             # $_->get_xmlns()->{'#default'} eq $args[0] &&
74             $_->get_name() eq $args[1]
75             }
76 0           @{ $type_of{ ident $self } };
77 0           return $found_at[0];
78             }
79              
80             1;