← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-password-comma-bug-886077

« back to all changes in this revision

Viewing changes to bin/pt-tcp-model

  • Committer: Daniel Nichter
  • Date: 2012-02-07 20:10:11 UTC
  • mfrom: (174 2.0)
  • mto: This revision was merged to the branch mainline in revision 189.
  • Revision ID: daniel@percona.com-20120207201011-sok2c1f2ay9qr3gm
Merge trunk r174.

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/pt-tcp-model
6
6
 
7
7
use strict;
8
8
use warnings FATAL => 'all';
9
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
9
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
10
10
 
11
11
# ###########################################################################
12
12
# OptionParser package
22
22
use strict;
23
23
use warnings FATAL => 'all';
24
24
use English qw(-no_match_vars);
25
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
25
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
26
26
 
27
27
use List::Util qw(max);
28
28
use Getopt::Long;
106
106
   my $contents = do { local $/ = undef; <$fh> };
107
107
   close $fh;
108
108
   if ( $contents =~ m/^=head1 DSN OPTIONS/m ) {
109
 
      MKDEBUG && _d('Parsing DSN OPTIONS');
 
109
      PTDEBUG && _d('Parsing DSN OPTIONS');
110
110
      my $dsn_attribs = {
111
111
         dsn  => 1,
112
112
         copy => 1,
148
148
      $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts);
149
149
   }
150
150
 
151
 
   if ( $contents =~ m/^(Percona Toolkit v.+)$/m ) {
 
151
   if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) {
152
152
      $self->{version} = $1;
153
 
      MKDEBUG && _d($self->{version});
 
153
      PTDEBUG && _d($self->{version});
154
154
   }
155
155
 
156
156
   return;
187
187
      chomp $para;
188
188
      $para =~ s/\s+/ /g;
189
189
      $para =~ s/$POD_link_re/$1/go;
190
 
      MKDEBUG && _d('Option rule:', $para);
 
190
      PTDEBUG && _d('Option rule:', $para);
191
191
      push @rules, $para;
192
192
   }
193
193
 
