File Coverage

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


line stmt bran cond sub pod time code
1             package PYX::XMLSchema::List;
2              
3             # Pragmas.
4 8     8   230744 use strict;
  8         21  
  8         203  
5 8     8   38 use warnings;
  8         16  
  8         275  
6              
7             # Modules.
8 8     8   2274 use Class::Utils qw(set_params);
  8         105620  
  8         286  
9 8     8   231 use Error::Pure qw(err);
  8         15  
  8         381  
10 8     8   42 use List::Util qw(reduce);
  8         14  
  8         753  
11 8     8   6142 use PYX::Parser;
  8         10134  
  8         235  
12 8     8   63 use Readonly;
  8         17  
  8         8208  
13              
14             # Constants.
15             Readonly::Scalar our $EMPTY_STR => q{};
16             Readonly::Scalar our $SPACE => q{ };
17              
18             # Version.
19             our $VERSION = 0.03;
20              
21             # Constructor.
22             sub new {
23 8     8 1 5467 my ($class, @params) = @_;
24 8         21 my $self = bless {}, $class;
25              
26             # Output handler.
27 8         45 $self->{'output_handler'} = \*STDOUT;
28              
29             # Process params.
30 8         34 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 6         99 'output_handler' => $self->{'output_handler'},
43             );
44              
45             # Object.
46 6         302 return $self;
47             }
48              
49             # Parse pyx text or array of pyx text.
50             sub parse {
51 3     3 1 3546 my ($self, $pyx, $out) = @_;
52 3         14 $self->{'_pyx_parser'}->parse($pyx, $out);
53 3         16 return;
54             }
55              
56             # Parse file with pyx text.
57             sub parse_file {
58 3     3 1 1194584 my ($self, $file, $out) = @_;
59 3         21 $self->{'_pyx_parser'}->parse_file($file, $out);
60 3         74 return;
61             }
62              
63             # Parse from handler.
64             sub parse_handler {
65 5     5 1 5297 my ($self, $input_file_handler, $out) = @_;
66 5         26 $self->{'_pyx_parser'}->parse_handler($input_file_handler, $out);
67 5         19 return;
68             }
69              
70             # Reset parser.
71             sub reset {
72 8     8 1 8607 my $self = shift;
73 8         28 $self->{'_pyx_parser'}->{'non_parser_options'}->{'schemas'} = {};
74 8         323 return;
75             }
76              
77             # Gets statistics structure.
78             sub stats {
79 2     2 1 906 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 37     37   1117 my ($pyx_parser_obj, $key, $val) = @_;
88 37         81 my $schemas_hr = $pyx_parser_obj->{'non_parser_options'}->{'schemas'};
89 37 100       83 if (my ($first, $sec) = _parse_schema($key)) {
90              
91             # Get URL for XML schema.
92 28 100       134 if ($first eq 'xmlns') {
93 13         27 my $schema = $sec;
94 13 100       43 if (! exists $schemas_hr->{$schema}) {
95 10         27 _init_struct($schemas_hr, $schema, $val);
96             } else {
97 3         11 $schemas_hr->{$schema}->[0] = $val;
98             }
99              
100             # Add attribute to XML schema statistics.
101             } else {
102 15         27 my $schema = $first;
103 15         47 _init_struct($schemas_hr, $schema);
104 15         33 $schemas_hr->{$schema}->[1]->{'attr'}++;
105             }
106             }
107 37         118 return;
108             }
109              
110             # Finalize callback.
111             sub _call_final {
112 11     11   508 my $pyx_parser_obj = shift;
113 11         26 my $schemas_hr = $pyx_parser_obj->{'non_parser_options'}->{'schemas'};
114 11         22 my $out = $pyx_parser_obj->{'output_handler'};
115 10 100   10   39 my $max_len = length reduce { length($a) > length($b) ? $a : $b }
116 11         79 keys %{$schemas_hr};
  11         133  
117 11         58 foreach my $key (sort keys %{$schemas_hr}) {
  11         61  
118 18         663 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 18 100       34 ? $SPACE.$schemas_hr->{$key}->[0]
123             : $EMPTY_STR;
124             }
125 11 100       24 if (! keys %{$schemas_hr}) {
  11         49  
126 3         8 print {$out} "No XML schemas.\n";
  3         374  
127             }
128 11         43 return;
129             }
130              
131             # Start of element callback.
132             sub _call_start_element {
133 16     16   999 my ($pyx_parser_obj, $elem) = @_;
134 16         43 my $schemas_hr = $pyx_parser_obj->{'non_parser_options'}->{'schemas'};
135 16 100       49 if (defined(my $schema = _parse_schema($elem))) {
136 8         52 _init_struct($schemas_hr, $schema);
137 8         18 $schemas_hr->{$schema}->[1]->{'element'}++;
138             }
139 16         48 return;
140             }
141              
142             # Initialize XML schema structure.
143             sub _init_struct {
144 33     33   63 my ($schemas_hr, $schema, $uri) = @_;
145 33 100       101 if (! defined $uri) {
146 23         41 $uri = $EMPTY_STR;
147             }
148 33 100       91 if (! exists $schemas_hr->{$schema}) {
149 18         90 $schemas_hr->{$schema} = [$uri, {
150             'attr' => 0,
151             'element' => 0,
152             }];
153             }
154 33         69 return;
155             }
156              
157             # Parse XML schema from string.
158             sub _parse_schema {
159 53     53   91 my $string = shift;
160 53 100       237 if ($string =~ m/^(.+?):(.+)$/ms) {
161 36 100       272 return wantarray ? ($1, $2) : $1;
162             }
163 17         84 return;
164             }
165              
166             1;
167              
168             __END__