File Coverage

blib/lib/PYX/XMLSchema/List.pm
Criterion Covered Total %
statement 86 86 100.0
branch 24 24 100.0
condition n/a
subroutine 19 19 100.0
pod 6 6 100.0
total 135 135 100.0


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