196
196
   do {
197
197
      if ( my ($option) = $para =~ m/^=item $self->{item}/ ) {
198
198
         chomp $para;
199
 
         MKDEBUG && _d($para);
 
199
         PTDEBUG && _d($para);
200
200
         my %attribs;
201
201
 
202
202
         $para = <$fh>; # read next paragraph, possibly attributes
215
215
            $para = <$fh>; # read next paragraph, probably short help desc
216
216
         }
217
217
         else {
218
 
            MKDEBUG && _d('Option has no attributes');
 
218
            PTDEBUG && _d('Option has no attributes');
219
219
         }
220
220
 
221
221
         $para =~ s/\s+\Z//g;
223
223
         $para =~ s/$POD_link_re/$1/go;
224
224
 
225
225
         $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s;
226
 
         MKDEBUG && _d('Short help:', $para);
 
226
         PTDEBUG && _d('Short help:', $para);
227
227
 
228
228
         die "No description after option spec $option" if $para =~ m/^=item/;
229
229
 
261
261
 
262
262
   foreach my $opt ( @specs ) {
263
263
      if ( ref $opt ) { # It's an option spec, not a rule.
264
 
         MKDEBUG && _d('Parsing opt spec:',
 
264
         PTDEBUG && _d('Parsing opt spec:',
265
265
            map { ($_, '=>', $opt->{$_}) } keys %$opt);
266
266
 
267
267
         my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
274
274
         $self->{opts}->{$long} = $opt;
275
275
 
276
276
         if ( length $long == 1 ) {
277
 
            MKDEBUG && _d('Long opt', $long, 'looks like short opt');
 
277
            PTDEBUG && _d('Long opt', $long, 'looks like short opt');
278
278
            $self->{short_opts}->{$long} = $long;
279
279
         }
280
280
 
300
300
 
301
301
         my ( $type ) = $opt->{spec} =~ m/=(.)/;
302
302
         $opt->{type} = $type;
303
 
         MKDEBUG && _d($long, 'type:', $type);
 
303
         PTDEBUG && _d($long, 'type:', $type);
304
304
 
305
305
 
306
306
         $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ );
307
307
 
308
308
         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
309
309
            $self->{defaults}->{$long} = defined $def ? $def : 1;
310
 
            MKDEBUG && _d($long, 'default:', $def);
 
310
            PTDEBUG && _d($long, 'default:', $def);
311
311
         }
312
312
 
313
313
         if ( $long eq 'config' ) {
316
316
 
317
317
         if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) {
318
318
            $disables{$long} = $dis;
319
 
            MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
 
319
            PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
320
320
         }
321
321
 
322
322
         $self->{opts}->{$long} = $opt;
323
323
      }
324
324
      else { # It's an option rule, not a spec.
325
 
         MKDEBUG && _d('Parsing rule:', $opt); 
 
325
         PTDEBUG && _d('Parsing rule:', $opt); 
326
326
         push @{$self->{rules}}, $opt;
327
327
         my @participants = $self->_get_participants($opt);
328
328
         my $rule_ok = 0;
330
330
         if ( $opt =~ m/mutually exclusive|one and only one/ ) {
331
331
            $rule_ok = 1;
332
332
            push @{$self->{mutex}}, \@participants;
333
 
            MKDEBUG && _d(@participants, 'are mutually exclusive');
 
333
            PTDEBUG && _d(@participants, 'are mutually exclusive');
334
334
         }
335
335
         if ( $opt =~ m/at least one|one and only one/ ) {
336
336
            $rule_ok = 1;
337
337
            push @{$self->{atleast1}}, \@participants;
338
 
            MKDEBUG && _d(@participants, 'require at least one');
 
338
            PTDEBUG && _d(@participants, 'require at least one');
339
339
         }
340
340
         if ( $opt =~ m/default to/ ) {
341
341
            $rule_ok = 1;
342
342
            $self->{defaults_to}->{$participants[0]} = $participants[1];
343
 
            MKDEBUG && _d($participants[0], 'defaults to', $participants[1]);
 
343
            PTDEBUG && _d($participants[0], 'defaults to', $participants[1]);
344
344
         }
345
345
         if ( $opt =~ m/restricted to option groups/ ) {
346
346
            $rule_ok = 1;
354
354
         if( $opt =~ m/accepts additional command-line arguments/ ) {
355
355
            $rule_ok = 1;
356
356
            $self->{strict} = 0;
357
 
            MKDEBUG && _d("Strict mode disabled by rule");
 
357
            PTDEBUG && _d("Strict mode disabled by rule");
358
358
         }
359
359
 
360
360
         die "Unrecognized option rule: $opt" unless $rule_ok;
364
364
   foreach my $long ( keys %disables ) {
365
365
      my @participants = $self->_get_participants($disables{$long});
366
366
      $self->{disables}->{$long} = \@participants;
367
 
      MKDEBUG && _d('Option', $long, 'disables', @participants);
 
367
      PTDEBUG && _d('Option', $long, 'disables', @participants);
368
368
   }
369
369
 
370
370
   return; 
378
378
         unless exists $self->{opts}->{$long};
379
379
      push @participants, $long;
380
380
   }
381
 
   MKDEBUG && _d('Participants for', $str, ':', @participants);
 
381
   PTDEBUG && _d('Participants for', $str, ':', @participants);
382
382
   return @participants;
383
383
}
384
384
 
401
401
      die "Cannot set default for nonexistent option $long"
402
402
         unless exists $self->{opts}->{$long};
403
403
      $self->{defaults}->{$long} = $defaults{$long};
404
 
      MKDEBUG && _d('Default val for', $long, ':', $defaults{$long});
 
404
      PTDEBUG && _d('Default val for', $long, ':', $defaults{$long});
405
405
   }
406
406
   return;
