File Coverage

blib/lib/Pg/Explain/Analyzer.pm
Criterion Covered Total %
statement 68 68 100.0
branch 14 14 100.0
condition n/a
subroutine 15 15 100.0
pod 4 4 100.0
total 101 101 100.0


line stmt bran cond sub pod time code
1             package Pg::Explain::Analyzer;
2              
3             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
4 2     2   1696 use v5.18;
  2         8  
5 2     2   11 use strict;
  2         4  
  2         51  
6 2     2   10 use warnings;
  2         4  
  2         60  
7 2     2   9 use warnings qw( FATAL utf8 );
  2         5  
  2         73  
8 2     2   10 use utf8;
  2         5  
  2         122  
9 2     2   62 use open qw( :std :utf8 );
  2         43  
  2         14  
10 2     2   314 use Unicode::Normalize qw( NFC );
  2         4  
  2         110  
11 2     2   12 use Unicode::Collate;
  2         6  
  2         49  
12 2     2   9 use Encode qw( decode );
  2         3  
  2         123  
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 2     2   457 use autodie;
  2         7  
  2         16  
21 2     2   10993 use Carp;
  2         5  
  2         1356  
22              
23             =head1 NAME
24              
25             Pg::Explain::Analyzer - Some helper methods to analyze explains
26              
27             =head1 VERSION
28              
29             Version 2.3
30              
31             =cut
32              
33             our $VERSION = '2.3';
34              
35             =head1 SYNOPSIS
36              
37             This is to be used in analysis/statistical tools. Sample usage:
38              
39             use Pg::Explain;
40             use Pg::Explain::Analyzer;
41             use Data::Dumper;
42              
43             my $explain = Pg::Explain->new('source_file' => 'some_file.out');
44             my $analyzer = Pg::Explain::Analyzer->new( $explain );
45              
46             print Dumper($analyzer->all_node_types);
47              
48             =head1 FUNCTIONS
49              
50             =head2 new
51              
52             Object constructor.
53              
54             Takes one argument - Pg::Explain object.
55              
56             =cut
57              
58             sub new {
59 11     11 1 5973 my $class = shift;
60 11         24 my $self = bless {}, $class;
61 11 100       57 croak( 'You have to provide explain object.' ) if 0 == scalar @_;
62 10 100       39 croak( 'Too many arguments to Pg::Explain::Analyzer->new().' ) if 1 < scalar @_;
63 9         25 $self->explain( shift );
64 9 100       17 croak( 'Given explain is not an object.' ) unless ref( $self->explain );
65 8 100       18 croak( 'Given explain is not Pg::Explain.' ) unless $self->explain->isa( 'Pg::Explain' );
66 7         22 return $self;
67             }
68              
69             =head2 explain
70              
71             Getter/setter of explain object.
72              
73             =cut
74              
75             sub explain {
76 38     38 1 59 my $self = shift;
77 38 100       87 $self->{ 'explain' } = $_[ 0 ] if 0 < scalar @_;
78 38         135 return $self->{ 'explain' };
79             }
80              
81             =head2 all_node_types
82              
83             Returns list (arrayref) with names of all nodes in analyzed explain.
84              
85             =cut
86              
87             sub all_node_types {
88 6     6 1 4059 my $self = shift;
89 6         14 my %seen = ();
90 6         12 my @return = ();
91 6         18 my @nodes = ( $self->explain->top_node );
92 6         16 while ( my $node = shift @nodes ) {
93 27         55 my $type = $node->type;
94 27 100       87 push @return, $type unless $seen{ $type }++;
95 27         62 push @nodes, $node->all_subnodes;
96             }
97 6         40 return \@return;
98             }
99              
100             =head2 all_node_paths
101              
102             Returns list (arrayref) where each element is array of node types from top level to "current".
103              
104             Elements in final arrays are node types.
105              
106             =cut
107              
108             sub all_node_paths {
109 6     6 1 18440 my $self = shift;
110 6         16 my %seen = ();
111 6         12 my @return = ();
112 6         18 my @nodes = ( [ [], $self->explain->top_node ] );
113 6         19 while ( my $data = shift @nodes ) {
114 27         40 my ( $prefix, $node ) = @{ $data };
  27         44  
115 27         62 my $node_type = $node->type;
116 27         41 my $current_path = [ @{ $prefix }, $node_type ];
  27         51  
117 27         41 my $current_path_str = join ' :: ', @{ $current_path };
  27         54  
118 27 100       96 push @return, $current_path unless $seen{ $current_path_str }++;
119 27         61 push @nodes, map { [ $current_path, $_ ] } $node->all_subnodes;
  21         64  
120             }
121 6         32 return \@return;
122             }
123              
124             =head1 AUTHOR
125              
126             hubert depesz lubaczewski, C<< >>
127              
128             =head1 BUGS
129              
130             Please report any bugs or feature requests to C.
131              
132             =head1 SUPPORT
133              
134             You can find documentation for this module with the perldoc command.
135              
136             perldoc Pg::Explain
137              
138             =head1 COPYRIGHT & LICENSE
139              
140             Copyright 2008-2021 hubert depesz lubaczewski, all rights reserved.
141              
142             This program is free software; you can redistribute it and/or modify it
143             under the same terms as Perl itself.
144              
145             =cut
146              
147             1; # End of Pg::Explain::Analyzer