This file is indexed.

/usr/lib/perl5/DBI/Profile.pm is in libdbi-perl 1.630-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
package DBI::Profile;

=head1 NAME

DBI::Profile - Performance profiling and benchmarking for the DBI

=head1 SYNOPSIS

The easiest way to enable DBI profiling is to set the DBI_PROFILE
environment variable to 2 and then run your code as usual:

  DBI_PROFILE=2 prog.pl

This will profile your program and then output a textual summary
grouped by query when the program exits.  You can also enable profiling by
setting the Profile attribute of any DBI handle:

  $dbh->{Profile} = 2;

Then the summary will be printed when the handle is destroyed.

Many other values apart from are possible - see L<"ENABLING A PROFILE"> below.

=head1 DESCRIPTION

The DBI::Profile module provides a simple interface to collect and
report performance and benchmarking data from the DBI.

For a more elaborate interface, suitable for larger programs, see
L<DBI::ProfileDumper|DBI::ProfileDumper> and L<dbiprof|dbiprof>.
For Apache/mod_perl applications see
L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.

=head1 OVERVIEW

Performance data collection for the DBI is built around several
concepts which are important to understand clearly.

=over 4

=item Method Dispatch

Every method call on a DBI handle passes through a single 'dispatch'
function which manages all the common aspects of DBI method calls,
such as handling the RaiseError attribute.

=item Data Collection

If profiling is enabled for a handle then the dispatch code takes
a high-resolution timestamp soon after it is entered. Then, after
calling the appropriate method and just before returning, it takes
another high-resolution timestamp and calls a function to record
the information.  That function is passed the two timestamps
plus the DBI handle and the name of the method that was called.
That data about a single DBI method call is called a I<profile sample>.

=item Data Filtering

If the method call was invoked by the DBI or by a driver then the call is
ignored for profiling because the time spent will be accounted for by the
original 'outermost' call for your code.

For example, the calls that the selectrow_arrayref() method makes
to prepare() and execute() etc. are not counted individually
because the time spent in those methods is going to be allocated
to the selectrow_arrayref() method when it returns. If this was not
done then it would be very easy to double count time spent inside
the DBI.

=item Data Storage Tree

The profile data is accumulated as 'leaves on a tree'. The 'path' through the
branches of the tree to a particular leaf is determined dynamically for each sample.
This is a key feature of DBI profiling.

For each profiled method call the DBI walks along the Path and uses each value
in the Path to step into and grow the Data tree.

For example, if the Path is

  [ 'foo', 'bar', 'baz' ]

then the new profile sample data will be I<merged> into the tree at

  $h->{Profile}->{Data}->{foo}->{bar}->{baz}

But it's not very useful to merge all the call data into one leaf node (except
to get an overall 'time spent inside the DBI' total).  It's more common to want
the Path to include dynamic values such as the current statement text and/or
the name of the method called to show what the time spent inside the DBI was for.

The Path can contain some 'magic cookie' values that are automatically replaced
by corresponding dynamic values when they're used. These magic cookies always
start with a punctuation character.

For example a value of 'C<!MethodName>' in the Path causes the corresponding
entry in the Data to be the name of the method that was called.
For example, if the Path was:

  [ 'foo', '!MethodName', 'bar' ]

and the selectall_arrayref() method was called, then the profile sample data
for that call will be merged into the tree at:

  $h->{Profile}->{Data}->{foo}->{selectall_arrayref}->{bar}

=item Profile Data

Profile data is stored at the 'leaves' of the tree as references
to an array of numeric values. For example:

  [
    106,                  # 0: count of samples at this node
    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 sample
    1023115819.86576,     # 6: time of last sample
  ]

After the first sample, later samples always update elements 0, 1, and 6, and
may update 3 or 4 depending on the duration of the sampled call.

=back

=head1 ENABLING A PROFILE

