File Coverage

blib/lib/Pg/Explain/FromXML.pm
Criterion Covered Total %
statement 93 97 95.8
branch 37 44 84.0
condition 5 6 83.3
subroutine 16 16 100.0
pod 2 2 100.0
total 153 165 92.7


line stmt bran cond sub pod time code
1             package Pg::Explain::FromXML;
2              
3             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
4 73     73   943 use v5.18;
  73         329  
5 73     73   419 use strict;
  73         170  
  73         1601  
6 73     73   387 use warnings;
  73         175  
  73         3148  
7 73     73   454 use warnings qw( FATAL utf8 );
  73         166  
  73         2610  
8 73     73   461 use utf8;
  73         176  
  73         536  
9 73     73   2762 use open qw( :std :utf8 );
  73         207  
  73         496  
10 73     73   10182 use Unicode::Normalize qw( NFC );
  73         242  
  73         4499  
11 73     73   561 use Unicode::Collate;
  73         196  
  73         2721  
12 73     73   475 use Encode qw( decode );
  73         207  
  73         4658  
13              
14             if ( grep /\P{ASCII}/ => @ARGV ) {
15             @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV;
16             }
17              
18             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
19              
20 73     73   16120 use base qw( Pg::Explain::From );
  73         189  
  73         8304  
21 73     73   62587 use XML::Simple;
  73         693745  
  73         547  
22 73     73   6602 use Carp;
  73         186  
  73         3792  
23 73     73   480 use Pg::Explain::JIT;
  73         181  
  73         1561  
24 73     73   413 use Pg::Explain::Buffers;
  73         170  
  73         70454  
