File Coverage

blib/lib/MySQL/Explain/Parser.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	13	14	92.8
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	95	96	98.9

package MySQL::Explain::Parser;
use 5.008005;
use strict;
use warnings;
use utf8;
use parent "Exporter";
use Text::VisualWidth::PP qw/vtrim/;

our $VERSION = "0.02";
our @EXPORT_OK = qw/parse parse_vertical/;

sub parse {
    my ($explain) = @_;

    my @rows = grep {$_} split /\r?\n/, $explain;

    shift @rows; # Skip the top of outline

    # Skip bottom unnecessary line(s)
    if (pop(@rows) =~ /\A\d+\s+rows/) {
        pop @rows;
    }

    my $index_row = shift @rows;
    my @indexes = grep {$_} split /\|/, $index_row;
    my @indexes_length = map {length $_} @indexes;
    map {s/\s//g} @indexes; ## no critic

    shift @rows; # Skip the separator between header and body

    my @parsed;
    my $num_of_indexes = scalar @indexes;
    for my $row (@rows) {
        my %parsed;
        my $begin_pos = 0;
        for (my $i = 0; $i < $num_of_indexes; $i++) {
            my $length = $indexes_length[$i];
            my $item = vtrim($row, $length + 1);
            $row =~ s/\A\Q$item\E//;
            ($item) = $item =~ /\A\|\s*(.*?)\s*\Z/;

            $parsed{$indexes[$i]} = $item eq 'NULL' ? undef : $item;
        }
        push @parsed, \%parsed;
    }

    return \@parsed;
}

sub parse_vertical {
    my ($explain) = @_;

    my @parsed;
    my @explains;
    my @rows = grep {$_} split /\r?\n/, $explain;
    for my $row (@rows) {
        if ($row =~ /\A\*+\s\d/) {
            if (@explains) {
                push @parsed, _parse_yaml_like(\@explains);
            }
            @explains = ();
            next;
        }

        $row =~ s/\A\s*//;
        push @explains, $row;
    }

    if (@explains) {
        push @parsed, _parse_yaml_like(\@explains);
    }

    return \@parsed;
}

sub _parse_yaml_like {
    my ($explains) = @_;

    if ($explains->[-1] =~ /\A\d+\s+rows/) {
        pop @$explains;
    }

    my %parsed;
    for my $explain (@$explains) {
        (my $v = $explain) =~ s/\s*?([^:]*):\s*//;
        my $k = $1;
        if ($v eq 'NULL') {
            $v = undef;
        }
        $parsed{$k} = $v;
    }
    return \%parsed;
}

1;
__END__