Profiling is enabled for a handle by assigning to the Profile
attribute. For example:

  $h->{Profile} = DBI::Profile->new();

The Profile attribute holds a blessed reference to a hash object
that contains the profile data and attributes relating to it.

The class the Profile object is blessed into is expected to
provide at least a DESTROY method which will dump the profile data
to the DBI trace file handle (STDERR by default).

All these examples have the same effect as each other:

  $h->{Profile} = 0;
  $h->{Profile} = "/DBI::Profile";
  $h->{Profile} = DBI::Profile->new();
  $h->{Profile} = {};
  $h->{Profile} = { Path => [] };

Similarly, these examples have the same effect as each other:

  $h->{Profile} = 6;
  $h->{Profile} = "6/DBI::Profile";
  $h->{Profile} = "!Statement:!MethodName/DBI::Profile";
  $h->{Profile} = { Path => [ '!Statement', '!MethodName' ] };

If a non-blessed hash reference is given then the DBI::Profile
module is automatically C<require>'d and the reference is blessed
into that class.

If a string is given then it is processed like this:

    ($path, $module, $args) = split /\//, $string, 3

    @path = split /:/, $path
    @args = split /:/, $args

    eval "require $module" if $module
    $module ||= "DBI::Profile"

    $module->new( Path => \@Path, @args )

So the first value is used to select the Path to be used (see below).
The second value, if present, is used as the name of a module which
will be loaded and it's C<new> method called. If not present it
defaults to DBI::Profile. Any other values are passed as arguments
to the C<new> method. For example: "C<2/DBIx::OtherProfile/Foo:42>".

Numbers can be used as a shorthand way to enable common Path values.
The simplest way to explain how the values are interpreted is to show the code:

    push @Path, "DBI"           if $path_elem & 0x01;
    push @Path, "!Statement"    if $path_elem & 0x02;
    push @Path, "!MethodName"   if $path_elem & 0x04;
    push @Path, "!MethodClass"  if $path_elem & 0x08;
    push @Path, "!Caller2"      if $path_elem & 0x10;

So "2" is the same as "!Statement" and "6" (2+4) is the same as
"!Statement:!Method".  Those are the two most commonly used values.  Using a
negative number will reverse the path. Thus "-6" will group by method name then
statement.

The splitting and parsing of string values assigned to the Profile
attribute may seem a little odd, but there's a good reason for it.
Remember that attributes can be embedded in the Data Source Name
string which can be passed in to a script as a parameter. For
example:

    dbi:DriverName(Profile=>2):dbname
    dbi:DriverName(Profile=>{Username}:!Statement/MyProfiler/Foo:42):dbname

And also, if the C<DBI_PROFILE> environment variable is set then
The DBI arranges for every driver handle to share the same profile
object. When perl exits a single profile summary will be generated
that reflects (as nearly as practical) the total use of the DBI by
the application.


=head1 THE PROFILE OBJECT

The DBI core expects the Profile attribute value to be a hash
reference and if the following values don't exist it will create
them as needed:

=head2 Data

A reference to a hash containing the collected profile data.

=head2 Path

The Path value is a reference to an array. Each element controls the
value to use at the corresponding level of the profile Data tree.

If the value of Path is anything other than an array reference,
it is treated as if it was:

	[ '!Statement' ]

The elements of Path array can be one of the following types:

=head3 Special Constant

B<!Statement>

Use the current Statement text. Typically that's the value of the Statement
attribute for the handle the method was called with. Some methods, like
commit() and rollback(), are unrelated to a particular statement. For those
methods !Statement records an empty string.

For statement handles this is always simply the string that was
given to prepare() when the handle was created.  For database handles
this is the statement that was last prepared or executed on that
database handle. That can lead to a little 'fuzzyness' because, for
example, calls to the quote() method to build a new statement will
typically be associated with the previous statement. In practice
this isn't a significant issue and the dynamic Path mechanism can
be used to setup your own rules.

