#!/usr/bin/perl use strict; use File::Spec; use Data::Dumper; use POSIX qw(strftime); use Fatal qw(open); #my ( $OPTIONAL_HEADER, @HEADER_ELEMENTS ) = get_optional_header_re( '%m %u@%d %p %r ' ); my ( $OPTIONAL_HEADER, @HEADER_ELEMENTS ) = get_optional_header_re( '%t (%r) [%p]: [%l-1] user=%u,db=%d ' ); my $ANALYZE_DB = shift || '*'; my $HTML_OUTPUT = 0; my $SORT_ORDER = 'sum'; # possible: min, max, sum, count, avg my $globals = {}; my $queries = {}; debug( 'Starting' ); normalize_data(); debug( 'Stage1 complete' ); sort_data(); debug( 'Stage2 complete' ); write_raport(); exit; sub get_optional_header_re { my $prefix = shift; my %re = ( 'u' => '[a-z0-9_]*', 'd' => '[a-z0-9_]*', 'r' => '(?:\d{1,3}(?:\.\d{1,3}){3}\(\d+\)|\[local\])?', 'h' => '\d{1,3}(?:\.\d{1,3}){3}|\[local\]', 'p' => '\d+', 't' => '\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d (?:[A-Z]+|\+\d\d\d\d)', 'm' => '\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d\.\d+ (?:[A-Z]+|\+\d\d\d\d)', 'l' => '\d+', 'i' => '(?:BEGIN|COMMIT|DELETE|INSERT|ROLLBACK|SELECT|SET|SHOW|UPDATE)', 'x' => '\d+', 'c' => '[a-f0-9]+\.[a-f0-9]+', ); my @known_keys = keys %re; my $known_re = join '|', @known_keys; my @matched = (); $prefix =~ s/([()\[\]])/\\$1/g; $prefix =~ s/%($known_re)/push @matched, $1;'('.$re{$1}.')'/ge; return $prefix, @matched; } sub write_raport { print "\n" if $HTML_OUTPUT; print_raport_summary(); print "\n" if $HTML_OUTPUT; print_raport_header(); for my $normal ( @{ $globals->{ 'queries_list' } } ) { my $d = delete $queries->{ $normal }; $d->{ 'normal' } = $normal; raport_data( $d ); } print "
\n" if $HTML_OUTPUT; return; } sub raport_columns { if ( $HTML_OUTPUT ) { print "" . join( "", @_ ) . "\n"; } else { print join( "\t", @_ ) . "\n"; } return; } sub print_raport_summary { print "\n" if $HTML_OUTPUT; raport_columns( "Total-time:", sprintf "%d", $globals->{ 'time' } ); raport_columns( "Total-count:", sprintf "%d", $globals->{ 'count' } ); raport_columns( "First-header:", $globals->{ 'first_header' } ) if $globals->{ 'first_header' }; raport_columns( "Last-header:", $globals->{ 'last_header' } ) if $globals->{ 'last_header' }; print "
\n" if $HTML_OUTPUT; return; } sub print_raport_header { raport_columns( qw( query count min avg max totaltime count% time% factor-x fastest slowest ) ); return; } sub raport_data { my $d = shift; my @c = (); push @c, $d->{ 'normal' }; push @c, $d->{ 'count' }; push @c, sprintf "%.2f", $d->{ 'min' }; push @c, sprintf "%.2f", $d->{ 'avg' }; push @c, sprintf "%.2f", $d->{ 'max' }; push @c, sprintf "%.2f", $d->{ 'sum' }; push @c, sprintf "%.2f", 100 * $d->{ 'count' } / $globals->{ 'count' }; # count % push @c, sprintf "%.2f", 100 * $d->{ 'sum' } / $globals->{ 'time' }; # time % push @c, sprintf "%.2f", ( $d->{ 'sum' } / $globals->{ 'time' } ) / ( $d->{ 'count' } / $globals->{ 'count' } ); # factor x push @c, $d->{ 'min_sql' }; push @c, $d->{ 'max_sql' }; raport_columns( @c ); return; } sub sort_data { $globals->{ 'queries_list' } = [ sort { $queries->{ $b }->{ $SORT_ORDER } <=> $queries->{ $a }->{ $SORT_ORDER } } keys %{ $queries } ]; return; } sub normalize_data { my $last = {}; my $read = 0; while ( my $line = ) { chomp $line; $read++; print STDERR '#' if 0 == $read % 1000; my %prefix; if ( $line =~ s/^($OPTIONAL_HEADER)//oi ) { my $header = $1; @prefix{ @HEADER_ELEMENTS } = $header =~ /$OPTIONAL_HEADER/oi; $globals->{ 'first_header' } = $header unless $globals->{ 'first_header' }; $globals->{ 'last_header' } = $header; } if ( $line =~ m{ \A \s* LOG: \s+ duration: \s+ (\d+\.\d+) \s+ ms \s+ (?: statement | execute[^:]* ): \s+ (.*?) \s* \z }xms ) { my ( $time, $sql ) = ( $1, $2 ); store_normalized_data( $last ) if $last->{ 'time' }; $last = { 'time' => $time, 'sql' => $sql, 'prefix' => \%prefix, }; } elsif ( $line =~ m{ \A \s* (?: LOG | NOTICE | HINT | DETAIL | WARNING | PANIC | ERROR | FATAL | CONTEXT ) : \s{1,2} }xms ) { store_normalized_data( $last ) if $last->{ 'time' }; $last = {}; next; } else { next unless $last->{ 'time' }; $last->{ 'sql' } .= ' ' . $line; } } store_normalized_data( $last ) if $last->{ 'sql' }; return; } sub store_normalized_data { my $d = shift; if ( ( $ANALYZE_DB ) && ( $ANALYZE_DB ne '*' ) && ( $d->{ 'prefix' }->{ 'd' } ne $ANALYZE_DB ) ) { return; } my $T = $d->{ 'time' }; $globals->{ 'count' }++; $globals->{ 'time' } += $T; my $sql = $d->{ 'sql' }; $sql =~ s/^\s*//; $sql =~ s/\s*$//; $sql =~ s/\s+/ /g; my $std = lc $sql; $std =~ s/'[^']*'/?/g; $std =~ s/\bnull\b/?/g; $std =~ s/\s* ( <> | >= | <= | <> | \+ | - | > | < | = ) \s* (\d+)(and|or) \s+ / $1 $2 $3 /x; $std =~ s/\b\d+\b/?/g; $std =~ s/ in \(\s*\$?\?(?:\s*,\s*\$?\?)*\s*\)/IN (?,,?)/gi; $std =~ s/ \s* ( \bI?LIKE\b | <> | >= | <= | <> | \+ | - | > | < | = | ~ ) \s* / \U$1\E /gix; $std =~ s/\s*;\s*$//; $std =~ s/\s+ = \s+ - \s+ \? \s*/ = ? /gx; if ( $std =~ s{ \A declare \s+ (\S+) \s+ (.*?) \s+ for \s+ (.*) \z }{declare ? $2 for $3}xms ) { $globals->{ 'cursor' }->{ $1 } = $3; } $std =~ s{ \A (fetch \s+ .*? \s+ from ) \s+ (\S+) \s* \z}{$1 [$globals->{'cursor'}->{$2}]}xms; $std =~ s{ \A prepare\s+ [^\s(]+ }{prepare STATEMENT}xms; $std =~ s{ \A deallocate \s+ \S+ }{deallocate STATEMENT}xms; $std =~ s{ \A (?: abort | rollback | rollback \s+ transaction ) \s* \z }{rollback}xms; $std =~ s{ \A (?: end | commit | commit \s+ transaction ) \s* \z }{commit}xms; $std =~ s{ \A (?: begin | begin \s+ work | begin \s+ transaction | start \s+ transaction ) \s* \z }{begin}xms; $std =~ s/--.*$//mg; $std =~ s{/\*.*?\*/}{}sg; $std =~ s/^\s*//; $std =~ s/\s*$//; $std =~ s/\s+/ /g; $std =~ s/\?+/?/g; my $ID = qr{ (?: [a-z_0-9]+ | " (?: [^"]* | "" )+ " ) }ix; my $FIELD = qr{ (?: (?: $ID(?:\.$ID)? ) (?: \s* [<>=]+ \s* (?: $ID | \? ) )? (?: \s+ as \s+ $ID )? ) }ixo; $std =~ s/select $FIELD(?:\s*,\s*$FIELD)* FROM/select SOME_FIELDS from/goi; $queries->{ $std } ||= {}; my $Q = $queries->{ $std }; $Q->{ 'count' }++; $Q->{ 'sum' } += $T; $Q->{ 'avg' } = $Q->{ 'sum' } / $Q->{ 'count' }; @$Q{ qw(min min_sql) } = ( $T, $sql ) if !$Q->{ 'min' } || $Q->{ 'min' } > $T; @$Q{ qw(max max_sql) } = ( $T, $sql ) if !$Q->{ 'max' } || $Q->{ 'max' } < $T; return; } sub debug { my $what = shift; printf STDERR '[%s] %s%s', strftime( '%Y-%m-%d %H:%M:%S', localtime time ), $what, "\n"; return; }