25              
26             =head1 NAME
27              
28             Pg::Explain::FromXML - Parser for explains in XML format
29              
30             =head1 VERSION
31              
32             Version 2.3
33              
34             =cut
35              
36             our $VERSION = '2.3';
37              
38             =head1 SYNOPSIS
39              
40             It's internal class to wrap some work. It should be used by Pg::Explain, and not directly.
41              
42             =head1 FUNCTIONS
43              
44             =head2 normalize_node_struct
45              
46             XML structure is different than JSON/YAML (after parsing), so we need to normalize it.
47             =cut
48              
49             sub normalize_node_struct {
50 177     177 1 324 my $self = shift;
51 177         305 my $struct = shift;
52              
53 177         427 my @keys = keys %{ $struct };
  177         1042  
54 177         445 for my $key ( @keys ) {
55 2661         3880 my $new_key = $key;
56 2661         4052 $new_key =~ s{^I-O-(Read|Write)-Time$}{I/O $1 Time};
57 2661         6341 $new_key =~ s/-/ /g;
58 2661 100       9575 $struct->{ $new_key } = delete $struct->{ $key } if $key ne $new_key;
59             }
60              
61 177         422 my $subplans = [];
62 177 50 66     819 if ( ( $struct->{ 'Plans' } )
63             && ( $struct->{ 'Plans' }->{ 'Plan' } ) )
64             {
65 68 100       296 if ( 'HASH' eq ref $struct->{ 'Plans' }->{ 'Plan' } ) {
66 31         67 push @{ $subplans }, $struct->{ 'Plans' }->{ 'Plan' };
  31         114  
67             }
68             else {
69 37         96 $subplans = $struct->{ 'Plans' }->{ 'Plan' };
70             }
71             }
72 177         464 $struct->{ 'Plans' } = $subplans;
73              
74 177 100       523 if ( $struct->{ 'Group Key' } ) {
75 3         7 my $items = $struct->{ 'Group Key' }->{ 'Item' };
76 3 100       9 if ( 'ARRAY' eq ref $items ) {
77 1         108 $struct->{ 'Group Key' } = $items;
78             }
79             else {
80 2         5 $struct->{ 'Group Key' } = [ $items ];
81             }
82             }
83              
84 177 100       447 if ( $struct->{ 'Conflict Arbiter Indexes' } ) {
85 1         5 $struct->{ 'Conflict Arbiter Indexes' } = [ $struct->{ 'Conflict Arbiter Indexes' }->{ 'Item' } ];
86             }
87 177         625 return $struct;
88             }
89              
90             =head2 parse_source
91              
92             Function which parses actual plan, and constructs Pg::Explain::Node objects
93             which represent it.
94              
95             Returns Top node of query plan.
96              
97             =cut
98              
99             sub parse_source {
100 67     67 1 172 my $self = shift;
101 67         179 my $source = shift;
102              
103 67 50       1818 unless ( $source =~ s{\A .*? ^ \s* () \s* $}{$1}xms ) {
104 0         0 carp( 'Source does not match first s///' );
105 0         0 return;
106             }
107 67 50       6621 unless ( $source =~ s{^ \s* \s* $ .* \z}{}xms ) {
108 0         0 carp( 'Source does not match second s///' );
109 0         0 return;
110             }
111              
112 67         433 my $struct = XMLin( $source );
113              
114             # Need this to work around a bit different format from auto-explain module
115 67 100       3549931 $struct = $struct->{ 'Query' } if defined $struct->{ 'Query' };
116              
117 67         744 my $top_node = $self->make_node_from( $struct->{ 'Plan' } );
118              
119 67 100       400 if ( $struct->{ 'Planning' } ) {
    100          
120 4         21 $self->explain->planning_time( $struct->{ 'Planning' }->{ 'Planning-Time' } );
121 4         21 my $buffers = Pg::Explain::Buffers->new( $self->normalize_node_struct( $struct->{ 'Planning' } ) );
122 4 100       16 $self->explain->planning_buffers( $buffers ) if $buffers;
123             }
124             elsif ( $struct->{ 'Planning-Time' } ) {
125 48         183 $self->explain->planning_time( $struct->{ 'Planning-Time' } );
126             }
127 67 100       397 $self->explain->execution_time( $struct->{ 'Execution-Time' } ) if $struct->{ 'Execution-Time' };
128 67 100       257 $self->explain->total_runtime( $struct->{ 'Total-Runtime' } ) if $struct->{ 'Total-Runtime' };
129 67 100       235 if ( $struct->{ 'Triggers' } ) {
130 59         128 for my $t ( @{ $struct->{ 'Triggers' }->{ 'Trigger' } } ) {
  59         310  
131 2         4 my $ts = {};
132 2 50       9 $ts->{ 'calls' } = $t->{ 'Calls' } if defined $t->{ 'Calls' };
133 2 50       8 $ts->{ 'time' } = $t->{ 'Time' } if defined $t->{ 'Time' };
134 2 50       7 $ts->{ 'relation' } = $t->{ 'Relation' } if defined $t->{ 'Relation' };
135 2 50       6 $ts->{ 'name' } = $t->{ 'Trigger-Name' } if defined $t->{ 'Trigger-Name' };
136 2         6 $self->explain->add_trigger_time( $ts );
137             }
138             }
139 67 100       259 $self->explain->jit( Pg::Explain::JIT->new( 'struct' => $struct->{ 'JIT' } ) ) if $struct->{ 'JIT' };
140              
141 67 100       256 $self->explain->query( $struct->{ 'Query-Text' } ) if $struct->{ 'Query-Text' };
142              
143 67 100 100     337 $self->explain->settings( $struct->{ 'Settings' } ) if ( $struct->{ 'Settings' } ) && ( 0 < scalar keys %{ $struct->{ 'Settings' } } );
  3         18  
144              
145 67         838 return $top_node;
146             }
147              
148             =head1 AUTHOR
149              
150             hubert depesz lubaczewski, C<< >>
151              
152             =head1 BUGS
153              
154             Please report any bugs or feature requests to C.
155              
156             =head1 SUPPORT
157              
158             You can find documentation for this module with the perldoc command.
159              
160             perldoc Pg::Explain
161              
162             =head1 COPYRIGHT & LICENSE
163              
164             Copyright 2008-2021 hubert depesz lubaczewski, all rights reserved.
165              
166             This program is free software; you can redistribute it and/or modify it
167             under the same terms as Perl itself.
168              
169             =cut
170              
171             1; # End of Pg::Explain::FromXML