407
407
}
430
430
      $opt->{value} = $val;
431
431
   }
432
432
   $opt->{got} = 1;
433
 
   MKDEBUG && _d('Got option', $long, '=', $val);
 
433
   PTDEBUG && _d('Got option', $long, '=', $val);
434
434
}
435
435
 
436
436
sub get_opts {
461
461
            if ( $self->got('config') ) {
462
462
               die $EVAL_ERROR;
463
463
            }
464
 
            elsif ( MKDEBUG ) {
 
464
            elsif ( PTDEBUG ) {
465
465
               _d($EVAL_ERROR);
466
466
            }
467
467
         }
528
528
            if ( exists $self->{disables}->{$long} ) {
529
529
               my @disable_opts = @{$self->{disables}->{$long}};
530
530
               map { $self->{opts}->{$_}->{value} = undef; } @disable_opts;
531
 
               MKDEBUG && _d('Unset options', @disable_opts,
 
531
               PTDEBUG && _d('Unset options', @disable_opts,
532
532
                  'because', $long,'disables them');
533
533
            }
534
534
 
577
577
            delete $long[$i];
578
578
         }
579
579
         else {
580
 
            MKDEBUG && _d('Temporarily failed to parse', $long);
 
580
            PTDEBUG && _d('Temporarily failed to parse', $long);
581
581
         }
582
582
      }
583
583
 
601
601
   my $val = $opt->{value};
602
602
 
