[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package DBI::ProfileDumper; 2 use strict; 3 4 =head1 NAME 5 6 DBI::ProfileDumper - profile DBI usage and output data to a file 7 8 =head1 SYNOPSIS 9 10 To profile an existing program using DBI::ProfileDumper, set the 11 DBI_PROFILE environment variable and run your program as usual. For 12 example, using bash: 13 14 DBI_PROFILE=2/DBI::ProfileDumper program.pl 15 16 Then analyze the generated file (F<dbi.prof>) with L<dbiprof|dbiprof>: 17 18 dbiprof 19 20 You can also activate DBI::ProfileDumper from within your code: 21 22 use DBI; 23 24 # profile with default path (2) and output file (dbi.prof) 25 $dbh->{Profile} = "!Statement/DBI::ProfileDumper"; 26 27 # same thing, spelled out 28 $dbh->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof"; 29 30 # another way to say it 31 use DBI::ProfileDumper; 32 $dbh->{Profile} = DBI::ProfileDumper->new( 33 Path => [ '!Statement' ] 34 File => 'dbi.prof' ); 35 36 # using a custom path 37 $dbh->{Profile} = DBI::ProfileDumper->new( 38 Path => [ "foo", "bar" ], 39 File => 'dbi.prof', 40 ); 41 42 43 =head1 DESCRIPTION 44 45 DBI::ProfileDumper is a subclass of L<DBI::Profile|DBI::Profile> which 46 dumps profile data to disk instead of printing a summary to your 47 screen. You can then use L<dbiprof|dbiprof> to analyze the data in 48 a number of interesting ways, or you can roll your own analysis using 49 L<DBI::ProfileData|DBI::ProfileData>. 50 51 B<NOTE:> For Apache/mod_perl applications, use 52 L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>. 53 54 =head1 USAGE 55 56 One way to use this module is just to enable it in your C<$dbh>: 57 58 $dbh->{Profile} = "1/DBI::ProfileDumper"; 59 60 This will write out profile data by statement into a file called 61 F<dbi.prof>. If you want to modify either of these properties, you 62 can construct the DBI::ProfileDumper object yourself: 63 64 use DBI::ProfileDumper; 65 $dbh->{Profile} = DBI::ProfileDumper->new( 66 Path => [ '!Statement' ], 67 File => 'dbi.prof' 68 ); 69 70 The C<Path> option takes the same values as in 71 L<DBI::Profile>. The C<File> option gives the name of the 72 file where results will be collected. If it already exists it will be 73 overwritten. 74 75 You can also activate this module by setting the DBI_PROFILE 76 environment variable: 77 78 $ENV{DBI_PROFILE} = "!Statement/DBI::ProfileDumper"; 79 80 This will cause all DBI handles to share the same profiling object. 81 82 =head1 METHODS 83 84 The following methods are available to be called using the profile 85 object. You can get access to the profile object from the Profile key 86 in any DBI handle: 87 88 my $profile = $dbh->{Profile}; 89 90 =head2 flush_to_disk 91 92 $profile->flush_to_disk() 93 94 Flushes all collected profile data to disk and empties the Data hash. Returns 95 the filename writen to. If no profile data has been collected then the file is 96 not written and flush_to_disk() returns undef. 97 98 The file is locked while it's being written. A process 'consuming' the files 99 while they're being written to, should rename the file first, then lock it, 100 then read it, then close and delete it. The C<DeleteFiles> option to 101 L<DBI::ProfileData> does the right thing. 102 103 This method may be called multiple times during a program run. 104 105 =head2 empty 106 107 $profile->empty() 108 109 Clears the Data hash without writing to disk. 110 111 =head2 filename 112 113 $filename = $profile->filename(); 114 115 Get or set the filename. 116 117 The filename can be specified as a CODE reference, in which case the referenced 118 code should return the filename to be used. The code will be called with the 119 profile object as its first argument. 120 121 =head1 DATA FORMAT 122 123 The data format written by DBI::ProfileDumper starts with a header 124 containing the version number of the module used to generate it. Then 125 a block of variable declarations describes the profile. After two 126 newlines, the profile data forms the body of the file. For example: 127 128 DBI::ProfileDumper 2.003762 129 Path = [ '!Statement', '!MethodName' ] 130 Program = t/42profile_data.t 131 132 + 1 SELECT name FROM users WHERE id = ? 133 + 2 prepare 134 = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576 135 + 2 execute 136 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576 137 + 2 fetchrow_hashref 138 = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576 139 + 1 UPDATE users SET name = ? WHERE id = ? 140 + 2 prepare 141 = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576 142 + 2 execute 143 = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576 144 145 The lines beginning with C<+> signs signify keys. The number after 146 the C<+> sign shows the nesting level of the key. Lines beginning 147 with C<=> are the actual profile data, in the same order as 148 in DBI::Profile. 149 150 Note that the same path may be present multiple times in the data file 151 since C<format()> may be called more than once. When read by 152 DBI::ProfileData the data points will be merged to produce a single 153 data set for each distinct path. 154 155 The key strings are transformed in three ways. First, all backslashes 156 are doubled. Then all newlines and carriage-returns are transformed 157 into C<\n> and C<\r> respectively. Finally, any NULL bytes (C<\0>) 158 are entirely removed. When DBI::ProfileData reads the file the first 159 two transformations will be reversed, but NULL bytes will not be 160 restored. 161 162 =head1 AUTHOR 163 164 Sam Tregar <sam@tregar.com> 165 166 =head1 COPYRIGHT AND LICENSE 167 168 Copyright (C) 2002 Sam Tregar 169 170 This program is free software; you can redistribute it and/or modify 171 it under the same terms as Perl 5 itself. 172 173 =cut 174 175 # inherit from DBI::Profile 176 use DBI::Profile; 177 178 our @ISA = ("DBI::Profile"); 179 180 our $VERSION = sprintf("2.%06d", q$Revision: 9894 $ =~ /(\d+)/o); 181 182 use Carp qw(croak); 183 use Fcntl qw(:flock); 184 use Symbol; 185 186 my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK}) 187 ? $ENV{DBI_PROFILE_FLOCK} 188 : do { local $@; eval { flock STDOUT, 0; 1 } }; 189 190 my $program_header; 191 192 193 # validate params and setup default 194 sub new { 195 my $pkg = shift; 196 my $self = $pkg->SUPER::new( 197 LockFile => $HAS_FLOCK, 198 @_, 199 ); 200 201 # provide a default filename 202 $self->filename("dbi.prof") unless $self->filename; 203 204 return $self; 205 } 206 207 208 # get/set filename to use 209 sub filename { 210 my $self = shift; 211 $self->{File} = shift if @_; 212 my $filename = $self->{File}; 213 $filename = $filename->($self) if ref($filename) eq 'CODE'; 214 return $filename; 215 } 216 217 218 # flush available data to disk 219 sub flush_to_disk { 220 my $self = shift; 221 my $class = ref $self; 222 my $filename = $self->filename; 223 my $data = $self->{Data}; 224 225 if (1) { # make an option 226 if (not $data or ref $data eq 'HASH' && !%$data) { 227 DBI->trace_msg("flush_to_disk skipped for empty profile\n",0) if $self->{Trace}; 228 return undef; 229 } 230 } 231 232 my $fh = gensym; 233 if (($self->{_wrote_header}||'') eq $filename) { 234 # append more data to the file 235 # XXX assumes that Path hasn't changed 236 open($fh, ">>", $filename) 237 or croak("Unable to open '$filename' for $class output: $!"); 238 } else { 239 # create new file (or overwrite existing) 240 open($fh, ">", $filename) 241 or croak("Unable to open '$filename' for $class output: $!"); 242 } 243 # lock the file (before checking size and writing the header) 244 flock($fh, LOCK_EX) if $self->{LockFile}; 245 # write header if file is empty - typically because we just opened it 246 # in '>' mode, or perhaps we used '>>' but the file had been truncated externally. 247 if (-s $fh == 0) { 248 DBI->trace_msg("flush_to_disk wrote header to $filename\n",0) if $self->{Trace}; 249 $self->write_header($fh); 250 $self->{_wrote_header} = $filename; 251 } 252 253 my $lines = $self->write_data($fh, $self->{Data}, 1); 254 DBI->trace_msg("flush_to_disk wrote $lines lines to $filename\n",0) if $self->{Trace}; 255 256 close($fh) # unlocks the file 257 or croak("Error closing '$filename': $!"); 258 259 $self->empty(); 260 261 262 return $filename; 263 } 264 265 266 # write header to a filehandle 267 sub write_header { 268 my ($self, $fh) = @_; 269 270 # isolate us against globals which effect print 271 local($\, $,); 272 273 # $self->VERSION can return undef during global destruction 274 my $version = $self->VERSION || $VERSION; 275 276 # module name and version number 277 print $fh ref($self)." $version\n"; 278 279 # print out Path (may contain CODE refs etc) 280 my @path_words = map { escape_key($_) } @{ $self->{Path} || [] }; 281 print $fh "Path = [ ", join(', ', @path_words), " ]\n"; 282 283 # print out $0 and @ARGV 284 if (!$program_header) { 285 # XXX should really quote as well as escape 286 $program_header = "Program = " 287 . join(" ", map { escape_key($_) } $0, @ARGV) 288 . "\n"; 289 } 290 print $fh $program_header; 291 292 # all done 293 print $fh "\n"; 294 } 295 296 297 # write data in the proscribed format 298 sub write_data { 299 my ($self, $fh, $data, $level) = @_; 300 301 # XXX it's valid for $data to be an ARRAY ref, i.e., Path is empty. 302 # produce an empty profile for invalid $data 303 return 0 unless $data and UNIVERSAL::isa($data,'HASH'); 304 305 # isolate us against globals which affect print 306 local ($\, $,); 307 308 my $lines = 0; 309 while (my ($key, $value) = each(%$data)) { 310 # output a key 311 print $fh "+ $level ". escape_key($key). "\n"; 312 if (UNIVERSAL::isa($value,'ARRAY')) { 313 # output a data set for a leaf node 314 print $fh "= ".join(' ', @$value)."\n"; 315 $lines += 1; 316 } else { 317 # recurse through keys - this could be rewritten to use a 318 # stack for some small performance gain 319 $lines += $self->write_data($fh, $value, $level + 1); 320 } 321 } 322 return $lines; 323 } 324 325 326 # escape a key for output 327 sub escape_key { 328 my $key = shift; 329 $key =~ s!\\!\\\\!g; 330 $key =~ s!\n!\\n!g; 331 $key =~ s!\r!\\r!g; 332 $key =~ s!\0!!g; 333 return $key; 334 } 335 336 337 # flush data to disk when profile object goes out of scope 338 sub on_destroy { 339 shift->flush_to_disk(); 340 } 341 342 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |