File Coverage

blib/lib/Pg/Explain/JIT.pm

Criterion	Covered	Total	%
statement	111	111	100.0
branch	32	38	84.2
condition			n/a
subroutine	19	19	100.0
pod	7	7	100.0
total	169	175	96.5

package Pg::Explain::JIT;

# UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
use v5.18;
use strict;
use warnings;
use warnings qw( FATAL utf8 );
use utf8;
use open qw( :std :utf8 );
use Unicode::Normalize qw( NFC );
use Unicode::Collate;
use Encode qw( decode );

if ( grep /\P{ASCII}/ => @ARGV ) {
    @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV;
}

# UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/

use Carp;

=head1 NAME

Pg::Explain::JIT - Stores information about JIT from PostgreSQL's explain analyze.

=head1 VERSION

Version 2.9

=cut

our $VERSION = '2.9';

=head1 SYNOPSIS

This module provides wrapper around various information about JIT that can be parsed from plans returned by explain analyze in PostgreSQL.

Object of this class is created by Pg::Explain when parsing plan, and is later available as $explain->jit.

=head1 ACCESSORS

=head2 functions( [val] )

Returns/sets number of functions / operators that were JIT compiled.

=head2 options( [val] )

Returns/sets whole hashref of options that were used by JIT compiler.

=head2 option( name, [val] )

Returns/sets value of single option that was used by JIT compiler.

=head2 timings( [val] )

Returns/sets whole hashref of how long it took to process various stages of JIT compiling.

=head2 timing( name, [val] )

Returns/sets time of single stage of JIT compiling.

=cut

sub functions { my $self = shift; $self->{ 'functions' } = $_[ 0 ] if 0 < scalar @_; return $self->{ 'functions' }; }
sub options   { my $self = shift; $self->{ 'options' }   = $_[ 0 ] if 0 < scalar @_; return $self->{ 'options' }; }
sub timings   { my $self = shift; $self->{ 'timings' }   = $_[ 0 ] if 0 < scalar @_; return $self->{ 'timings' }; }

sub option { my $self = shift; my $name = shift; $self->options->{ $name } = $_[ 0 ] if 0 < scalar @_; return $self->options->{ $name }; }
sub timing { my $self = shift; my $name = shift; $self->timings->{ $name } = $_[ 0 ] if 0 < scalar @_; return $self->timings->{ $name }; }

=head1 METHODS

=head2 new

Object constructor. Should get one of:

=over

=item * struct - hashref based on parsing of JSON/YAML/XML plans

=item * lines - arrayref of strings containling lines describing JIT from text plans

=back

=cut

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = bless {}, $class;
    $self->{ 'options' } = {};
    $self->{ 'timings' } = {};
    if ( $args{ 'struct' } ) {
        croak "Pg::Explain::JIT constructor cannot be called with both struct and lines!" if $args{ 'lines' };
        $self->_parse_struct( $args{ 'struct' } );
    }
    else {
        $self->_parse_lines( $args{ 'lines' } );
    }
    return $self;
}

=head2 as_text

Returns text that represents the JIT info as in explain analyze output for 'text' format.

=cut

sub as_text {
    my $self   = shift;
    my $output = "JIT:\n";
    if ( $self->functions ) {
        $output .= sprintf "  Functions: %s\n", $self->functions;
    }
    if ( 0 < scalar keys %{ $self->options } ) {
        my $str = join( ', ', map { "$_ " . ( $self->option( $_ ) ? "true" : "false" ) } keys %{ $self->options } );
        $output .= sprintf "  Options: %s\n", $str;
    }

    # Shortcircuit as logic to build timings line will be slightly longer than options…
    return $output if 0 == scalar keys %{ $self->timings };

    my @parts = ();
    for my $key ( sort keys %{ $self->timings } ) {
        my $val = $self->timings->{ $key };

        # Two potential cases, value is scalar, and it's simply time, and it's hash, in which case we have to build all subparts
        if ( '' eq ref $val ) {
            push @parts, "${key} ${val} ms";
            next;
        }

        # This is the more complex case:
        my @subelements = map { sprintf "%s %s ms", $_, $val->{ $_ } } grep { $_ ne 'Total' } sort keys %{ $val };
        push @parts, sprintf "%s %s ms (%s)", $key, $val->{ 'Total' }, join( ', ', @subelements );
    }
    $output .= sprintf "  Timing: %s\n", join( ', ', @parts );

    return $output;
}

=head1 INTERNAL METHODS

=head2 _parse_struct

Parses given struct, as returned from parsing JSON/YAML/XML formats.

=cut

sub _parse_struct {
    my $self   = shift;
    my $struct = shift;
    $self->functions( $struct->{ 'Functions' } );
    while ( my ( $key, $val ) = each %{ $struct->{ 'Options' } } ) {
        $val = undef if $val eq 'false';
        $self->option( $key, $val ? 1 : 0 );
    }
    $self->timings( $struct->{ 'Timing' } );
    return;
}

=head2 _parse_lines

Parses given lines, as parsed out of TEXT explain format.

=cut

sub _parse_lines {
    my $self  = shift;
    my $lines = shift;
    for my $line ( @{ $lines } ) {
        if ( $line =~ m{ \A \s* Functions: \s+ (\d+) \s* \z }xms ) {
            $self->functions( $1 );
        }
        elsif ( $line =~ m{ \A \s* Options: \s+ (\S.*\S) \s* \z }xms ) {
            my @parts = split( /\s*,\s*/, $1 );
            for my $e ( @parts ) {
                $e =~ s/\s*(true|false)\z//;
                $self->option( $e, $1 eq "true" ? 1 : 0 );
            }
        }
        elsif ( $line =~ m{ \A \s* Timing: \s+ (\S.*\S) \s* \z }xms ) {
            my $timings = $1;

            # Two types of timing information:
            # 1: "Optimization 11.314 ms"
            # 2: "Generation 0.327 ms (Deform 0.131 ms)"
            while (
                $timings =~ s{ \A
                    (? \S+ )
                    \s+
                    (? \d+\.\d+ )
                    \s+
                    ms
                    (?: \s+ \( (? [^\)]+ ) \) )?
                    (?: \z | , \s+ )
                }{}x
                )
            {
                my ( $t_name, $t_total, $t_subelements ) = ( $+{ 'name' }, $+{ 'total' }, $+{ 'subelements' } );
                if ( !defined $t_subelements ) {

                    # This is the simple format of timing information
                    $self->timing( $t_name, $t_total );
                    next;
                }

                # In here, we have subelements, so extract them separately, and put the total timing into Total key
                my @parts = $t_subelements =~ m{(\S+)\s+(\d+\.\d+)\s+ms(?:$|, )}g;
                my $val   = { @parts };
                $val->{ "Total" } = $t_total;
                $self->timing( $t_name, $val );
            }
        }
    }
}

=head1 AUTHOR

hubert depesz lubaczewski, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Pg::Explain::JIT

=head1 COPYRIGHT & LICENSE

Copyright 2008-2023 hubert depesz lubaczewski, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1;    # End of Pg::Explain::JIT