File Coverage

blib/lib/DBI/Shell/Timing.pm
Criterion Covered Total %
statement 29 29 100.0
branch 12 12 100.0
condition n/a
subroutine 7 7 100.0
pod 0 3 0.0
total 48 51 94.1


line stmt bran cond sub pod time code
1             #
2             # Package meta, adds meta database commands to dbish
3             #
4             package DBI::Shell::Timing;
5              
6             our $VERSION = '11.96_03'; # TRIAL VERSION
7             $VERSION = eval $VERSION;
8              
9 4     4   30 use strict;
  4         9  
  4         169  
10 4     4   24 use vars qw(@ISA);
  4         7  
  4         212  
11 4     4   2288 use Benchmark qw(timeit timestr);
  4         27750  
  4         29  
12              
13             sub init {
14 4     4 0 17 my ($self, $sh, @arg) = @_;
15              
16              
17 4         56 $sh->install_options(
18             [
19             [ 'timing_style' => qq{auto} ],
20             [ 'timing_timing' => 1 ], # Set the default to on
21             [ 'timing_format' => '5.2f' ],
22             [ 'timing_prefix' => 'Elapsed: ' ],
23             ]);
24 4         17 my $com_ref = $sh->{commands};
25             $com_ref->{timing} = {
26 4         18 hint =>
27             "timing: on/off (1/0) display execute time upon completion of command",
28             };
29            
30 4         16 return $self;
31             }
32              
33             sub do_timing {
34 19     19 0 39 my $self = shift;
35 19 100       47 if (@_) {
36 8         16 my $t = shift;
37             # $self->log( qq{timing called with $t} );
38 8 100       50 $t = 0 if ($t =~ m/off|stop|end/i);
39 8 100       34 $t = 1 if ($t =~ m/on|start|begin/i);
40 8 100       25 $self->{timing_timing} = ($t?1:0);
41             }
42 19 100       96 $self->print_buffer(qq{timing: } . ($self->{timing_timing}? 'on': 'off'));
43 19         157 return $self->{timing_timing};
44             }
45              
46              
47             #
48             # Subclass the do_go command to include the timing options. I'm not
49             # sure which is better, to subclass this command or completely
50             # override it.
51             #
52             sub do_go {
53 40     40 0 111 my $self = shift;
54 40     40   301 my $rv = timeit( 1, sub { $self->DBI::Shell::Base::do_go( @_ ) } );
  40         599475  
55 40 100       4211 if ($self->{timing_timing}) {
56             my $str = $self->{timing_prefix} .
57 39         167 timestr( $rv, $self->{timing_style}, $self->{timing_format} );
58 39         3221 $self->log( $str );
59             }
60 40         418 return;
61             }
62              
63             my $_unimp = qq{timing: not implemented yet};
64              
65             1;