summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
committerNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
commit661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch)
tree2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm
parentb645030efc22e13c2498a1522083634ab91b2de1 (diff)
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm')
-rwxr-xr-xMaster/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm342
1 files changed, 0 insertions, 342 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm b/Master/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm
deleted file mode 100755
index 5887f16cfe8..00000000000
--- a/Master/tlpkg/tlperl.straw/lib/DBI/ProfileDumper.pm
+++ /dev/null
@@ -1,342 +0,0 @@
-package DBI::ProfileDumper;
-use strict;
-
-=head1 NAME
-
-DBI::ProfileDumper - profile DBI usage and output data to a file
-
-=head1 SYNOPSIS
-
-To profile an existing program using DBI::ProfileDumper, set the
-DBI_PROFILE environment variable and run your program as usual. For
-example, using bash:
-
- DBI_PROFILE=2/DBI::ProfileDumper program.pl
-
-Then analyze the generated file (F<dbi.prof>) with L<dbiprof|dbiprof>:
-
- dbiprof
-
-You can also activate DBI::ProfileDumper from within your code:
-
- use DBI;
-
- # profile with default path (2) and output file (dbi.prof)
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper";
-
- # same thing, spelled out
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof";
-
- # another way to say it
- use DBI::ProfileDumper;
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ]
- File => 'dbi.prof' );
-
- # using a custom path
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ "foo", "bar" ],
- File => 'dbi.prof',
- );
-
-
-=head1 DESCRIPTION
-
-DBI::ProfileDumper is a subclass of L<DBI::Profile|DBI::Profile> which
-dumps profile data to disk instead of printing a summary to your
-screen. You can then use L<dbiprof|dbiprof> to analyze the data in
-a number of interesting ways, or you can roll your own analysis using
-L<DBI::ProfileData|DBI::ProfileData>.
-
-B<NOTE:> For Apache/mod_perl applications, use
-L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
-
-=head1 USAGE
-
-One way to use this module is just to enable it in your C<$dbh>:
-
- $dbh->{Profile} = "1/DBI::ProfileDumper";
-
-This will write out profile data by statement into a file called
-F<dbi.prof>. If you want to modify either of these properties, you
-can construct the DBI::ProfileDumper object yourself:
-
- use DBI::ProfileDumper;
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ],
- File => 'dbi.prof'
- );
-
-The C<Path> option takes the same values as in
-L<DBI::Profile>. The C<File> option gives the name of the
-file where results will be collected. If it already exists it will be
-overwritten.
-
-You can also activate this module by setting the DBI_PROFILE
-environment variable:
-
- $ENV{DBI_PROFILE} = "!Statement/DBI::ProfileDumper";
-
-This will cause all DBI handles to share the same profiling object.
-
-=head1 METHODS
-
-The following methods are available to be called using the profile
-object. You can get access to the profile object from the Profile key
-in any DBI handle:
-
- my $profile = $dbh->{Profile};
-
-=head2 flush_to_disk
-
- $profile->flush_to_disk()
-
-Flushes all collected profile data to disk and empties the Data hash. Returns
-the filename writen to. If no profile data has been collected then the file is
-not written and flush_to_disk() returns undef.
-
-The file is locked while it's being written. A process 'consuming' the files
-while they're being written to, should rename the file first, then lock it,
-then read it, then close and delete it. The C<DeleteFiles> option to
-L<DBI::ProfileData> does the right thing.
-
-This method may be called multiple times during a program run.
-
-=head2 empty
-
- $profile->empty()
-
-Clears the Data hash without writing to disk.
-
-=head2 filename
-
- $filename = $profile->filename();
-
-Get or set the filename.
-
-The filename can be specified as a CODE reference, in which case the referenced
-code should return the filename to be used. The code will be called with the
-profile object as its first argument.
-
-=head1 DATA FORMAT
-
-The data format written by DBI::ProfileDumper starts with a header
-containing the version number of the module used to generate it. Then
-a block of variable declarations describes the profile. After two
-newlines, the profile data forms the body of the file. For example:
-
- DBI::ProfileDumper 2.003762
- Path = [ '!Statement', '!MethodName' ]
- Program = t/42profile_data.t
-
- + 1 SELECT name FROM users WHERE id = ?
- + 2 prepare
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 execute
- 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 fetchrow_hashref
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 1 UPDATE users SET name = ? WHERE id = ?
- + 2 prepare
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 execute
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-
-The lines beginning with C<+> signs signify keys. The number after
-the C<+> sign shows the nesting level of the key. Lines beginning
-with C<=> are the actual profile data, in the same order as
-in DBI::Profile.
-
-Note that the same path may be present multiple times in the data file
-since C<format()> may be called more than once. When read by
-DBI::ProfileData the data points will be merged to produce a single
-data set for each distinct path.
-
-The key strings are transformed in three ways. First, all backslashes
-are doubled. Then all newlines and carriage-returns are transformed
-into C<\n> and C<\r> respectively. Finally, any NULL bytes (C<\0>)
-are entirely removed. When DBI::ProfileData reads the file the first
-two transformations will be reversed, but NULL bytes will not be
-restored.
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=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
-
-# inherit from DBI::Profile
-use DBI::Profile;
-
-our @ISA = ("DBI::Profile");
-
-our $VERSION = sprintf("2.%06d", q$Revision: 9894 $ =~ /(\d+)/o);
-
-use Carp qw(croak);
-use Fcntl qw(:flock);
-use Symbol;
-
-my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK})
- ? $ENV{DBI_PROFILE_FLOCK}
- : do { local $@; eval { flock STDOUT, 0; 1 } };
-
-my $program_header;
-
-
-# validate params and setup default
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new(
- LockFile => $HAS_FLOCK,
- @_,
- );
-
- # provide a default filename
- $self->filename("dbi.prof") unless $self->filename;
-
- return $self;
-}
-
-
-# get/set filename to use
-sub filename {
- my $self = shift;
- $self->{File} = shift if @_;
- my $filename = $self->{File};
- $filename = $filename->($self) if ref($filename) eq 'CODE';
- return $filename;
-}
-
-
-# flush available data to disk
-sub flush_to_disk {
- my $self = shift;
- my $class = ref $self;
- my $filename = $self->filename;
- my $data = $self->{Data};
-
- if (1) { # make an option
- if (not $data or ref $data eq 'HASH' && !%$data) {
- DBI->trace_msg("flush_to_disk skipped for empty profile\n",0) if $self->{Trace};
- return undef;
- }
- }
-
- my $fh = gensym;
- if (($self->{_wrote_header}||'') eq $filename) {
- # append more data to the file
- # XXX assumes that Path hasn't changed
- open($fh, ">>", $filename)
- or croak("Unable to open '$filename' for $class output: $!");
- } else {
- # create new file (or overwrite existing)
- open($fh, ">", $filename)
- or croak("Unable to open '$filename' for $class output: $!");
- }
- # lock the file (before checking size and writing the header)
- flock($fh, LOCK_EX) if $self->{LockFile};
- # write header if file is empty - typically because we just opened it
- # in '>' mode, or perhaps we used '>>' but the file had been truncated externally.
- if (-s $fh == 0) {
- DBI->trace_msg("flush_to_disk wrote header to $filename\n",0) if $self->{Trace};
- $self->write_header($fh);
- $self->{_wrote_header} = $filename;
- }
-
- my $lines = $self->write_data($fh, $self->{Data}, 1);
- DBI->trace_msg("flush_to_disk wrote $lines lines to $filename\n",0) if $self->{Trace};
-
- close($fh) # unlocks the file
- or croak("Error closing '$filename': $!");
-
- $self->empty();
-
-
- return $filename;
-}
-
-
-# write header to a filehandle
-sub write_header {
- my ($self, $fh) = @_;
-
- # isolate us against globals which effect print
- local($\, $,);
-
- # $self->VERSION can return undef during global destruction
- my $version = $self->VERSION || $VERSION;
-
- # module name and version number
- print $fh ref($self)." $version\n";
-
- # print out Path (may contain CODE refs etc)
- my @path_words = map { escape_key($_) } @{ $self->{Path} || [] };
- print $fh "Path = [ ", join(', ', @path_words), " ]\n";
-
- # print out $0 and @ARGV
- if (!$program_header) {
- # XXX should really quote as well as escape
- $program_header = "Program = "
- . join(" ", map { escape_key($_) } $0, @ARGV)
- . "\n";
- }
- print $fh $program_header;
-
- # all done
- print $fh "\n";
-}
-
-
-# write data in the proscribed format
-sub write_data {
- my ($self, $fh, $data, $level) = @_;
-
- # XXX it's valid for $data to be an ARRAY ref, i.e., Path is empty.
- # produce an empty profile for invalid $data
- return 0 unless $data and UNIVERSAL::isa($data,'HASH');
-
- # isolate us against globals which affect print
- local ($\, $,);
-
- my $lines = 0;
- while (my ($key, $value) = each(%$data)) {
- # output a key
- print $fh "+ $level ". escape_key($key). "\n";
- if (UNIVERSAL::isa($value,'ARRAY')) {
- # output a data set for a leaf node
- print $fh "= ".join(' ', @$value)."\n";
- $lines += 1;
- } else {
- # recurse through keys - this could be rewritten to use a
- # stack for some small performance gain
- $lines += $self->write_data($fh, $value, $level + 1);
- }
- }
- return $lines;
-}
-
-
-# escape a key for output
-sub escape_key {
- my $key = shift;
- $key =~ s!\\!\\\\!g;
- $key =~ s!\n!\\n!g;
- $key =~ s!\r!\\r!g;
- $key =~ s!\0!!g;
- return $key;
-}
-
-
-# flush data to disk when profile object goes out of scope
-sub on_destroy {
- shift->flush_to_disk();
-}
-
-1;