File Coverage

blib/lib/PYX/XMLSchema/List.pm
Criterion Covered Total %
statement 82 85 96.4
branch 22 22 100.0
condition n/a
subroutine 18 19 94.7
pod 6 6 100.0
total 128 132 96.9


line stmt bran cond sub pod time code
1             package PYX::XMLSchema::List;
2              
3             # Pragmas.
4 8     8   229261 use strict;
  8         16  
  8         209  
5 8     8   40 use warnings;
  8         15  
  8         242  
6              
7             # Modules.
8 8     8   2288 use Class::Utils qw(set_params);
  8         74369  
  8         289  
9 8     8   233 use Error::Pure qw(err);
  8         11  
  8         348  
10 8     8   41 use List::Util qw(reduce);
  8         43  
  8         745  
11 8     8   6378 use PYX::Parser;
  8         10570  
  8         220  
12 8     8   49 use Readonly;
  8         14  
  8         8355  
13              
14             # Constants.
15             Readonly::Scalar our $EMPTY_STR => q{};
16             Readonly::Scalar our $SPACE => q{ };
17              
18             # Version.
19             our $VERSION = 0.02;
20              
21             # Constructor.
22             sub new {
23 7     7 1 5969 my ($class, @params) = @_;
24 7         20 my $self = bless {}, $class;
25              
26             # Output handler.
27 7         34 $self->{'output_handler'} = \*STDOUT;
28              
29             # Process params.
30 7         32 set_params($self, @params);
31              
32             # PYX::Parser object.
33             $self->{'_pyx_parser'} = PYX::Parser->new(
34             'callbacks' => {
35             'attribute' => \&_call_attribute,
36             'final' => \&_call_final,
37             'start_element' => \&_call_start_element,
38             },
39             'non_parser_options' => {
40             'schemas' => {},
41             },
42 5         85 'output_handler' => $self->{'output_handler'},
43             );
44              
45             # Object.
46 5         266 return $self;
47             }
48              
49             # Parse pyx text or array of pyx text.
50             sub parse {
51 0     0 1 0 my ($self, $pyx, $out) = @_;
52 0         0 $self->{'_pyx_parser'}->parse($pyx, $out);
53 0         0 return;
54             }
55              
56             # Parse file with pyx text.
57             sub parse_file {
58 3     3 1 3028 my ($self, $file, $out) = @_;
59 3         12 $self->{'_pyx_parser'}->parse_file($file, $out);
60 3         40 return;
61             }
62              
63             # Parse from handler.
64             sub parse_handler {
65 5     5 1 5845 my ($self, $input_file_handler, $out) = @_;
66 5         28 $self->{'_pyx_parser'}->parse_handler($input_file_handler, $out);
67 5         18 return;
68             }
69              
70             # Reset parser.
71             sub reset {
72 6     6 1 5633 my $self = shift;
73 6         17 $self->{'_pyx_parser'}->{'non_parser_options'}->{'schemas'} = {};
74 6         205 return;
75             }
76              
77             # Gets statistics structure.
78             sub stats {
79 2     2 1 1132 my $self = shift;
80             my $schemas_hr = $self->{'_pyx_parser'}->{'non_parser_options'}
81 2         6 ->{'schemas'};
82 2         5 return $schemas_hr;
83             }
84              
85             # Attribute callback.
86             sub _call_attribute {
87 28     28   700 my ($pyx_parser_obj, $key, $val) = @_;
88 28         52 my $schemas_hr = $pyx_parser_obj->{'non_parser_options'}->{'schemas'};
89 28 100       52 if (my ($first, $sec) = _parse_schema($key)) {
90              
91             # Get URL for XML schema.
92 22 100       84 if ($first eq 'xmlns') {
93 10         16 my $schema = $sec;
94 10 100       37 if (! exists $schemas_hr->{$schema}) {
95 8         23 _init_struct($schemas_hr, $schema, $val);
96             } else {
97 2         5 $schemas_hr->{$schema}->[0] = $val;
98             }
99              
100             # Add attribute to XML schema statistics.
101             } else {
102 12         19 my $schema = $first;
103 12         30 _init_struct($schemas_hr, $schema);
104 12         21 $schemas_hr->{$schema}->[1]->{'attr'}++;
105             }
106             }
107 28         79 return;
108             }
109              
110             # Finalize callback.
111             sub _call_final {
112 8     8   304 my $pyx_parser_obj = shift;
113 8         18 my $schemas_hr = $pyx_parser_obj->{'non_parser_options'}->{'schemas'};
114 8         13 my $out = $pyx_parser_obj->{'output_handler'};
115 8 100   8   29 my $max_len = length reduce { length($a) > length($b) ? $a : $b }
116 8         52 keys %{$schemas_hr};
  8         87  
117 8         33 foreach my $key (sort keys %{$schemas_hr}) {
  8         39  
118 14         412 printf {$out} "[ %-${max_len}s ] (E: %04d, A: %04d)%s\n", $key,
119             $schemas_hr->{$key}->[1]->{'element'},
120             $schemas_hr->{$key}->[1]->{'attr'},
121             $schemas_hr->{$key}->[0] ne $EMPTY_STR
122 14 100       23 ? $SPACE.$schemas_hr->{$key}->[0]
123             : $EMPTY_STR;
124             }
125 8 100       17 if (! keys %{$schemas_hr}) {
  8         28  
126 2         8 print {$out} "No XML schemas.\n";
  2         105  
127             }
128 8         26 return;
129             }
130              
131             # Start of element callback.
132             sub _call_start_element {
133 12     12   610 my ($pyx_parser_obj, $elem) = @_;
134 12         26 my $schemas_hr = $pyx_parser_obj->{'non_parser_options'}->{'schemas'};
135 12 100       31 if (defined(my $schema = _parse_schema($elem))) {
136 6         51 _init_struct($schemas_hr, $schema);
137 6         10 $schemas_hr->{$schema}->[1]->{'element'}++;
138             }
139 12         32 return;
140             }
141              
142             # Initialize XML schema structure.
143             sub _init_struct {
144 26     26   45 my ($schemas_hr, $schema, $uri) = @_;
145 26 100       70 if (! defined $uri) {
146 18         32 $uri = $EMPTY_STR;
147             }
148 26 100       66 if (! exists $schemas_hr->{$schema}) {
149 14         66 $schemas_hr->{$schema} = [$uri, {
150             'attr' => 0,
151             'element' => 0,
152             }];
153             }
154 26         45 return;
155             }
156              
157             # Parse XML schema from string.
158             sub _parse_schema {
159 40     40   58 my $string = shift;
160 40 100       154 if ($string =~ m/^(.+?):(.+)$/ms) {
161 28 100       160 return wantarray ? ($1, $2) : $1;
162             }
163 12         47 return;
164             }
165              
166             1;
167              
168             __END__