B<!MethodName>

Use the name of the DBI method that the profile sample relates to.

B<!MethodClass>

Use the fully qualified name of the DBI method, including
the package, that the profile sample relates to. This shows you
where the method was implemented. For example:

  'DBD::_::db::selectrow_arrayref' =>
      0.022902s
  'DBD::mysql::db::selectrow_arrayref' =>
      2.244521s / 99 = 0.022445s avg (first 0.022813s, min 0.022051s, max 0.028932s)

The "DBD::_::db::selectrow_arrayref" shows that the driver has
inherited the selectrow_arrayref method provided by the DBI.

But you'll note that there is only one call to
DBD::_::db::selectrow_arrayref but another 99 to
DBD::mysql::db::selectrow_arrayref. Currently the first
call doesn't record the true location. That may change.

B<!Caller>

Use a string showing the filename and line number of the code calling the method.

B<!Caller2>

Use a string showing the filename and line number of the code calling the
method, as for !Caller, but also include filename and line number of the code
that called that. Calls from DBI:: and DBD:: packages are skipped.

B<!File>

Same as !Caller above except that only the filename is included, not the line number.

B<!File2>

Same as !Caller2 above except that only the filenames are included, not the line number.

B<!Time>

Use the current value of time(). Rarely used. See the more useful C<!Time~N> below.

B<!Time~N>

Where C<N> is an integer. Use the current value of time() but with reduced precision.
The value used is determined in this way:

    int( time() / N ) * N

This is a useful way to segregate a profile into time slots. For example:

    [ '!Time~60', '!Statement' ]

=head3 Code Reference

The subroutine is passed the handle it was called on and the DBI method name.
The current Statement is in $_. The statement string should not be modified,
so most subs start with C<local $_ = $_;>.

The list of values it returns is used at that point in the Profile Path.

The sub can 'veto' (reject) a profile sample by including a reference to undef
in the returned list. That can be useful when you want to only profile
statements that match a certain pattern, or only profile certain methods.

=head3 Subroutine Specifier

A Path element that begins with 'C<&>' is treated as the name of a subroutine
in the DBI::ProfileSubs namespace and replaced with the corresponding code reference.

Currently this only works when the Path is specified by the C<DBI_PROFILE>
environment variable.

Also, currently, the only subroutine in the DBI::ProfileSubs namespace is
C<'&norm_std_n3'>. That's a very handy subroutine when profiling code that
doesn't use placeholders. See L<DBI::ProfileSubs> for more information.

=head3 Attribute Specifier

A string enclosed in braces, such as 'C<{Username}>', specifies that the current
value of the corresponding database handle attribute should be used at that
point in the Path.

=head3 Reference to a Scalar

Specifies that the current value of the referenced scalar be used at that point
in the Path.  This provides an efficient way to get 'contextual' values into
your profile.

=head3 Other Values

Any other values are stringified and used literally.

(References, and values that begin with punctuation characters are reserved.)


=head1 REPORTING

=head2 Report Format

The current accumulated profile data can be formatted and output using

    print $h->{Profile}->format;

To discard the profile data and start collecting fresh data
you can do:

    $h->{Profile}->{Data} = undef;


The default results format looks like this:

  DBI::Profile: 0.001015s 42.7% (5 calls) programname @ YYYY-MM-DD HH:MM:SS
  '' =>
      0.000024s / 2 = 0.000012s avg (first 0.000015s, min 0.000009s, max 0.000015s)
  'SELECT mode,size,name FROM table' =>
      0.000991s / 3 = 0.000330s avg (first 0.000678s, min 0.000009s, max 0.000678s)

Which shows the total time spent inside the DBI, with a count of
the total number of method calls and the name of the script being
run, then a formatted version of the profile data tree.

