home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Timing.pm < prev    next >
Encoding:
Perl POD Document  |  2002-12-13  |  1.4 KB  |  65 lines
  1. #
  2. # Package meta, adds meta database commands to dbish
  3. #
  4. package DBI::Shell::Timing;
  5.  
  6. use strict;
  7. use vars qw(@ISA $VERSION);
  8. use Benchmark qw(timeit timestr);
  9.  
  10. $VERSION = sprintf( "%d.%02d", q$Revision: 11.91 $ =~ /(\d+)\.(\d+)/ );
  11.  
  12. sub init {
  13.     my ($self, $sh, @arg)  = @_;
  14.  
  15.  
  16.     $sh->install_options( 
  17.     [
  18.         [ 'timing_style'     => qq{auto}        ],
  19.         [ 'timing_timing'    => 1            ],  # Set the default to on
  20.         [ 'timing_format'    => '5.2f'        ],
  21.         [ 'timing_prefix'    => 'Elapsed: '    ],
  22.     ]);
  23.     my $com_ref = $sh->{commands};
  24.     $com_ref->{timing}        = { 
  25.         hint => 
  26.             "timing: on/off (1/0) display execute time upon completion of command",
  27.     };
  28.         
  29.     return $self;
  30. }
  31.  
  32. sub do_timing {
  33.     my $self = shift;
  34.     if (@_) {
  35.         my $t = shift;
  36.         # $self->log( qq{timing called with $t} );
  37.         $t = 0 if ($t =~ m/off|stop|end/i);
  38.         $t = 1 if ($t =~ m/on|start|begin/i);
  39.         $self->{timing_timing} = ($t?1:0);
  40.     }
  41.     $self->print_buffer(qq{timing: } . ($self->{timing_timing}? 'on': 'off'));
  42. return $self->{timing_timing};
  43. }
  44.  
  45.  
  46. #
  47. # Subclass the do_go command to include the timing options.  I'm not
  48. # sure which is better, to subclass this command or completely
  49. # override it.
  50. #
  51. sub do_go {
  52.     my $self = shift;
  53.     my $rv = timeit( 1, sub { $self->DBI::Shell::Base::do_go( @_ ) } );
  54.     if ($self->{timing_timing}) {
  55.         my $str = $self->{timing_prefix} . 
  56.             timestr( $rv, $self->{timing_style}, $self->{timing_format} );
  57.         $self->log( $str );
  58.     }
  59.     return;
  60. }
  61.  
  62. my $_unimp = qq{timing: not implemented yet};
  63.  
  64. 1;
  65.