603
603
   if ( $val && $opt->{type} eq 'm' ) {  # type time
604
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
 
604
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
605
605
      my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
606
606
      if ( !$suffix ) {
607
607
         my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/;
608
608
         $suffix = $s || 's';
609
 
         MKDEBUG && _d('No suffix given; using', $suffix, 'for',
 
609
         PTDEBUG && _d('No suffix given; using', $suffix, 'for',
610
610
            $opt->{long}, '(value:', $val, ')');
611
611
      }
612
612
      if ( $suffix =~ m/[smhd]/ ) {
615
615
              : $suffix eq 'h' ? $num * 3600     # Hours
616
616
              :                  $num * 86400;   # Days
617
617
         $opt->{value} = ($prefix || '') . $val;
618
 
         MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
 
618
         PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
619
619
      }
620
620
      else {
621
621
         $self->save_error("Invalid time suffix for --$opt->{long}");
622
622
      }
623
623
   }
624
624
   elsif ( $val && $opt->{type} eq 'd' ) {  # type DSN
625
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
 
625
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
626
626
      my $prev = {};
627
627
      my $from_key = $self->{defaults_to}->{ $opt->{long} };
628
628
      if ( $from_key ) {
629
 
         MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
 
629
         PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
630
630
         if ( $self->{opts}->{$from_key}->{parsed} ) {
631
631
            $prev = $self->{opts}->{$from_key}->{value};
632
632
         }
633
633
         else {
634
 
            MKDEBUG && _d('Cannot parse', $opt->{long}, 'until',
 
634
            PTDEBUG && _d('Cannot parse', $opt->{long}, 'until',
635
635
               $from_key, 'parsed');
636
636
            return;
637
637
         }
640
640
      $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
641
641
   }
642
642
   elsif ( $val && $opt->{type} eq 'z' ) {  # type size
643
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
 
643
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
644
644
      $self->_parse_size($opt, $val);
645
645
   }
646
646
   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
650
650
      $opt->{value} = [ split(/(?<!\\),\s*/, ($val || '')) ];
651
651
   }
652
652
   else {
653
 
      MKDEBUG && _d('Nothing to validate for option',
 
653
      PTDEBUG && _d('Nothing to validate for option',
654
654
         $opt->{long}, 'type', $opt->{type}, 'value', $val);
655
655
   }
656
656
 
724
724
   $file ||= $self->{file} || __FILE__;
725
725
 
726
726
   if ( !$self->{description} || !$self->{usage} ) {
727
 
      MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
 
727
      PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
728
728
      my %synop = $self->_parse_synopsis($file);
729
729
      $self->{description} ||= $synop{description};
730
730
      $self->{usage}       ||= $synop{usage};
731
 
      MKDEBUG && _d("Description:", $self->{description},
 
731
      PTDEBUG && _d("Description:", $self->{description},
732
732
         "\nUsage:", $self->{usage});
733
733
   }
734
734
 
943
943
   my ( $self, $opt, $val ) = @_;
944
944
 
945
945
   if ( lc($val || '') eq 'null' ) {
946
 
      MKDEBUG && _d('NULL size for', $opt->{long});
 
946
      PTDEBUG && _d('NULL size for', $opt->{long});
947
947
      $opt->{value} = 'null';
948
948
      return;
949
949
   }
953
953
   if ( defined $num ) {
954
954
      if ( $factor ) {
955
955
         $num *= $factor_for{$factor};
956
 
         MKDEBUG && _d('Setting option', $opt->{y},
 
956
         PTDEBUG && _d('Setting option', $opt->{y},
957
957
            'to num', $num, '* factor', $factor);
958
958
      }
959
959
      $opt->{value} = ($pre || '') . $num;
977
977
sub _parse_synopsis {
978
978
   my ( $self, $file ) = @_;
979
979
   $file ||= $self->{file} || __FILE__;
980
 
   MKDEBUG && _d("Parsing SYNOPSIS in", $file);
 
980
   PTDEBUG && _d("Parsing SYNOPSIS in", $file);
981
981
 
982
982
   local $INPUT_RECORD_SEPARATOR = '';  # read paragraphs
983
983
   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
990
990
      push @synop, $para;
991
991
   }
992
992
   close $fh;
993
 
   MKDEBUG && _d("Raw SYNOPSIS text:", @synop);
 
993
   PTDEBUG && _d("Raw SYNOPSIS text:", @synop);
994
994
   my ($usage, $desc) = @synop;
995
995
   die "The SYNOPSIS section in $file is not formatted properly"
996
996
      unless $usage && $desc;
1017
1017
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
1018
1018
}
1019
1019
 
1020
 
if ( MKDEBUG ) {
 
1020
if ( PTDEBUG ) {
1021
1021
   print '# ', $^X, ' ', $], "\n";
1022
1022
   if ( my $uname = `uname -a` ) {
1023
1023
      $uname =~ s/\s+/ /g;
1047
1047
use strict;
1048
1048
use warnings FATAL => 'all';
1049
1049
use English qw(-no_match_vars);
1050
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1050
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1051
1051
 
1052
1052
use Time::Local qw(timegm timelocal);
1053
1053
use Digest::MD5 qw(md5_hex);
1227
1227
         : $suffix eq 'h' ? $n * 3600     # Hours
1228
1228
         : $suffix eq 'd' ? $n * 86400    # Days
1229
1229
         :                  $n;           # default: Seconds
1230
 
      MKDEBUG && _d('ts is now - N[shmd]:', $n);
 
1230
      PTDEBUG && _d('ts is now - N[shmd]:', $n);
1231
1231
      return time - $n;
1232
1232
   }
1233
1233
   elsif ( $val =~ m/^\d{9,}/ ) {
1234
 
      MKDEBUG && _d('ts is already a unix timestamp');
 
1234
      PTDEBUG && _d('ts is already a unix timestamp');
1235
1235
      return $val;
1236
1236
   }
1237
1237
   elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) {
1238
 
      MKDEBUG && _d('ts is MySQL slow log timestamp');
 
1238
      PTDEBUG && _d('ts is MySQL slow log timestamp');
1239
1239
      $val .= ' 00:00:00' unless $hms;
1240
1240
      return unix_timestamp(parse_timestamp($val));
1241
1241
   }
1242
1242
   elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) {
1243
 
      MKDEBUG && _d('ts is properly formatted timestamp');
 
1243
      PTDEBUG && _d('ts is properly formatted timestamp');
1244
1244
      $val .= ' 00:00:00' unless $hms;
1245
1245
      return unix_timestamp($val);
1246
1246
   }
1247
1247
   else {
1248
 
      MKDEBUG && _d('ts is MySQL expression');
 
1248
      PTDEBUG && _d('ts is MySQL expression');
1249
1249
      return $callback->($val) if $callback && ref $callback eq 'CODE';
1250
1250
   }
1251
1251
 
1252
 
   MKDEBUG && _d('Unknown ts type:', $val);
 
1252
   PTDEBUG && _d('Unknown ts type:', $val);
1253
1253
   return;
1254
1254
}
1255
1255
 
1256
1256
sub make_checksum {
1257
1257
   my ( $val ) = @_;
1258
1258
   my $checksum = uc substr(md5_hex($val), -16);
1259
 
   MKDEBUG && _d($checksum, 'checksum for', $val);
 
1259
   PTDEBUG && _d($checksum, 'checksum for', $val);
1260
1260
   return $checksum;
1261
1261
}
1262
1262
 
1303
1303
use strict;
1304
1304
use warnings FATAL => 'all';
1305
1305
use English qw(-no_match_vars);
1306
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1306
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1307
1307
 
1308
1308
sub new {
1309
1309
   my ( $class, %args ) = @_;
1444
1444
use strict;
1445
1445
use warnings FATAL => 'all';
1446
1446
use English qw(-no_match_vars);
1447
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1447
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1448
1448
 
1449
1449
sub new {
1450
1450
   my ( $class, %args ) = @_;
1475
1475
 
1476
1476
   if ( !@filenames ) {
1477
1477
      push @final_filenames, '-';
1478
 
      MKDEBUG && _d('Auto-adding "-" to the list of filenames');
 
1478
      PTDEBUG && _d('Auto-adding "-" to the list of filenames');
1479
1479
   }
1480
1480
 
1481
 
   MKDEBUG && _d('Final filenames:', @final_filenames);
 
1481
   PTDEBUG && _d('Final filenames:', @final_filenames);
1482
1482
   return sub {
1483
1483
      while ( @final_filenames ) {
1484
1484
         my $fn = shift @final_filenames;
1485
 
         MKDEBUG && _d('Filename:', $fn);
 
1485
         PTDEBUG && _d('Filename:', $fn);
1486
1486
         if ( $fn eq '-' ) { # Magical STDIN filename.
1487
1487
            return (*STDIN, undef, undef);
1488
1488
         }
1523
1523
use strict;
1524
1524
use warnings FATAL => 'all';
1525
1525
use English qw(-no_match_vars);
1526
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1526
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1527
1527
 
1528
1528
use Time::Local qw(timelocal);
1529
1529
use Data::Dumper;
1608
1608
      $event->{port} = $src_port;
1609
1609
      $event->{arg}  = undef;
1610
1610
      delete $event->{status};
1611
 
      MKDEBUG && _d('Properties of event:', Dumper($event));
 
1611
      PTDEBUG && _d('Properties of event:', Dumper($event));
1612
1612
      return $event;
1613
1613
   }
1614
1614
   return undef;
1655
1655
use strict;
1656
1656
use warnings FATAL => 'all';
1657
1657
use English qw(-no_match_vars);
1658
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1658
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1659
1659
 
1660
1660
use List::Util qw(sum);
1661
1661
use Data::Dumper;
1691
1691
 
1692
1692
   EVENT:
1693
1693
   while ( 1 ) {
1694
 
      MKDEBUG && _d("Beginning a loop at pos", $pos_in_log);
 
1694
      PTDEBUG && _d("Beginning a loop at pos", $pos_in_log);
1695
1695
      my ( $id, $start, $elapsed );
1696
1696
 
1697
1697
      my ($timestamp, $direction);
1698
1698
      if ( $self->{pending} ) {
1699
1699
         ( $id, $start, $elapsed ) = @{$self->{pending}};
1700
 
         MKDEBUG && _d("Pulled from pending", @{$self->{pending}});
 
1700
         PTDEBUG && _d("Pulled from pending", @{$self->{pending}});
1701
1701
      }
1702
1702
      elsif ( defined(my $line = $next_event->()) ) {
1703
1703
         my ($end, $host_port);
1704
1704
         ( $id, $start, $end, $elapsed, $host_port ) = $line =~ m/(\S+)/g;
1705
1705
         @$buffer = sort { $a <=> $b } ( @$buffer, $end );
1706
 
         MKDEBUG && _d("Read from the file", $id, $start, $end, $elapsed, $host_port);
1707
 
         MKDEBUG && _d("Buffer is now", @$buffer);
 
1706
         PTDEBUG && _d("Read from the file", $id, $start, $end, $elapsed, $host_port);
 
1707
         PTDEBUG && _d("Buffer is now", @$buffer);
1708
1708
      }
1709
1709
      if ( $start ) { # Test that we got a line; $id can be 0.
1710
1710
         if ( @$buffer && $buffer->[0] < $start ) {
1712
1712
            $timestamp       = shift @$buffer;
1713
1713
            $self->{pending} = [ $id, $start, $elapsed ];
1714
1714
            $id = $start = $elapsed = undef;
1715
 
            MKDEBUG && _d("Completion: using buffered end value", $timestamp);
1716
 
            MKDEBUG && _d("Saving line to pending", @{$self->{pending}});
 
1715
            PTDEBUG && _d("Completion: using buffered end value", $timestamp);
 
1716
            PTDEBUG && _d("Saving line to pending", @{$self->{pending}});
1717
1717
         }
1718
1718
         else {
1719
1719
            $direction       = 'A'; # Arrival
1720
1720
            $timestamp       = $start;
1721
1721
            $self->{pending} = undef;
1722
 
            MKDEBUG && _d("Deleting pending line");
1723
 
            MKDEBUG && _d("Arrival: using the line");
 
1722
            PTDEBUG && _d("Deleting pending line");
 
1723
            PTDEBUG && _d("Arrival: using the line");
1724
1724
         }
1725
1725
      }
1726
1726
      elsif ( @$buffer ) {
1727
1727
         $direction = 'C';
1728
1728
         $timestamp = shift @$buffer;
1729
 
         MKDEBUG && _d("No more lines, reading from buffer", $timestamp);
 
1729
         PTDEBUG && _d("No more lines, reading from buffer", $timestamp);
1730
1730
      }
1731
1731
      else { # We hit EOF.
1732
 
         MKDEBUG && _d("No more lines, no more buffered end times");
 
1732
         PTDEBUG && _d("No more lines, no more buffered end times");
1733
1733
         if ( $self->{in_prg} ) {
1734
1734
            die "Error: no more lines, but in_prg = $self->{in_prg}";
1735
1735
         }
1736
1736
         if ( $self->{t_start} < $self->{current_ts} ) {
1737
 
            MKDEBUG && _d("Returning event based on what's been seen");
 
1737
            PTDEBUG && _d("Returning event based on what's been seen");
1738
1738
            return $self->make_event($self->{t_start}, $self->{current_ts});
1739
1739
         }
1740
1740
         else {
1741
 
            MKDEBUG && _d("No further events to make");
 
1741
            PTDEBUG && _d("No further events to make");
1742
1742
            return;
1743
1743
         }
1744
1744
      }
1745
1745
 
1746
1746
      my $t_start = int($timestamp / $self->{interval}) * $self->{interval};
1747
1747
      $self->{t_start} ||= $timestamp; # Not $t_start; that'd skew 1st interval.
1748
 
      MKDEBUG && _d("Timestamp", $timestamp, "interval start time", $t_start);
 
1748
      PTDEBUG && _d("Timestamp", $timestamp, "interval start time", $t_start);
1749
1749
 
1750
1750
      if ( $t_start > $self->{t_start} ) {
1751
 
         MKDEBUG && _d("Timestamp doesn't belong to this interval");
 
1751
         PTDEBUG && _d("Timestamp doesn't belong to this interval");
1752
1752
         if ( $self->{in_prg} ) {
1753
 
            MKDEBUG && _d("Computing from", $self->{current_ts}, "to", $t_start);
 
1753
            PTDEBUG && _d("Computing from", $self->{current_ts}, "to", $t_start);
1754
1754
            $self->{busy_time}     += $t_start - $self->{current_ts};
1755
1755
            $self->{weighted_time} += ($t_start - $self->{current_ts}) * $self->{in_prg};
1756
1756
         }
1772
1772
 
1773
1773
      else {
1774
1774
         if ( $self->{in_prg} ) {
1775
 
            MKDEBUG && _d("Computing from", $self->{current_ts}, "to", $timestamp);
 
1775
            PTDEBUG && _d("Computing from", $self->{current_ts}, "to", $timestamp);
1776
1776
            $self->{busy_time}     += $timestamp - $self->{current_ts};
1777
1777
            $self->{weighted_time} += ($timestamp - $self->{current_ts}) * $self->{in_prg};
1778
1778
         }
1779
1779
         $self->{current_ts} = $timestamp;
1780
1780
         if ( $direction eq 'A' ) {
1781
 
            MKDEBUG && _d("Direction A", $timestamp);
 
1781
            PTDEBUG && _d("Direction A", $timestamp);
1782
1782
            ++$self->{in_prg};
1783
1783
            if ( defined $elapsed ) {
1784
1784
               push @{$self->{response_times}}, $elapsed;
1785
1785
            }
1786
1786
         }
1787
1787
         else {
1788
 
            MKDEBUG && _d("Direction C", $timestamp);
 
1788
            PTDEBUG && _d("Direction C", $timestamp);
1789
1789
            --$self->{in_prg};
1790
1790
            ++$self->{completions};
1791
1791
         }
1851
1851
   $self->{last_completions}   = $self->{completions};
1852
1852
   $self->{response_times}     = [];
1853
1853
 
1854
 
   MKDEBUG && _d("Event is", Dumper($event));
 
1854
   PTDEBUG && _d("Event is", Dumper($event));
1855
1855
   return $event;
1856
1856
}
1857
1857
 
1888
1888
$Data::Dumper::Indent = 1;
1889
1889
$OUTPUT_AUTOFLUSH     = 1;
1890
1890
 
1891
 
use constant MKDEBUG        => $ENV{MKDEBUG}        || 0;
 
1891
use constant PTDEBUG        => $ENV{PTDEBUG}        || 0;
1892
1892
 
1893
1893
use sigtrap 'handler', \&sig_int, 'normal-signals';
1894
1894
 
1988
1988
         else {
1989
1989
            printf "%s %5.2f %9.3f %5d %5d %.6f %.6f %.6f %.6f %.6f %.6f\n",
1990
1990
               @{$event}{qw(
1991
 
                ts concurrency throughput arrivals completions res_time
 
1991
                ts concurrency throughput arrivals completions busy_time
1992
1992
                weighted_time sum_time variance_mean quantile_time obs_time)};
1993
1993
         }
1994
1994
         $pr->update($tell) if $pr;
2393
2393
 
2394
2394
=head1 COPYRIGHT, LICENSE, AND WARRANTY
2395
2395
 
2396
 
This program is copyright 2011 Baron Schwartz, 2011 Percona Inc.
 
2396
This program is copyright 2011 Baron Schwartz, 2011-2012 Percona Inc.
2397
2397
Feedback and improvements are welcome.
2398
2398
 
2399
2399
THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
2412
2412
 
2413
2413
=head1 VERSION
2414
2414
 
2415
 
Percona Toolkit v0.9.5 released 2011-08-04
 
2415
pt-tcp-model 2.0.3
2416
2416
 
2417
2417
=cut