profiledata.pm

SinFP是一种新的识别对方计算机操作系统类型的工具

package DBI::ProfileData;
use strict;

=head1 NAME

DBI::ProfileData - manipulate DBI::ProfileDumper data dumps

=head1 SYNOPSIS

The easiest way to use this module is through the dbiprof frontend
(see L<dbiprof> for details):

  dbiprof --number 15 --sort count

This module can also be used to roll your own profile analysis:

  # load data from dbi.prof
  $prof = DBI::ProfileData->new(File => "dbi.prof");

  # get a count of the records in the data set
  $count = $prof->count();

  # sort by longest overall time
  $prof->sort(field => "longest");

  # sort by longest overall time, least to greatest
  $prof->sort(field => "longest", reverse => 1);

  # exclude records with key2 eq 'disconnect'
  $prof->exclude(key2 => 'disconnect');

  # exclude records with key1 matching /^UPDATE/i
  $prof->exclude(key1 => qr/^UPDATE/i);

  # remove all records except those where key1 matches /^SELECT/i
  $prof->match(key1 => qr/^SELECT/i);

  # produce a formatted report with the given number of items
  $report = $prof->report(number => 10); 

  # clone the profile data set
  $clone = $prof->clone();

  # get access to hash of header values
  $header = $prof->header();

  # get access to sorted array of nodes
  $nodes = $prof->nodes();

  # format a single node in the same style as report()
  $text = $prof->format($nodes->[0]);

  # get access to Data hash in DBI::Profile format
  $Data = $prof->Data();

=head1 DESCRIPTION

This module offers the ability to read, manipulate and format
DBI::ProfileDumper profile data.  

Conceptually, a profile consists of a series of records, or nodes,
each of each has a set of statistics and set of keys.  Each record
must have a unique set of keys, but there is no requirement that every
record have the same number of keys.

=head1 METHODS

The following methods are supported by DBI::ProfileData objects.

=over 4

=cut

use vars qw($VERSION);
$VERSION = "1.0";

use Carp qw(croak);
use Symbol;

use DBI::Profile qw(dbi_profile_merge);

# some constants for use with node data arrays
sub COUNT     () { 0 };
sub TOTAL     () { 1 };
sub FIRST     () { 2 };
sub SHORTEST  () { 3 };
sub LONGEST   () { 4 };
sub FIRST_AT  () { 5 };
sub LAST_AT   () { 6 };
sub PATH      () { 7 };

=item $prof = DBI::ProfileData->new(File => "dbi.prof")

=item $prof = DBI::ProfileData->new(File => "dbi.prof", Filter => sub { ... })

=item $prof = DBI::ProfileData->new(Files => [ "dbi.prof.1", "dbi.prof.2" ])

Creates a a new DBI::ProfileData object.  Takes either a single file
through the File option or a list of Files in an array ref.  If
multiple files are specified then the header data from the first file
is used.

The C<Filter> parameter can be used to supply a code reference that can
manipulate the profile data as it is being read. This is most useful for
editing SQL statements so that slightly different statements in the raw data
will be merged and aggregated in the loaded data. For example:

  Filter => sub {
      my ($path_ref, $data_ref) = @_;
      s/foo = '.*?'/foo = '...'/ for @$path_ref;
  }

Here's an example that performs some normalization on the SQL. It converts all
numbers to C<N> and all quoted strings to C<S>.  It can also convert digits to
N within names. Finally, it summarizes long "IN (...)" clauses.

It's aggressive and simplistic, but it's often sufficient, and serves as an
example that you can tailor to suit your own needs:

  Filter => sub {
      my ($path_ref, $data_ref) = @_;
      local $_ = $path_ref->[0]; # whichever element contains the SQL Statement
      s/\b\d+\b/N/g;             # 42 -> N
      s/\b0x[0-9A-Fa-f]+\b/N/g;  # 0xFE -> N
      s/'.*?'/'S'/g;             # single quoted strings (doesn't handle escapes)
      s/".*?"/"S"/g;             # double quoted strings (doesn't handle escapes)
      # convert names like log_20001231 into log_NNNNNNNN, controlled by $opt{n}
      s/([a-z_]+)(\d{$opt{n},})/$1.('N' x length($2))/ieg if $opt{n};
      # abbreviate massive "in (...)" statements and similar
      s!(([NS],){100,})!sprintf("$2,{repeated %d times}",length($1)/2)!eg;
  }

=cut

sub new {
    my $pkg = shift;
    my $self = {                
                Files        => [ "dbi.prof" ],
		Filter       => undef,
                _header      => {},
                _nodes       => [],
                _node_lookup => {},
                @_
               };
    bless $self, $pkg;
    
    # File overrides Files
    $self->{Files} = [ $self->{File} ] if exists $self->{File};

    $self->_read_files();
    return $self;
}

