| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package DBI::Profile; 2 3 =head1 NAME 4 5 DBI::Profile - Performance profiling and benchmarking for the DBI 6 7 =head1 SYNOPSIS 8 9 The easiest way to enable DBI profiling is to set the DBI_PROFILE 10 environment variable to 2 and then run your code as usual: 11 12 DBI_PROFILE=2 prog.pl 13 14 This will profile your program and then output a textual summary 15 grouped by query when the program exits. You can also enable profiling by 16 setting the Profile attribute of any DBI handle: 17 18 $dbh->{Profile} = 2; 19 20 Then the summary will be printed when the handle is destroyed. 21 22 Many other values apart from are possible - see L<"ENABLING A PROFILE"> below. 23 24 =head1 DESCRIPTION 25 26 The DBI::Profile module provides a simple interface to collect and 27 report performance and benchmarking data from the DBI. 28 29 For a more elaborate interface, suitable for larger programs, see 30 L<DBI::ProfileDumper|DBI::ProfileDumper> and L<dbiprof|dbiprof>. 31 For Apache/mod_perl applications see 32 L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>. 33 34 =head1 OVERVIEW 35 36 Performance data collection for the DBI is built around several 37 concepts which are important to understand clearly. 38 39 =over 4 40 41 =item Method Dispatch 42 43 Every method call on a DBI handle passes through a single 'dispatch' 44 function which manages all the common aspects of DBI method calls, 45 such as handling the RaiseError attribute. 46 47 =item Data Collection 48 49 If profiling is enabled for a handle then the dispatch code takes 50 a high-resolution timestamp soon after it is entered. Then, after 51 calling the appropriate method and just before returning, it takes 52 another high-resolution timestamp and calls a function to record 53 the information. That function is passed the two timestamps 54 plus the DBI handle and the name of the method that was called. 55 That data about a single DBI method call is called a I<profile sample>. 56 57 =item Data Filtering 58 59 If the method call was invoked by the DBI or by a driver then the call is 60 ignored for profiling because the time spent will be accounted for by the 61 original 'outermost' call for your code. 62 63 For example, the calls that the selectrow_arrayref() method makes 64 to prepare() and execute() etc. are not counted individually 65 because the time spent in those methods is going to be allocated 66 to the selectrow_arrayref() method when it returns. If this was not 67 done then it would be very easy to double count time spent inside 68 the DBI. 69 70 =item Data Storage Tree 71 72 The profile data is accumulated as 'leaves on a tree'. The 'path' through the 73 branches of the tree to a particular leaf is determined dynamically for each sample. 74 This is a key feature of DBI profiliing. 75 76 For each profiled method call the DBI walks along the Path and uses each value 77 in the Path to step into and grow the Data tree. 78 79 For example, if the Path is 80 81 [ 'foo', 'bar', 'baz' ] 82 83 then the new profile sample data will be I<merged> into the tree at 84 85 $h->{Profile}->{Data}->{foo}->{bar}->{baz} 86 87 But it's not very useful to merge all the call data into one leaf node (except 88 to get an overall 'time spent inside the DBI' total). It's more common to want 89 the Path to include dynamic values such as the current statement text and/or 90 the name of the method called to show what the time spent inside the DBI was for. 91 92 The Path can contain some 'magic cookie' values that are automatically replaced 93 by corresponding dynamic values when they're used. These magic cookies always 94 start with a punctuation character. 95 96 For example a value of 'C<!MethodName>' in the Path causes the corresponding 97 entry in the Data to be the name of the method that was called. 98 For example, if the Path was: 99 100 [ 'foo', '!MethodName', 'bar' ] 101 102 and the selectall_arrayref() method was called, then the profile sample data 103 for that call will be merged into the tree at: 104 105 $h->{Profile}->{Data}->{foo}->{selectall_arrayref}->{bar} 106 107 =item Profile Data 108 109 Profile data is stored at the 'leaves' of the tree as references 110 to an array of numeric values. For example: 111 112 [ 113 106, # 0: count of samples at this node 114 0.0312958955764771, # 1: total duration 115 0.000490069389343262, # 2: first duration 116 0.000176072120666504, # 3: shortest duration 117 0.00140702724456787, # 4: longest duration 118 1023115819.83019, # 5: time of first sample 119 1023115819.86576, # 6: time of last sample 120 ] 121 122 After the first sample, later samples always update elements 0, 1, and 6, and 123 may update 3 or 4 depending on the duration of the sampled call. 124 125 =back 126 127 =head1 ENABLING A PROFILE 128 129 Profiling is enabled for a handle by assigning to the Profile 130 attribute. For example: 131 132 $h->{Profile} = DBI::Profile->new(); 133 134 The Profile attribute holds a blessed reference to a hash object 135 that contains the profile data and attributes relating to it. 136 137 The class the Profile object is blessed into is expected to 138 provide at least a DESTROY method which will dump the profile data 139 to the DBI trace file handle (STDERR by default). 140 141 All these examples have the same effect as each other: 142 143 $h->{Profile} = 0; 144 $h->{Profile} = "/DBI::Profile"; 145 $h->{Profile} = DBI::Profile->new(); 146 $h->{Profile} = {}; 147 $h->{Profile} = { Path => [] }; 148 149 Similarly, these examples have the same effect as each other: 150 151 $h->{Profile} = 6; 152 $h->{Profile} = "6/DBI::Profile"; 153 $h->{Profile} = "!Statement:!MethodName/DBI::Profile"; 154 $h->{Profile} = { Path => [ '!Statement', '!MethodName' ] }; 155 156 If a non-blessed hash reference is given then the DBI::Profile 157 module is automatically C<require>'d and the reference is blessed 158 into that class. 159 160 If a string is given then it is processed like this: 161 162 ($path, $module, $args) = split /\//, $string, 3 163 164 @path = split /:/, $path 165 @args = split /:/, $args 166 167 eval "require $module" if $module 168 $module ||= "DBI::Profile" 169 170 $module->new( Path => \@Path, @args ) 171 172 So the first value is used to select the Path to be used (see below). 173 The second value, if present, is used as the name of a module which 174 will be loaded and it's C<new> method called. If not present it 175 defaults to DBI::Profile. Any other values are passed as arguments 176 to the C<new> method. For example: "C<2/DBIx::OtherProfile/Foo:42>". 177 178 Numbers can be used as a shorthand way to enable common Path values. 179 The simplest way to explain how the values are interpreted is to show the code: 180 181 push @Path, "DBI" if $path_elem & 0x01; 182 push @Path, "!Statement" if $path_elem & 0x02; 183 push @Path, "!MethodName" if $path_elem & 0x04; 184 push @Path, "!MethodClass" if $path_elem & 0x08; 185 push @Path, "!Caller2" if $path_elem & 0x10; 186 187 So "2" is the same as "!Statement" and "6" (2+4) is the same as 188 "!Statement:!Method". Those are the two most commonly used values. Using a 189 negative number will reverse the path. Thus "-6" will group by method name then 190 statement. 191 192 The spliting and parsing of string values assigned to the Profile 193 attribute may seem a little odd, but there's a good reason for it. 194 Remember that attributes can be embedded in the Data Source Name 195 string which can be passed in to a script as a parameter. For 196 example: 197 198 dbi:DriverName(Profile=>2):dbname 199 dbi:DriverName(Profile=>{Username}:!Statement/MyProfiler/Foo:42):dbname 200 201 And also, if the C<DBI_PROFILE> environment variable is set then 202 The DBI arranges for every driver handle to share the same profile 203 object. When perl exits a single profile summary will be generated 204 that reflects (as nearly as practical) the total use of the DBI by 205 the application. 206 207 208 =head1 THE PROFILE OBJECT 209 210 The DBI core expects the Profile attribute value to be a hash 211 reference and if the following values don't exist it will create 212 them as needed: 213 214 =head2 Data 215 216 A reference to a hash containing the collected profile data. 217 218 =head2 Path 219 220 The Path value is a reference to an array. Each element controls the 221 value to use at the corresponding level of the profile Data tree. 222 223 If the value of Path is anything other than an array reference, 224 it is treated as if it was: 225 226 [ '!Statement' ] 227 228 The elements of Path array can be one of the following types: 229 230 =head3 Special Constant 231 232 B<!Statement> 233 234 Use the current Statement text. Typically that's the value of the Statement 235 attribute for the handle the method was called with. Some methods, like 236 commit() and rollback(), are unrelated to a particular statement. For those 237 methods !Statement records an empty string. 238 239 For statement handles this is always simply the string that was 240 given to prepare() when the handle was created. For database handles 241 this is the statement that was last prepared or executed on that 242 database handle. That can lead to a little 'fuzzyness' because, for 243 example, calls to the quote() method to build a new statement will 244 typically be associated with the previous statement. In practice 245 this isn't a significant issue and the dynamic Path mechanism can 246 be used to setup your own rules. 247 248 B<!MethodName> 249 250 Use the name of the DBI method that the profile sample relates to. 251 252 B<!MethodClass> 253 254 Use the fully qualified name of the DBI method, including 255 the package, that the profile sample relates to. This shows you 256 where the method was implemented. For example: 257 258 'DBD::_::db::selectrow_arrayref' => 259 0.022902s 260 'DBD::mysql::db::selectrow_arrayref' => 261 2.244521s / 99 = 0.022445s avg (first 0.022813s, min 0.022051s, max 0.028932s) 262 263 The "DBD::_::db::selectrow_arrayref" shows that the driver has 264 inherited the selectrow_arrayref method provided by the DBI. 265 266 But you'll note that there is only one call to 267 DBD::_::db::selectrow_arrayref but another 99 to 268 DBD::mysql::db::selectrow_arrayref. Currently the first 269 call Pern't record the true location. That may change. 270 271 B<!Caller> 272 273 Use a string showing the filename and line number of the code calling the method. 274 275 B<!Caller2> 276 277 Use a string showing the filename and line number of the code calling the 278 method, as for !Caller, but also include filename and line number of the code 279 that called that. Calls from DBI:: and DBD:: packages are skipped. 280 281 B<!File> 282 283 Same as !Caller above except that only the filename is included, not the line number. 284 285 B<!File2> 286 287 Same as !Caller2 above except that only the filenames are included, not the line number. 288 289 B<!Time> 290 291 Use the current value of time(). Rarely used. See the more useful C<!Time~N> below. 292 293 B<!Time~N> 294 295 Where C<N> is an integer. Use the current value of time() but with reduced precision. 296 The value used is determined in this way: 297 298 int( time() / N ) * N 299 300 This is a useful way to segregate a profile into time slots. For example: 301 302 [ '!Time~60', '!Statement' ] 303 304 =head3 Code Reference 305 306 The subroutine is passed the handle it was called on and the DBI method name. 307 The current Statement is in $_. The statement string should not be modified, 308 so most subs start with C<local $_ = $_;>. 309 310 The list of values it returns is used at that point in the Profile Path. 311 312 The sub can 'veto' (reject) a profile sample by including a reference to undef 313 in the returned list. That can be useful when you want to only profile 314 statements that match a certain pattern, or only profile certain methods. 315 316 =head3 Subroutine Specifier 317 318 A Path element that begins with 'C<&>' is treated as the name of a subroutine 319 in the DBI::ProfileSubs namespace and replaced with the corresponding code reference. 320 321 Currently this only works when the Path is specified by the C<DBI_PROFILE> 322 environment variable. 323 324 Also, currently, the only subroutine in the DBI::ProfileSubs namespace is 325 C<'&norm_std_n3'>. That's a very handy subroutine when profiling code that 326 doesn't use placeholders. See L<DBI::ProfileSubs> for more information. 327 328 =head3 Attribute Specifier 329 330 A string enclosed in braces, such as 'C<{Username}>', specifies that the current 331 value of the corresponding database handle attribute should be used at that 332 point in the Path. 333 334 =head3 Reference to a Scalar 335 336 Specifies that the current value of the referenced scalar be used at that point 337 in the Path. This provides an efficient way to get 'contextual' values into 338 your profile. 339 340 =head3 Other Values 341 342 Any other values are stringified and used literally. 343 344 (References, and values that begin with punctuation characters are reserved.) 345 346 347 =head1 REPORTING 348 349 =head2 Report Format 350 351 The current accumulated profile data can be formatted and output using 352 353 print $h->{Profile}->format; 354 355 To discard the profile data and start collecting fresh data 356 you can do: 357 358 $h->{Profile}->{Data} = undef; 359 360 361 The default results format looks like this: 362 363 DBI::Profile: 0.001015s 42.7% (5 calls) programname @ YYYY-MM-DD HH:MM:SS 364 '' => 365 0.000024s / 2 = 0.000012s avg (first 0.000015s, min 0.000009s, max 0.000015s) 366 'SELECT mode,size,name FROM table' => 367 0.000991s / 3 = 0.000330s avg (first 0.000678s, min 0.000009s, max 0.000678s) 368 369 Which shows the total time spent inside the DBI, with a count of 370 the total number of method calls and the name of the script being 371 run, then a formated version of the profile data tree. 372 373 If the results are being formated when the perl process is exiting 374 (which is usually the case when the DBI_PROFILE environment variable 375 is used) then the percentage of time the process spent inside the 376 DBI is also shown. If the process is not exiting then the percentage is 377 calculated using the time between the first and last call to the DBI. 378 379 In the example above the paths in the tree are only one level deep and 380 use the Statement text as the value (that's the default behaviour). 381 382 The merged profile data at the 'leaves' of the tree are presented 383 as total time spent, count, average time spent (which is simply total 384 time divided by the count), then the time spent on the first call, 385 the time spent on the fastest call, and finally the time spent on 386 the slowest call. 387 388 The 'avg', 'first', 'min' and 'max' times are not particularly 389 useful when the profile data path only contains the statement text. 390 Here's an extract of a more detailed example using both statement 391 text and method name in the path: 392 393 'SELECT mode,size,name FROM table' => 394 'FETCH' => 395 0.000076s 396 'fetchrow_hashref' => 397 0.036203s / 108 = 0.000335s avg (first 0.000490s, min 0.000152s, max 0.002786s) 398 399 Here you can see the 'avg', 'first', 'min' and 'max' for the 400 108 calls to fetchrow_hashref() become rather more interesting. 401 Also the data for FETCH just shows a time value because it was only 402 called once. 403 404 Currently the profile data is output sorted by branch names. That 405 may change in a later version so the leaf nodes are sorted by total 406 time per leaf node. 407 408 409 =head2 Report Destination 410 411 The default method of reporting is for the DESTROY method of the 412 Profile object to format the results and write them using: 413 414 DBI->trace_msg($results, 0); # see $ON_DESTROY_DUMP below 415 416 to write them to the DBI trace() filehandle (which defaults to 417 STDERR). To direct the DBI trace filehandle to write to a file 418 without enabling tracing the trace() method can be called with a 419 trace level of 0. For example: 420 421 DBI->trace(0, $filename); 422 423 The same effect can be achieved without changing the code by 424 setting the C<DBI_TRACE> environment variable to C<0=filename>. 425 426 The $DBI::Profile::ON_DESTROY_DUMP variable holds a code ref 427 that's called to perform the output of the formatted results. 428 The default value is: 429 430 $ON_DESTROY_DUMP = sub { DBI->trace_msg($results, 0) }; 431 432 Apart from making it easy to send the dump elsewhere, it can also 433 be useful as a simple way to disable dumping results. 434 435 =head1 CHILD HANDLES 436 437 Child handles inherit a reference to the Profile attribute value 438 of their parent. So if profiling is enabled for a database handle 439 then by default the statement handles created from it all contribute 440 to the same merged profile data tree. 441 442 443 =head1 PROFILE OBJECT METHODS 444 445 =head2 format 446 447 See L</REPORTING>. 448 449 =head2 as_node_path_list 450 451 @ary = $dbh->{Profile}->as_node_path_list(); 452 @ary = $dbh->{Profile}->as_node_path_list($node, $path); 453 454 Returns the collected data ($dbh->{Profile}{Data}) restructured into a list of 455 array refs, one for each leaf node in the Data tree. This 'flat' structure is 456 often much simpler for applications to work with. 457 458 The first element of each array ref is a reference to the leaf node. 459 The remaining elements are the 'path' through the data tree to that node. 460 461 For example, given a data tree like this: 462 463 {key1a}{key2a}[node1] 464 {key1a}{key2b}[node2] 465 {key1b}{key2a}{key3a}[node3] 466 467 The as_node_path_list() method will return this list: 468 469 [ [node1], 'key1a', 'key2a' ] 470 [ [node2], 'key1a', 'key2b' ] 471 [ [node3], 'key1b', 'key2a', 'key3a' ] 472 473 The nodes are ordered by key, depth-first. 474 475 The $node argument can be used to focus on a sub-tree. 476 If not specified it defaults to $dbh->{Profile}{Data}. 477 478 The $path argument can be used to specify a list of path elements that will be 479 added to each element of the returned list. If not specified it defaults to a a 480 ref to an empty array. 481 482 =head2 as_text 483 484 @txt = $dbh->{Profile}->as_text(); 485 $txt = $dbh->{Profile}->as_text({ 486 node => undef, 487 path => [], 488 separator => " > ", 489 format => '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n"; 490 sortsub => sub { ... }, 491 ); 492 493 Returns the collected data ($dbh->{Profile}{Data}) reformatted into a list of formatted strings. 494 In scalar context the list is returned as a single contatenated string. 495 496 A hashref can be used to pass in arguments, the default values are shown in the example above. 497 498 The C<node> and <path> arguments are passed to as_node_path_list(). 499 500 The C<separator> argument is used to join the elemets of the path for each leaf node. 501 502 The C<sortsub> argument is used to pass in a ref to a sub that will order the list. 503 The subroutine will be passed a reference to the array returned by 504 as_node_path_list() and should sort the contents of the array in place. 505 The return value from the sub is ignored. For example, to sort the nodes by the 506 second level key you could use: 507 508 sortsub => sub { my $ary=shift; @$ary = sort { $a->[2] cmp $b->[2] } @$ary } 509 510 The C<format> argument is a C<sprintf> format string that specifies the format 511 to use for each leaf node. It uses the explicit format parameter index 512 mechanism to specify which of the arguments should appear where in the string. 513 The arguments to sprintf are: 514 515 1: path to node, joined with the separator 516 2: average duration (total duration/count) 517 (3 thru 9 are currently unused) 518 10: count 519 11: total duration 520 12: first duration 521 13: smallest duration 522 14: largest duration 523 15: time of first call 524 16: time of first call 525 526 =head1 CUSTOM DATA MANIPULATION 527 528 Recall that C<$h->{Profile}->{Data}> is a reference to the collected data. 529 Either to a 'leaf' array (when the Path is empty, i.e., DBI_PROFILE env var is 1), 530 or a reference to hash containing values that are either further hash 531 references or leaf array references. 532 533 Sometimes it's useful to be able to summarise some or all of the collected data. 534 The dbi_profile_merge_nodes() function can be used to merge leaf node values. 535 536 =head2 dbi_profile_merge_nodes 537 538 use DBI qw(dbi_profile_merge_nodes); 539 540 $time_in_dbi = dbi_profile_merge_nodes(my $totals=[], @$leaves); 541 542 Merges profile data node. Given a reference to a destination array, and zero or 543 more references to profile data, merges the profile data into the destination array. 544 For example: 545 546 $time_in_dbi = dbi_profile_merge_nodes( 547 my $totals=[], 548 [ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ], 549 [ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ], 550 ); 551 552 $totals will then contain 553 554 [ 25, 0.93, 0.11, 0.01, 0.23, 1023110000, 1023110010 ] 555 556 and $time_in_dbi will be 0.93; 557 558 The second argument need not be just leaf nodes. If given a reference to a hash 559 then the hash is recursively searched for for leaf nodes and all those found 560 are merged. 561 562 For example, to get the time spent 'inside' the DBI during an http request, 563 your logging code run at the end of the request (i.e. mod_perl LogHandler) 564 could use: 565 566 my $time_in_dbi = 0; 567 if (my $Profile = $dbh->{Profile}) { # if DBI profiling is enabled 568 $time_in_dbi = dbi_profile_merge_nodes(my $total=[], $Profile->{Data}); 569 $Profile->{Data} = {}; # reset the profile data 570 } 571 572 If profiling has been enabled then $time_in_dbi will hold the time spent inside 573 the DBI for that handle (and any other handles that share the same profile data) 574 since the last request. 575 576 Prior to DBI 1.56 the dbi_profile_merge_nodes() function was called dbi_profile_merge(). 577 That name still exists as an alias. 578 579 =head1 CUSTOM DATA COLLECTION 580 581 =head2 Using The Path Attribute 582 583 XXX example to be added later using a selectall_arrayref call 584 XXX nested inside a fetch loop where the first column of the 585 XXX outer loop is bound to the profile Path using 586 XXX bind_column(1, \${ $dbh->{Profile}->{Path}->[0] }) 587 XXX so you end up with separate profiles for each loop 588 XXX (patches welcome to add this to the docs :) 589 590 =head2 Adding Your Own Samples 591 592 The dbi_profile() function can be used to add extra sample data 593 into the profile data tree. For example: 594 595 use DBI; 596 use DBI::Profile (dbi_profile dbi_time); 597 598 my $t1 = dbi_time(); # floating point high-resolution time 599 600 ... execute code you want to profile here ... 601 602 my $t2 = dbi_time(); 603 dbi_profile($h, $statement, $method, $t1, $t2); 604 605 The $h parameter is the handle the extra profile sample should be 606 associated with. The $statement parameter is the string to use where 607 the Path specifies !Statement. If $statement is undef 608 then $h->{Statement} will be used. Similarly $method is the string 609 to use if the Path specifies !MethodName. There is no 610 default value for $method. 611 612 The $h->{Profile}{Path} attribute is processed by dbi_profile() in 613 the usual way. 614 615 The $h parameter is usually a DBI handle but it can also be a reference to a 616 hash, in which case the dbi_profile() acts on each defined value in the hash. 617 This is an efficient way to update multiple profiles with a single sample, 618 and is used by the L<DashProfiler> module. 619 620 =head1 SUBCLASSING 621 622 Alternate profile modules must subclass DBI::Profile to help ensure 623 they work with future versions of the DBI. 624 625 626 =head1 CAVEATS 627 628 Applications which generate many different statement strings 629 (typically because they don't use placeholders) and profile with 630 !Statement in the Path (the default) will consume memory 631 in the Profile Data structure for each statement. Use a code ref 632 in the Path to return an edited (simplified) form of the statement. 633 634 If a method throws an exception itself (not via RaiseError) then 635 it won't be counted in the profile. 636 637 If a HandleError subroutine throws an exception (rather than returning 638 0 and letting RaiseError do it) then the method call won't be counted 639 in the profile. 640 641 Time spent in DESTROY is added to the profile of the parent handle. 642 643 Time spent in DBI->*() methods is not counted. The time spent in 644 the driver connect method, $drh->connect(), when it's called by 645 DBI->connect is counted if the DBI_PROFILE environment variable is set. 646 647 Time spent fetching tied variables, $DBI::errstr, is counted. 648 649 Time spent in FETCH for $h->{Profile} is not counted, so getting the profile 650 data doesn't alter it. 651 652 DBI::PurePerl does not support profiling (though it could in theory). 653 654 A few platforms don't support the gettimeofday() high resolution 655 time function used by the DBI (and available via the dbi_time() function). 656 In which case you'll get integer resolution time which is mostly useless. 657 658 On Windows platforms the dbi_time() function is limited to millisecond 659 resolution. Which isn't sufficiently fine for our needs, but still 660 much better than integer resolution. This limited resolution means 661 that fast method calls will often register as taking 0 time. And 662 timings in general will have much more 'jitter' depending on where 663 within the 'current millisecond' the start and and timing was taken. 664 665 This documentation could be more clear. Probably needs to be reordered 666 to start with several examples and build from there. Trying to 667 explain the concepts first seems painful and to lead to just as 668 many forward references. (Patches welcome!) 669 670 =cut 671 672 673 use strict; 674 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); 675 use Exporter (); 676 use UNIVERSAL (); 677 use Carp; 678 679 use DBI qw(dbi_time dbi_profile dbi_profile_merge_nodes dbi_profile_merge); 680 681 $VERSION = sprintf("2.%06d", q$Revision: 10916 $ =~ /(\d+)/o); 682 683 684 @ISA = qw(Exporter); 685 @EXPORT = qw( 686 DBIprofile_Statement 687 DBIprofile_MethodName 688 DBIprofile_MethodClass 689 dbi_profile 690 dbi_profile_merge_nodes 691 dbi_profile_merge 692 dbi_time 693 ); 694 @EXPORT_OK = qw( 695 format_profile_thingy 696 ); 697 698 use constant DBIprofile_Statement => '!Statement'; 699 use constant DBIprofile_MethodName => '!MethodName'; 700 use constant DBIprofile_MethodClass => '!MethodClass'; 701 702 our $ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) }; 703 our $ON_FLUSH_DUMP = sub { DBI->trace_msg(shift, 0) }; 704 705 sub new { 706 my $class = shift; 707 my $profile = { @_ }; 708 return bless $profile => $class; 709 } 710 711 712 sub _auto_new { 713 my $class = shift; 714 my ($arg) = @_; 715 716 # This sub is called by DBI internals when a non-hash-ref is 717 # assigned to the Profile attribute. For example 718 # dbi:mysql(RaiseError=>1,Profile=>!Statement:!MethodName/DBIx::MyProfile/arg1:arg2):dbname 719 # This sub works out what to do and returns a suitable hash ref. 720 721 $arg =~ s/^DBI::/2\/DBI::/ 722 and carp "Automatically changed old-style DBI::Profile specification to $arg"; 723 724 # it's a path/module/arg/arg/arg list 725 my ($path, $package, $args) = split /\//, $arg, 3; 726 my @args = (defined $args) ? split(/:/, $args, -1) : (); 727 my @Path; 728 729 for my $element (split /:/, $path) { 730 if (DBI::looks_like_number($element)) { 731 my $reverse = ($element < 0) ? ($element=-$element, 1) : 0; 732 my @p; 733 # a single "DBI" is special-cased in format() 734 push @p, "DBI" if $element & 0x01; 735 push @p, DBIprofile_Statement if $element & 0x02; 736 push @p, DBIprofile_MethodName if $element & 0x04; 737 push @p, DBIprofile_MethodClass if $element & 0x08; 738 push @p, '!Caller2' if $element & 0x10; 739 push @Path, ($reverse ? reverse @p : @p); 740 } 741 elsif ($element =~ m/^&(\w.*)/) { 742 my $name = "DBI::ProfileSubs::$1"; # capture $1 early 743 require DBI::ProfileSubs; 744 my $code = do { no strict; *{$name}{CODE} }; 745 if (defined $code) { 746 push @Path, $code; 747 } 748 else { 749 warn "$name: subroutine not found\n"; 750 push @Path, $element; 751 } 752 } 753 else { 754 push @Path, $element; 755 } 756 } 757 758 eval "require $package" if $package; # sliently ignores errors 759 $package ||= $class; 760 761 return $package->new(Path => \@Path, @args); 762 } 763 764 765 sub empty { # empty out profile data 766 my $self = shift; 767 DBI->trace_msg("profile data discarded\n",0) if $self->{Trace}; 768 $self->{Data} = undef; 769 } 770 771 sub filename { # baseclass method, see DBI::ProfileDumper 772 return undef; 773 } 774 775 sub flush_to_disk { # baseclass method, see DBI::ProfileDumper & DashProfiler::Core 776 my $self = shift; 777 return unless $ON_FLUSH_DUMP; 778 return unless $self->{Data}; 779 my $detail = $self->format(); 780 $ON_FLUSH_DUMP->($detail) if $detail; 781 } 782 783 784 sub as_node_path_list { 785 my ($self, $node, $path) = @_; 786 # convert the tree into an array of arrays 787 # from 788 # {key1a}{key2a}[node1] 789 # {key1a}{key2b}[node2] 790 # {key1b}{key2a}{key3a}[node3] 791 # to 792 # [ [node1], 'key1a', 'key2a' ] 793 # [ [node2], 'key1a', 'key2b' ] 794 # [ [node3], 'key1b', 'key2a', 'key3a' ] 795 796 $node ||= $self->{Data} or return; 797 $path ||= []; 798 if (ref $node eq 'HASH') { # recurse 799 $path = [ @$path, undef ]; 800 return map { 801 $path->[-1] = $_; 802 ($node->{$_}) ? $self->as_node_path_list($node->{$_}, $path) : () 803 } sort keys %$node; 804 } 805 return [ $node, @$path ]; 806 } 807 808 809 sub as_text { 810 my ($self, $args_ref) = @_; 811 my $separator = $args_ref->{separator} || " > "; 812 my $format_path_element = $args_ref->{format_path_element} 813 || "%s"; # or e.g., " key%2$d='%s'" 814 my $format = $args_ref->{format} 815 || '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n"; 816 817 my @node_path_list = $self->as_node_path_list(undef, $args_ref->{path}); 818 819 $args_ref->{sortsub}->(\@node_path_list) if $args_ref->{sortsub}; 820 821 my $eval = "qr/".quotemeta($separator)."/"; 822 my $separator_re = eval($eval) || quotemeta($separator); 823 #warn "[$eval] = [$separator_re]"; 824 my @text; 825 my @spare_slots = (undef) x 7; 826 for my $node_path (@node_path_list) { 827 my ($node, @path) = @$node_path; 828 my $idx = 0; 829 for (@path) { 830 s/[\r\n]+/ /g; 831 s/$separator_re/ /g; 832 $_ = sprintf $format_path_element, $_, ++$idx; 833 } 834 push @text, sprintf $format, 835 join($separator, @path), # 1=path 836 ($node->[0] ? $node->[1]/$node->[0] : 0), # 2=avg 837 @spare_slots, 838 @$node; # 10=count, 11=dur, 12=first_dur, 13=min, 14=max, 15=first_called, 16=last_called 839 } 840 return @text if wantarray; 841 return join "", @text; 842 } 843 844 845 sub format { 846 my $self = shift; 847 my $class = ref($self) || $self; 848 849 my $prologue = "$class: "; 850 my $detail = $self->format_profile_thingy( 851 $self->{Data}, 0, " ", 852 my $path = [], 853 my $leaves = [], 854 )."\n"; 855 856 if (@$leaves) { 857 dbi_profile_merge_nodes(my $totals=[], @$leaves); 858 my ($count, $time_in_dbi, undef, undef, undef, $t1, $t2) = @$totals; 859 (my $progname = $0) =~ s:.*/::; 860 if ($count) { 861 $prologue .= sprintf "%fs ", $time_in_dbi; 862 my $perl_time = ($DBI::PERL_ENDING) ? time() - $^T : $t2-$t1; 863 $prologue .= sprintf "%.2f%% ", $time_in_dbi/$perl_time*100 if $perl_time; 864 my @lt = localtime(time); 865 my $ts = sprintf "%d-%02d-%02d %02d:%02d:%02d", 866 1900+$lt[5], $lt[4]+1, @lt[3,2,1,0]; 867 $prologue .= sprintf "(%d calls) $progname \@ $ts\n", $count; 868 } 869 if (@$leaves == 1 && ref($self->{Data}) eq 'HASH' && $self->{Data}->{DBI}) { 870 $detail = ""; # hide the "DBI" from DBI_PROFILE=1 871 } 872 } 873 return ($prologue, $detail) if wantarray; 874 return $prologue.$detail; 875 } 876 877 878 sub format_profile_leaf { 879 my ($self, $thingy, $depth, $pad, $path, $leaves) = @_; 880 croak "format_profile_leaf called on non-leaf ($thingy)" 881 unless UNIVERSAL::isa($thingy,'ARRAY'); 882 883 push @$leaves, $thingy if $leaves; 884 my ($count, $total_time, $first_time, $min, $max, $first_called, $last_called) = @$thingy; 885 return sprintf "%s%fs\n", ($pad x $depth), $total_time 886 if $count <= 1; 887 return sprintf "%s%fs / %d = %fs avg (first %fs, min %fs, max %fs)\n", 888 ($pad x $depth), $total_time, $count, $count ? $total_time/$count : 0, 889 $first_time, $min, $max; 890 } 891 892 893 sub format_profile_branch { 894 my ($self, $thingy, $depth, $pad, $path, $leaves) = @_; 895 croak "format_profile_branch called on non-branch ($thingy)" 896 unless UNIVERSAL::isa($thingy,'HASH'); 897 my @chunk; 898 my @keys = sort keys %$thingy; 899 while ( @keys ) { 900 my $k = shift @keys; 901 my $v = $thingy->{$k}; 902 push @$path, $k; 903 push @chunk, sprintf "%s'%s' =>\n%s", 904 ($pad x $depth), $k, 905 $self->format_profile_thingy($v, $depth+1, $pad, $path, $leaves); 906 pop @$path; 907 } 908 return join "", @chunk; 909 } 910 911 912 sub format_profile_thingy { 913 my ($self, $thingy, $depth, $pad, $path, $leaves) = @_; 914 return "undef" if not defined $thingy; 915 return $self->format_profile_leaf( $thingy, $depth, $pad, $path, $leaves) 916 if UNIVERSAL::isa($thingy,'ARRAY'); 917 return $self->format_profile_branch($thingy, $depth, $pad, $path, $leaves) 918 if UNIVERSAL::isa($thingy,'HASH'); 919 return "$thingy\n"; 920 } 921 922 923 sub on_destroy { 924 my $self = shift; 925 return unless $ON_DESTROY_DUMP; 926 return unless $self->{Data}; 927 my $detail = $self->format(); 928 $ON_DESTROY_DUMP->($detail) if $detail; 929 } 930 931 sub DESTROY { 932 my $self = shift; 933 local $@; 934 eval { $self->on_destroy }; 935 if ($@) { 936 chomp $@; 937 my $class = ref($self) || $self; 938 DBI->trace_msg("$class on_destroy failed: $@", 0); 939 } 940 } 941 942 1; 943
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 |