profiledata.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

  };

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

=cut

sub header { shift->{_header} }


=head2 $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
the profile object.

=cut

sub nodes { shift->{_nodes} }


=head2 $count = $prof->count()

Returns the number of items in the profile data set.

=cut

sub count { scalar @{shift->{_nodes}} }


=head2 $prof->sort(field => "field")

=head2 $prof->sort(field => "field", reverse => 1)

Sorts data by the given field.  Available fields are:

  longest
  total
  count
  shortest

The default sort is greatest to smallest, which is the opposite of the
normal Perl meaning.  This, however, matches the expected behavior of
the dbiprof frontend.

=cut


# sorts data by one of the available fields
{
    my %FIELDS = (
                  longest  => LONGEST,
                  total    => TOTAL,
                  count    => COUNT,
                  shortest => SHORTEST,
                  key1     => PATH+0,
                  key2     => PATH+1,
                  key3     => PATH+2,
                 );
    sub sort {
        my $self = shift;
        my $nodes = $self->{_nodes};
        my %opt = @_;
        
        croak("Missing required field option.") unless $opt{field};

        my $index = $FIELDS{$opt{field}};
        
        croak("Unrecognized sort field '$opt{field}'.")
          unless defined $index;

        # sort over index
        if ($opt{reverse}) {
            @$nodes = sort { 
                $a->[$index] <=> $b->[$index] 
            } @$nodes;
        } else {
            @$nodes = sort { 
                $b->[$index] <=> $a->[$index] 
            } @$nodes;
        }

        # remember how we're sorted
        $self->{_sort} = $opt{field};

        return $self;
    }
}


=head2 $count = $prof->exclude(key2 => "disconnect")

=head2 $count = $prof->exclude(key2 => "disconnect", case_sensitive => 1)

=head2 $count = $prof->exclude(key1 => qr/^SELECT/i)

Removes records from the data set that match the given string or
regular expression.  This method modifies the data in a permanent
fashion - use clone() first to maintain the original data after
exclude().  Returns the number of nodes left in the profile data set.

=cut

sub exclude {
    my $self = shift;
    my $nodes = $self->{_nodes};
    my %opt = @_;

    # find key index number
    my ($index, $val);
    foreach (keys %opt) {
        if (/^key(\d+)$/) {
            $index   = PATH + $1 - 1;
            $val     = $opt{$_};
            last;
        }
    }
    croak("Missing required keyN option.") unless $index;

    if (UNIVERSAL::isa($val,"Regexp")) {
        # regex match
        @$nodes = grep {
            $#$_ < $index or $_->[$index] !~ /$val/ 
        } @$nodes;
    } else {
        if ($opt{case_sensitive}) {
            @$nodes = grep { 
                $#$_ < $index or $_->[$index] ne $val;
            } @$nodes;
        } else {
            $val = lc $val;
            @$nodes = grep { 
                $#$_ < $index or lc($_->[$index]) ne $val;
            } @$nodes;
        }
    }

    return scalar @$nodes;
}


=head2 $count = $prof->match(key2 => "disconnect")

=head2 $count = $prof->match(key2 => "disconnect", case_sensitive => 1)

=head2 $count = $prof->match(key1 => qr/^SELECT/i)

Removes records from the data set that do not match the given string
or regular expression.  This method modifies the data in a permanent
fashion - use clone() first to maintain the original data after
match().  Returns the number of nodes left in the profile data set.

=cut

sub match {
    my $self = shift;
    my $nodes = $self->{_nodes};
    my %opt = @_;

    # find key index number
    my ($index, $val);
    foreach (keys %opt) {
        if (/^key(\d+)$/) {
            $index   = PATH + $1 - 1;
            $val     = $opt{$_};
            last;
        }
    }
    croak("Missing required keyN option.") unless $index;

    if (UNIVERSAL::isa($val,"Regexp")) {
        # regex match
        @$nodes = grep {
            $#$_ >= $index and $_->[$index] =~ /$val/ 
        } @$nodes;
    } else {
        if ($opt{case_sensitive}) {
            @$nodes = grep { 
                $#$_ >= $index and $_->[$index] eq $val;
            } @$nodes;
        } else {
            $val = lc $val;
            @$nodes = grep { 
                $#$_ >= $index and lc($_->[$index]) eq $val;
            } @$nodes;
        }
    }

    return scalar @$nodes;
}


=head2 $Data = $prof->Data()

Returns the same Data hash structure as seen in DBI::Profile.  This
structure is not sorted.  The nodes() structure probably makes more
sense for most analysis.

=cut

sub Data {
    my $self = shift;
    my (%Data, @data, $ptr);

    foreach my $node (@{$self->{_nodes}}) {
        # traverse to key location
        $ptr = \%Data;
        foreach my $key (@{$node}[PATH .. $#$node - 1]) {
            $ptr->{$key} = {} unless exists $ptr->{$key};
            $ptr = $ptr->{$key};
        }

        # slice out node data
        $ptr->{$node->[-1]} = [ @{$node}[0 .. 6] ];
    }

    return \%Data;
}


=head2 $text = $prof->format($nodes->[0])

Formats a single node into a human-readable block of text.

=cut

sub format {
    my ($self, $node) = @_;
    my $format;
    
    # setup keys
    my $keys = "";
    for (my $i = PATH; $i <= $#$node; $i++) {
        my $key = $node->[$i];
        
        # remove leading and trailing space
        $key =~ s/^\s+//;
        $key =~ s/\s+$//;

        # if key has newlines or is long take special precautions
        if (length($key) > 72 or $key =~ /\n/) {
            $keys .= "  Key " . ($i - PATH + 1) . "         :\n\n$key\n\n";
        } else {
            $keys .= "  Key " . ($i - PATH + 1) . "         : $key\n";
        }
    }

    # nodes with multiple runs get the long entry format, nodes with
    # just one run get a single count.
    if ($node->[COUNT] > 1) {
        $format = <<END;
  Count         : %d
  Total Time    : %3.6f seconds
  Longest Time  : %3.6f seconds
  Shortest Time : %3.6f seconds
  Average Time  : %3.6f seconds
END
        return sprintf($format, @{$node}[COUNT,TOTAL,LONGEST,SHORTEST], 
                       $node->[TOTAL] / $node->[COUNT]) . $keys;
    } else {
        $format = <<END;
  Count         : %d
  Time          : %3.6f seconds
END

        return sprintf($format, @{$node}[COUNT,TOTAL]) . $keys;

    }
}


=head2 $text = $prof->report(number => 10)

Produces a report with the given number of items.

=cut

sub report {
    my $self  = shift;
    my $nodes = $self->{_nodes};
    my %opt   = @_;

    croak("Missing required number option") unless exists $opt{number};

    $opt{number} = @$nodes if @$nodes < $opt{number};

    my $report = $self->_report_header($opt{number});
    for (0 .. $opt{number} - 1) {
        $report .= sprintf("#" x 5  . "[ %d ]". "#" x 59 . "\n", 
                           $_ + 1);
        $report .= $self->format($nodes->[$_]);
        $report .= "\n";
    }
    return $report;
}

# format the header for report()
sub _report_header {
    my ($self, $number) = @_;
    my $nodes = $self->{_nodes};
    my $node_count = @$nodes;

    # find total runtime and method count
    my ($time, $count) = (0,0);
    foreach my $node (@$nodes) {
        $time  += $node->[TOTAL];
        $count += $node->[COUNT];
    }

    my $header = <<END;

DBI Profile Data ($self->{_profiler})

END

    # output header fields
    while (my ($key, $value) = each %{$self->{_header}}) {
        $header .= sprintf("  %-13s : %s\n", $key, $value);
    }

    # output summary data fields
    $header .= sprintf(<<END, $node_count, $number, $self->{_sort}, $count, $time);
  Total Records : %d (showing %d, sorted by %s)
  Total Count   : %d
  Total Runtime : %3.6f seconds  

END

    return $header;
}


1;

__END__

=head1 AUTHOR

Sam Tregar <[e-mail]>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2002 Sam Tregar

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl 5 itself.

=cut