# read files into _header and _nodes
sub _read_files {
    my $self = shift;
    my $files = $self->{Files};
    my $read_header = 0;
    
    foreach my $filename (@$files) {
        my $fh = gensym;
        open($fh, $filename)
          or croak("Unable to read profile file '$filename': $!");
        
        $self->_read_header($fh, $filename, $read_header ? 0 : 1);
        $read_header = 1;
        $self->_read_body($fh, $filename);
        close($fh);
    }
    
    # discard node_lookup now that all files are read
    delete $self->{_node_lookup};
}

# read the header from the given $fh named $filename.  Discards the
# data unless $keep.
sub _read_header {
    my ($self, $fh, $filename, $keep) = @_;

    # get profiler module id
    my $first = <$fh>;
    chomp $first;
    $self->{_profiler} = $first if $keep;

    # collect variables from the header
    while (<$fh>) {
        chomp;
        last unless length $_;
        /^(\S+)\s*=\s*(.*)/
          or croak("Syntax error in header in $filename line $.: $_");
        $self->{_header}{$1} = $2 if $keep;
    }
}

# reads the body of the profile data
sub _read_body {
    my ($self, $fh, $filename) = @_;
    my $nodes = $self->{_nodes};
    my $lookup = $self->{_node_lookup};
    my $filter = $self->{Filter};

    # build up node array
    my @path = ("");
    my (@data, $index, $key, $path_key);
    while (<$fh>) {
        chomp;
        if (/^\+\s+(\d+)\s?(.*)/) {
            # it's a key
            ($key, $index) = ($2, $1 - 1);

            # unmangle key
            $key =~ s/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
            $key =~ s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
            $key =~ s/\\\\/\\/g;       # \\ to \

            $#path = $index;      # truncate path to new length
            $path[$index] = $key; # place new key at end

        }
	elsif (/^=/) {
            # it's data - file in the node array with the path in index 0
            @data = /^=\s+(\d+)
                       \s+(\d+\.?\d*)
                       \s+(\d+\.?\d*)
                       \s+(\d+\.?\d*)
                       \s+(\d+\.?\d*)
                       \s+(\d+\.?\d*)
                       \s+(\d+\.?\d*)
                       \s*$/x;

            # no data?
            croak("Invalid data syntax format in $filename line $.: $_") unless @data;

	    # hook to enable pre-processing of the data - such as mangling SQL
	    # so that slightly different statements get treated as the same
	    # and so merged in the results
	    $filter->(\@path, \@data) if $filter;

            # elements of @path can't have NULLs in them, so this
            # forms a unique string per @path.  If there's some way I
            # can get this without arbitrarily stripping out a
            # character I'd be happy to hear it!
            $path_key = join("\0",@path);

            # look for previous entry
            if (exists $lookup->{$path_key}) {
                # merge in the new data
		dbi_profile_merge($nodes->[$lookup->{$path_key}], \@data);
            } else {
                # insert a new node - nodes are arrays with data in 0-6
                # and path data after that
                push(@$nodes, [ @data, @path ]);

                # record node in %seen
                $lookup->{$path_key} = $#$nodes;
            }
        }
	else {
            croak("Invalid line type syntax error in $filename line $.: $_");
	}
    }
}



=item $copy = $prof->clone();

Clone a profile data set creating a new object.

=cut

sub clone {
    my $self = shift;

    # start with a simple copy
    my $clone = bless { %$self }, ref($self);

    # deep copy nodes
    $clone->{_nodes}  = [ map { [ @$_ ] } @{$self->{_nodes}} ];

    # deep copy header
    $clone->{_header} = { %{$self->{_header}} };

    return $clone;
}

=item $header = $prof->header();

Returns a reference to a hash of header values.  These are the key
value pairs included in the header section of the DBI::ProfileDumper
data format.  For example:

  $header = {
              Path    => '[ DBIprofile_Statement, DBIprofile_MethodName ]',
              Program => 't/42profile_data.t',
            };

Note that modifying this hash will modify the header data stored
inside the profile object.

=cut

sub header { shift->{_header} }


=item $nodes = $prof->nodes()

Returns a reference the sorted nodes array.  Each element in the array
is a single record in the data set.  The first seven elements are the
same as the elements provided by DBI::Profile.  After that each key is
in a separate element.  For example:

 $nodes = [
            [
              2,                      # 0, count
              0.0312958955764771,     # 1, total duration
              0.000490069389343262,   # 2, first duration
              0.000176072120666504,   # 3, shortest duration
              0.00140702724456787,    # 4, longest duration
              1023115819.83019,       # 5, time of first event
              1023115819.86576,       # 6, time of last event
              'SELECT foo FROM bar'   # 7, key1
              'execute'               # 8, key2
                                      # 6+N, keyN
            ],
                                      # ...
          ];

Note that modifying this array will modify the node data stored inside