bric_dbprof

#!/usr/bin/perl -w

use strict;

=head1 Name

bric_dbprof - Bricolage Log-Analyzing Database-Profiling Machine

=head1 Synopsis

bric_dbprof [options] logfile

  --help     - shows this screen

  --man      - shows the full documentation

  --verbose  - print a running description to STDERR.  Add a second
               --verbose and you'll get debugging output too.

  --n        - how many results to print, 0 for all.  Defaults to 10.

  --mode     - select an output mode.  The default is 'total'.
               Possibilities are:

                 total   - total time across all executions (default)

                 longest - longest single execution time

                 count   - most executions

  --nowrap   - by default the output wraps the SQL queries to fit on
               your screen.  Use this option to prevent that.


=head1 Description

This program reads Bricolage error logs and parses the output of the
DBI_DEBUG and DBI_PROFILE options.  It uses this data to produce
database usage statistics that can be used to optimize Bricolage.

To use this program, follow these steps;

=over 4

=item 1

Set the DBI_DEBUG and DBI_PROFILE options to 1 in bricolage.conf.

=item 2

Truncate or delete your Bricolage Apache error_log.

=item 3

Restart your server.

=item 4

Run the test case you're interested in using Bricolage as normal.

=item 5

Immediately copy the Apache error log to a safe place.

=item 6

Run bric_dbprof on the captured error log and begin your ascent to
greatness.

=back

=head1 Author

Sam Tregar <stregar@about-inc.com>

=head1 See Also

L<Bric::Util::DBI>

L<Bric::Hacker>

=cut

use Getopt::Long;
use Pod::Usage;
use Text::Wrap;

BEGIN {
    our $VERBOSE         = 0;
    our $n               = 10;
    our $mode            = "total";
    our $nowrap          = 0;
    our ($help, $man);
    GetOptions("help"            => \$help,
           "man"             => \$man,
           "verbose+"        => \$VERBOSE,       
           "n=s"             => \$n,
           "mode=s"          => \$mode,
           "nowrap"          => \$nowrap,
          ) or  pod2usage(2);

    pod2usage(1)             if $help;
    pod2usage(-verbose => 2) if $man;
}

parse_log();
output_stats();

# parses the log into %DATA
sub parse_log {
    our (%DATA, $VERBOSE);

    # make sure we have a logfile
    my $logfile = shift @ARGV;
    pod2usage("Missing required logfile parameter.")
    unless defined $logfile;

    # open it
    open(FILE, $logfile) or die "Unable to open $logfile : $!";

    # run through log, collecting into %DATA
    my ($sig, $last_exec);
    while(<FILE>) {
    # prepare line?
    if (/^############# Prepare Query \[([a-z0-9 ]+)\]/) {
        $sig = $1;
        print STDERR "Found prepare [$sig] on line $.\n"
        if $VERBOSE;
        next if exists $DATA{$sig};
        $DATA{$sig}{sql} = "";
        while(<FILE>) {
        last if /^#############/;
        next if /^\s*$/;
        chomp;
        s/\s+/ /g;
        $DATA{$sig}{sql} .= $_;
        }
        $DATA{$sig}{sql} =~ s/^\s+//;
    }

    # execute line?
    if (/^\+\+\+\+\+\+\+\+\+\+\+\+\+ Execute Query \[([a-z0-9 ]+)\]/) {
        $sig = $1;
        print STDERR "Found execute [$sig] on line $.\n"
        if $VERBOSE;
        die "Log file corrupt: found execute without prepare on line $."
        unless exists $DATA{$sig};
        $DATA{$sig}{count}++;
        $last_exec = $sig;
    }

    # profile line?
    if (/^\*\*\*\*\*\*\*\*\*\*\*\*\* Time: ([\d\.]+) seconds/) {
        my $time = $1;
        print STDERR "Found profile [$last_exec] on line $.\n"
        if $VERBOSE;
        die "Log file corrupt: found profile without execute on line $."
        unless $last_exec and exists $DATA{$last_exec};
        $DATA{$sig}{times}      ||= [];
        push @{$DATA{$sig}{times}}, $time;

        $DATA{$sig}{total_time} ||= 0;
        $DATA{$sig}{total_time}  += $time;

        $DATA{$sig}{longest}    ||= 0;
        $DATA{$sig}{longest}      = $time if $time > $DATA{$sig}{longest};
    }
    }

    close FILE or die "Cannot close $logfile : $!";
    
    if ($VERBOSE > 1) {
    require Data::Dumper;
    print STDERR Data::Dumper->Dump([\%DATA], ['DATA']);
    }
}

# output stats depending on --mode and --n
sub output_stats {
    our (%DATA, $mode, $n);

    if ($mode eq "total") {
    # sort by total time 
    my @data = map  { $DATA{$_} } 
                   sort { $DATA{$b}{total_time} <=> $DATA{$a}{total_time} } 
                   grep { defined $DATA{$_}{total_time} }
           keys %DATA;
    $n = @data unless $n;

    print "\n\n===> Top $n Queries By Total Run-Time <==\n\n\n";

    for (0 .. $n - 1) {
        output_record($_, $data[$_]);
    }
    } elsif ($mode eq "count") {
    # sort by count 
    my @data = map  { $DATA{$_} } 
                   sort { $DATA{$b}{count} <=> $DATA{$a}{count} } 
                   grep { defined $DATA{$_}{count} }
           keys %DATA;
    $n = @data unless $n;

    print "\n\n===> Top $n Queries By Count <==\n\n\n";

    for (0 .. $n - 1) {
        output_record($_, $data[$_]);
    }
    } elsif ($mode eq "longest") {
    # sort by longest single run
    my @data = map  { $DATA{$_} } 
                   sort { $DATA{$b}{longest} <=> $DATA{$a}{longest} } 
                   grep { defined $DATA{$_}{longest} }
           keys %DATA;
    $n = @data unless $n;
    
    print "\n\n===> Top $n Queries By Longest Single Execution <==\n\n\n";
    
    for (0 .. $n - 1) {
        output_record($_, $data[$_]);
    }
    } else {
    pod2usage("Unknown --mode setting \"$mode\".");
    }
}

# outputs a single query record
sub output_record {
    our ($nowrap);
    my ($num, $rec) = @_;
    my $sql = $nowrap ? $rec->{sql} : format_sql($rec->{sql});    

    printf(<<'END', $num + 1, $sql, $rec->{count}, $rec->{total_time}, ($rec->{total_time} / $rec->{count}), $rec->{longest});

### Query %3d #################################################################

%s

###############################################################################

 Execution Count: %-10d
 Total Time:       %0.6f seconds
 Average Time:     %0.6f seconds
 Longest Time:     %0.6f seconds

###############################################################################

END

}

# pretty-prints an SQL expression
sub format_sql {
    my $sql = shift;
    $sql =~ s/,([\S])/, $1/g;
    $sql =~ s/\b$_\b/\n\n$_\t/g 
      for qw(FROM WHERE VALUES LEFT AND OR ORDER LIMIT);
    $sql = fill(" ", " " x 8, $sql);
    $sql =~ s/\n\n/\n/;
    return $sql;
}