If the results are being formatted when the perl process is exiting
(which is usually the case when the DBI_PROFILE environment variable
is used) then the percentage of time the process spent inside the
DBI is also shown. If the process is not exiting then the percentage is
calculated using the time between the first and last call to the DBI.

In the example above the paths in the tree are only one level deep and
use the Statement text as the value (that's the default behaviour).

The merged profile data at the 'leaves' of the tree are presented
as total time spent, count, average time spent (which is simply total
time divided by the count), then the time spent on the first call,
the time spent on the fastest call, and finally the time spent on
the slowest call.

The 'avg', 'first', 'min' and 'max' times are not particularly
useful when the profile data path only contains the statement text.
Here's an extract of a more detailed example using both statement
text and method name in the path:

  'SELECT mode,size,name FROM table' =>
      'FETCH' =>
          0.000076s
      'fetchrow_hashref' =>
          0.036203s / 108 = 0.000335s avg (first 0.000490s, min 0.000152s, max 0.002786s)

Here you can see the 'avg', 'first', 'min' and 'max' for the
108 calls to fetchrow_hashref() become rather more interesting.
Also the data for FETCH just shows a time value because it was only
called once.

Currently the profile data is output sorted by branch names. That
may change in a later version so the leaf nodes are sorted by total
time per leaf node.


=head2 Report Destination

The default method of reporting is for the DESTROY method of the
Profile object to format the results and write them using:

    DBI->trace_msg($results, 0);  # see $ON_DESTROY_DUMP below

to write them to the DBI trace() filehandle (which defaults to
STDERR). To direct the DBI trace filehandle to write to a file
without enabling tracing the trace() method can be called with a
trace level of 0. For example:

    DBI->trace(0, $filename);

The same effect can be achieved without changing the code by
setting the C<DBI_TRACE> environment variable to C<0=filename>.

The $DBI::Profile::ON_DESTROY_DUMP variable holds a code ref
that's called to perform the output of the formatted results.
The default value is:

  $ON_DESTROY_DUMP = sub { DBI->trace_msg($results, 0) };

Apart from making it easy to send the dump elsewhere, it can also
be useful as a simple way to disable dumping results.

=head1 CHILD HANDLES

Child handles inherit a reference to the Profile attribute value
of their parent.  So if profiling is enabled for a database handle
then by default the statement handles created from it all contribute
to the same merged profile data tree.


=head1 PROFILE OBJECT METHODS

=head2 format

See L</REPORTING>.

=head2 as_node_path_list

  @ary = $dbh->{Profile}->as_node_path_list();
  @ary = $dbh->{Profile}->as_node_path_list($node, $path);

Returns the collected data ($dbh->{Profile}{Data}) restructured into a list of
array refs, one for each leaf node in the Data tree. This 'flat' structure is
often much simpler for applications to work with.

The first element of each array ref is a reference to the leaf node.
The remaining elements are the 'path' through the data tree to that node.

For example, given a data tree like this:

    {key1a}{key2a}[node1]
    {key1a}{key2b}[node2]
    {key1b}{key2a}{key3a}[node3]

The as_node_path_list() method  will return this list:

    [ [node1], 'key1a', 'key2a' ]
    [ [node2], 'key1a', 'key2b' ]
    [ [node3], 'key1b', 'key2a', 'key3a' ]

The nodes are ordered by key, depth-first.

The $node argument can be used to focus on a sub-tree.
If not specified it defaults to $dbh->{Profile}{Data}.

The $path argument can be used to specify a list of path elements that will be
added to each element of the returned list. If not specified it defaults to a
ref to an empty array.

=head2 as_text

  @txt = $dbh->{Profile}->as_text();
  $txt = $dbh->{Profile}->as_text({
      node      => undef,
      path      => [],
      separator => " > ",
      format    => '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
      sortsub   => sub { ... },
  );

Returns the collected data ($dbh->{Profile}{Data}) reformatted into a list of formatted strings.
In scalar context the list is returned as a single concatenated string.

A hashref can be used to pass in arguments, the default values are shown in the example above.

The C<node> and <path> arguments are passed to as_node_path_list().

The C<separator> argument is used to join the elements of the path for each leaf node.

The C<sortsub> argument is used to pass in a ref to a sub that will order the list.
The subroutine will be passed a reference to the array returned by
as_node_path_list() and should sort the contents of the array in place.
The return value from the sub is ignored. For example, to sort the nodes by the
second level key you could use:

  sortsub => sub { my $ary=shift; @$ary = sort { $a->[2] cmp $b->[2] } @$ary }

The C<format> argument is a C<sprintf> format string that specifies the format
to use for each leaf node.  It uses the explicit format parameter index
mechanism to specify which of the arguments should appear where in the string.
The arguments to sprintf are:

     1:  path to node, joined with the separator
     2:  average duration (total duration/count)
         (3 thru 9 are currently unused)
    10:  count
    11:  total duration
    12:  first duration
    13:  smallest duration
    14:  largest duration
    15:  time of first call
    16:  time of first call

=head1 CUSTOM DATA MANIPULATION

Recall that C<< $h->{Profile}->{Data} >> is a reference to the collected data.
Either to a 'leaf' array (when the Path is empty, i.e., DBI_PROFILE env var is 1),
or a reference to hash containing values that are either further hash
references or leaf array references.

Sometimes it's useful to be able to summarise some or all of the collected data.
The dbi_profile_merge_nodes() function can be used to merge leaf node values.

=head2 dbi_profile_merge_nodes

  use DBI qw(dbi_profile_merge_nodes);

  $time_in_dbi = dbi_profile_merge_nodes(my $totals=[], @$leaves);

Merges profile data node. Given a reference to a destination array, and zero or
more references to profile data, merges the profile data into the destination array.
For example:

  $time_in_dbi = dbi_profile_merge_nodes(
      my $totals=[],
      [ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
      [ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
  );

$totals will then contain

  [ 25, 0.93, 0.11, 0.01, 0.23, 1023110000, 1023110010 ]

and $time_in_dbi will be 0.93;

The second argument need not be just leaf nodes. If given a reference to a hash
then the hash is recursively searched for leaf nodes and all those found
are merged.

For example, to get the time spent 'inside' the DBI during an http request,
your logging code run at the end of the request (i.e. mod_perl LogHandler)
could use:

  my $time_in_dbi = 0;
  if (my $Profile = $dbh->{Profile}) { # if DBI profiling is enabled
      $time_in_dbi = dbi_profile_merge_nodes(my $total=[], $Profile->{Data});
      $Profile->{Data} = {}; # reset the profile data
  }

If profiling has been enabled then $time_in_dbi will hold the time spent inside
the DBI for that handle (and any other handles that share the same profile data)
since the last request.

Prior to DBI 1.56 the dbi_profile_merge_nodes() function was called dbi_profile_merge().
That name still exists as an alias.

=head1 CUSTOM DATA COLLECTION

=head2 Using The Path Attribute

  XXX example to be added later using a selectall_arrayref call
  XXX nested inside a fetch loop where the first column of the
  XXX outer loop is bound to the profile Path using
  XXX bind_column(1, \${ $dbh->{Profile}->{Path}->[0] })
  XXX so you end up with separate profiles for each loop
  XXX (patches welcome to add this to the docs :)

=head2 Adding Your Own Samples

The dbi_profile() function can be used to add extra sample data
into the profile data tree. For example:

    use DBI;
    use DBI::Profile (dbi_profile dbi_time);

    my $t1 = dbi_time(); # floating point high-resolution time

    ... execute code you want to profile here ...

    my $t2 = dbi_time();
    dbi_profile($h, $statement, $method, $t1, $t2);

The $h parameter is the handle the extra profile sample should be
associated with. The $statement parameter is the string to use where
the Path specifies !Statement. If $statement is undef
then $h->{Statement} will be used. Similarly $method is the string
to use if the Path specifies !MethodName. There is no
default value for $method.

The $h->{Profile}{Path} attribute is processed by dbi_profile() in
the usual way.

The $h parameter is usually a DBI handle but it can also be a reference to a
hash, in which case the dbi_profile() acts on each defined value in the hash.
This is an efficient way to update multiple profiles with a single sample,
and is used by the L<DashProfiler> module.

=head1 SUBCLASSING

Alternate profile modules must subclass DBI::Profile to help ensure
they work with future versions of the DBI.


=head1 CAVEATS

Applications which generate many different statement strings
(typically because they don't use placeholders) and profile with
!Statement in the Path (the default) will consume memory
in the Profile Data structure for each statement. Use a code ref
in the Path to return an edited (simplified) form of the statement.

If a method throws an exception itself (not via RaiseError) then
it won't be counted in the profile.

If a HandleError subroutine throws an exception (rather than returning
0 and letting RaiseError do it) then the method call won't be counted
in the profile.

Time spent in DESTROY is added to the profile of the parent handle.

Time spent in DBI->*() methods is not counted. The time spent in
the driver connect method, $drh->connect(), when it's called by
DBI->connect is counted if the DBI_PROFILE environment variable is set.

Time spent fetching tied variables, $DBI::errstr, is counted.

Time spent in FETCH for $h->{Profile} is not counted, so getting the profile
data doesn't alter it.

DBI::PurePerl does not support profiling (though it could in theory).

For asynchronous queries, time spent while the query is running on the
backend is not counted.

A few platforms don't support the gettimeofday() high resolution
time function used by the DBI (and available via the dbi_time() function).
In which case you'll get integer resolution time which is mostly useless.

On Windows platforms the dbi_time() function is limited to millisecond
resolution. Which isn't sufficiently fine for our needs, but still
much better than integer resolution. This limited resolution means
that fast method calls will often register as taking 0 time. And
timings in general will have much more 'jitter' depending on where
within the 'current millisecond' the start and end timing was taken.

This documentation could be more clear. Probably needs to be reordered
to start with several examples and build from there.  Trying to
explain the concepts first seems painful and to lead to just as
many forward references.  (Patches welcome!)

=cut


use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
use Exporter ();
use UNIVERSAL ();
use Carp;

use DBI qw(dbi_time dbi_profile dbi_profile_merge_nodes dbi_profile_merge);

$VERSION = "2.015065";

@ISA = qw(Exporter);
@EXPORT = qw(
    DBIprofile_Statement
    DBIprofile_MethodName
    DBIprofile_MethodClass
    dbi_profile
    dbi_profile_merge_nodes
    dbi_profile_merge
    dbi_time
);
@EXPORT_OK = qw(
    format_profile_thingy
);

use constant DBIprofile_Statement	=> '!Statement';
use constant DBIprofile_MethodName	=> '!MethodName';
use constant DBIprofile_MethodClass	=> '!MethodClass';

our $ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) };
our $ON_FLUSH_DUMP   = sub { DBI->trace_msg(shift, 0) };

sub new {
    my $class = shift;
    my $profile = { @_ };
    return bless $profile => $class;
}


sub _auto_new {
    my $class = shift;
    my ($arg) = @_;

    # This sub is called by DBI internals when a non-hash-ref is
    # assigned to the Profile attribute. For example
    #	dbi:mysql(RaiseError=>1,Profile=>!Statement:!MethodName/DBIx::MyProfile/arg1:arg2):dbname
    # This sub works out what to do and returns a suitable hash ref.

    $arg =~ s/^DBI::/2\/DBI::/
        and carp "Automatically changed old-style DBI::Profile specification to $arg";

    # it's a path/module/k1:v1:k2:v2:... list
    my ($path, $package, $args) = split /\//, $arg, 3;
    my @args = (defined $args) ? split(/:/, $args, -1) : ();
    my @Path;

    for my $element (split /:/, $path) {
        if (DBI::looks_like_number($element)) {
            my $reverse = ($element < 0) ? ($element=-$element, 1) : 0;
            my @p;
            # a single "DBI" is special-cased in format()
            push @p, "DBI"			if $element & 0x01;
            push @p, DBIprofile_Statement	if $element & 0x02;
            push @p, DBIprofile_MethodName	if $element & 0x04;
            push @p, DBIprofile_MethodClass	if $element & 0x08;
            push @p, '!Caller2'            	if $element & 0x10;
            push @Path, ($reverse ? reverse @p : @p);
        }
        elsif ($element =~ m/^&(\w.*)/) {
            my $name = "DBI::ProfileSubs::$1"; # capture $1 early
            require DBI::ProfileSubs;
            my $code = do { no strict; *{$name}{CODE} };
            if (defined $code) {
                push @Path, $code;
            }
            else {
                warn "$name: subroutine not found\n";
                push @Path, $element;
            }
        }
        else {
            push @Path, $element;
        }
    }

    eval "require $package" if $package; # silently ignores errors
    $package ||= $class;

    return $package->new(Path => \@Path, @args);
}


sub empty {             # empty out profile data
    my $self = shift;
    DBI->trace_msg("profile data discarded\n",0) if $self->{Trace};
    $self->{Data} = undef;
}

sub filename {          # baseclass method, see DBI::ProfileDumper
    return undef;
}

sub flush_to_disk {     # baseclass method, see DBI::ProfileDumper & DashProfiler::Core
    my $self = shift;
    return unless $ON_FLUSH_DUMP;
    return unless $self->{Data};
    my $detail = $self->format();
    $ON_FLUSH_DUMP->($detail) if $detail;
}


sub as_node_path_list {
    my ($self, $node, $path) = @_;
    # convert the tree into an array of arrays
    # from
    #   {key1a}{key2a}[node1]
    #   {key1a}{key2b}[node2]
    #   {key1b}{key2a}{key3a}[node3]
    # to
    #   [ [node1], 'key1a', 'key2a' ]
    #   [ [node2], 'key1a', 'key2b' ]
    #   [ [node3], 'key1b', 'key2a', 'key3a' ]

    $node ||= $self->{Data} or return;
    $path ||= [];
    if (ref $node eq 'HASH') {    # recurse
        $path = [ @$path, undef ];
        return map {
            $path->[-1] = $_;
            ($node->{$_}) ? $self->as_node_path_list($node->{$_}, $path) : ()
        } sort keys %$node;
    }
    return [ $node, @$path ];
}


sub as_text {
    my ($self, $args_ref) = @_;
    my $separator = $args_ref->{separator} || " > ";
    my $format_path_element = $args_ref->{format_path_element}
        || "%s"; # or e.g., " key%2$d='%s'"
    my $format    = $args_ref->{format}
        || '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";

    my @node_path_list = $self->as_node_path_list(undef, $args_ref->{path});

    $args_ref->{sortsub}->(\@node_path_list) if $args_ref->{sortsub};

    my $eval = "qr/".quotemeta($separator)."/";
    my $separator_re = eval($eval) || quotemeta($separator);
    #warn "[$eval] = [$separator_re]";
    my @text;
    my @spare_slots = (undef) x 7;
    for my $node_path (@node_path_list) {
        my ($node, @path) = @$node_path;
        my $idx = 0;
        for (@path) {
            s/[\r\n]+/ /g;
            s/$separator_re/ /g;
            $_ = sprintf $format_path_element, $_, ++$idx;
        }
        push @text, sprintf $format,
            join($separator, @path),                  # 1=path
            ($node->[0] ? $node->[1]/$node->[0] : 0), # 2=avg
            @spare_slots,
            @$node; # 10=count, 11=dur, 12=first_dur, 13=min, 14=max, 15=first_called, 16=last_called
    }
    return @text if wantarray;
    return join "", @text;
}


sub format {
    my $self = shift;
    my $class = ref($self) || $self;

    my $prologue = "$class: ";
    my $detail = $self->format_profile_thingy(
	$self->{Data}, 0, "    ",
	my $path = [],
	my $leaves = [],
    )."\n";

    if (@$leaves) {
	dbi_profile_merge_nodes(my $totals=[], @$leaves);
	my ($count, $time_in_dbi, undef, undef, undef, $t1, $t2) = @$totals;
	(my $progname = $0) =~ s:.*/::;
	if ($count) {
	    $prologue .= sprintf "%fs ", $time_in_dbi;
	    my $perl_time = ($DBI::PERL_ENDING) ? time() - $^T : $t2-$t1;
	    $prologue .= sprintf "%.2f%% ", $time_in_dbi/$perl_time*100 if $perl_time;
	    my @lt = localtime(time);
	    my $ts = sprintf "%d-%02d-%02d %02d:%02d:%02d",
		1900+$lt[5], $lt[4]+1, @lt[3,2,1,0];
	    $prologue .= sprintf "(%d calls) $progname \@ $ts\n", $count;
	}
	if (@$leaves == 1 && ref($self->{Data}) eq 'HASH' && $self->{Data}->{DBI}) {
	    $detail = "";	# hide the "DBI" from DBI_PROFILE=1
	}
    }
    return ($prologue, $detail) if wantarray;
    return $prologue.$detail;
}


sub format_profile_leaf {
    my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
    croak "format_profile_leaf called on non-leaf ($thingy)"
	unless UNIVERSAL::isa($thingy,'ARRAY');

    push @$leaves, $thingy if $leaves;
    my ($count, $total_time, $first_time, $min, $max, $first_called, $last_called) = @$thingy;
    return sprintf "%s%fs\n", ($pad x $depth), $total_time
	if $count <= 1;
    return sprintf "%s%fs / %d = %fs avg (first %fs, min %fs, max %fs)\n",
	($pad x $depth), $total_time, $count, $count ? $total_time/$count : 0,
	$first_time, $min, $max;
}


sub format_profile_branch {
    my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
    croak "format_profile_branch called on non-branch ($thingy)"
	unless UNIVERSAL::isa($thingy,'HASH');
    my @chunk;
    my @keys = sort keys %$thingy;
    while ( @keys ) {
	my $k = shift @keys;
	my $v = $thingy->{$k};
	push @$path, $k;
	push @chunk, sprintf "%s'%s' =>\n%s",
	    ($pad x $depth), $k,
	    $self->format_profile_thingy($v, $depth+1, $pad, $path, $leaves);
	pop @$path;
    }
    return join "", @chunk;
}


sub format_profile_thingy {
    my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
    return "undef" if not defined $thingy;
    return $self->format_profile_leaf(  $thingy, $depth, $pad, $path, $leaves)
	if UNIVERSAL::isa($thingy,'ARRAY');
    return $self->format_profile_branch($thingy, $depth, $pad, $path, $leaves)
	if UNIVERSAL::isa($thingy,'HASH');
    return "$thingy\n";
}


sub on_destroy {
    my $self = shift;
    return unless $ON_DESTROY_DUMP;
    return unless $self->{Data};
    my $detail = $self->format();
    $ON_DESTROY_DUMP->($detail) if $detail;
    $self->{Data} = undef;
}

sub DESTROY {
    my $self = shift;
    local $@;
    DBI->trace_msg("profile data DESTROY\n",0)
        if (($self->{Trace}||0) >= 2);
    eval { $self->on_destroy };
    if ($@) {
        chomp $@;
        my $class = ref($self) || $self;
        DBI->trace_msg("$class on_destroy failed: $@", 0);
    }
}

1;