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