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;
}