← Back to branch summary

~percona-toolkit-dev/percona-toolkit/mysql-5.6-test-fixes

« back to all changes in this revision

Viewing changes to lib/EventTimeline.pm

  • Committer: Daniel Nichter
  • Date: 2011-06-24 17:22:06 UTC
  • Revision ID: daniel@percona.com-20110624172206-c7q4s4ad6r260zz6
Add lib/, t/lib/, and sandbox/.  All modules are updated and passing on MySQL 5.1.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/EventTimeline.pm
 
1
# This program is copyright 2008-2011 Percona Inc.
 
2
# Feedback and improvements are welcome.
 
3
#
 
4
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
 
5
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
 
6
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
7
#
 
8
# This program is free software; you can redistribute it and/or modify it under
 
9
# the terms of the GNU General Public License as published by the Free Software
 
10
# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
 
11
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
 
12
# licenses.
 
13
#
 
14
# You should have received a copy of the GNU General Public License along with
 
15
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
 
16
# Place, Suite 330, Boston, MA  02111-1307  USA.
 
17
 
 
18
# ###########################################################################
 
19
# EventTimeline package $Revision: 6590 $
 
20
# ###########################################################################
 
21
 
 
22
# Package: EventTimeLine
 
23
# EventTimeLine aggregates events that are adjacent to each other.
 
24
{
 
25
package EventTimeline;
 
26
 
 
27
use strict;
 
28
use warnings FATAL => 'all';
 
29
use English qw(-no_match_vars);
 
30
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
31
 
 
32
Transformers->import(qw(parse_timestamp secs_to_time unix_timestamp));
 
33
 
 
34
use constant KEY     => 0;
 
35
use constant CNT     => 1;
 
36
use constant ATT     => 2;
 
37
 
 
38
# The best way to see how to use this is to look at the .t file.
 
39
#
 
40
# %args is a hash containing:
 
41
# groupby      An arrayref of names of properties to group/aggregate by.
 
42
# attributes   An arrayref of names of properties to aggregate.
 
43
#              Aggregation keeps the min, max and sum if it's a numeric
 
44
#              attribute.
 
45
sub new {
 
46
   my ( $class, %args ) = @_;
 
47
   foreach my $arg ( qw(groupby attributes) ) {
 
48
      die "I need a $arg argument" unless $args{$arg};
 
49
   }
 
50
 
 
51
   my %is_groupby = map { $_ => 1 } @{$args{groupby}};
 
52
 
 
53
   return bless {
 
54
      groupby    => $args{groupby},
 
55
      attributes => [ grep { !$is_groupby{$_} } @{$args{attributes}} ],
 
56
      results    => [],
 
57
   }, $class;
 
58
}
 
59
 
 
60
# Reset the aggregated data, but not anything the code has learned about
 
61
# incoming data.
 
62
sub reset_aggregated_data {
 
63
   my ( $self ) = @_;
 
64
   $self->{results} = [];
 
65
}
 
66
 
 
67
# Aggregate an event hashref's properties.
 
68
sub aggregate {
 
69
   my ( $self, $event ) = @_;
 
70
   my $handler = $self->{handler};
 
71
   if ( !$handler ) {
 
72
      $handler = $self->make_handler($event);
 
73
      $self->{handler} = $handler;
 
74
   }
 
75
   return unless $handler;
 
76
   $handler->($event);
 
77
}
 
78
 
 
79
# Return the aggregated results.
 
80
sub results {
 
81
   my ( $self ) = @_;
 
82
   return $self->{results};
 
83
}
 
84
 
 
85
# Make subroutines that do things with events.
 
86
#
 
87
# $event:  a sample event
 
88
#
 
89
# Return value:
 
90
# a subroutine with this signature:
 
91
#    my ( $event ) = @_;
 
92
sub make_handler {
 
93
   my ( $self, $event ) = @_;
 
94
 
 
95
   # Ripped off from Regexp::Common::number.
 
96
   my $float_re = qr{[+-]?(?:(?=\d|[.])\d*(?:[.])\d{0,})?(?:[E](?:[+-]?\d+)|)}i;
 
97
   my @lines; # lines of code for the subroutine
 
98
 
 
99
   foreach my $attrib ( @{$self->{attributes}} ) {
 
100
      my ($val) = $event->{$attrib};
 
101
      next unless defined $val; # Can't decide type if it's undef.
 
102
 
 
103
      my $type = $val  =~ m/^(?:\d+|$float_re)$/o ? 'num'
 
104
               : $val  =~ m/^(?:Yes|No)$/         ? 'bool'
 
105
               :                                    'string';
 
106
      MKDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')');
 
107
      $self->{type_for}->{$attrib} = $type;
 
108
 
 
109
      push @lines, (
 
110
         "\$val = \$event->{$attrib};",
 
111
         'defined $val && do {',
 
112
         "# type: $type",
 
113
         "\$store = \$last->[ATT]->{$attrib} ||= {};",
 
114
      );
 
115
 
 
116
      if ( $type eq 'bool' ) {
 
117
         push @lines, q{$val = $val eq 'Yes' ? 1 : 0;};
 
118
         $type = 'num';
 
119
      }
 
120
      my $op   = $type eq 'num' ? '<' : 'lt';
 
121
      push @lines, (
 
122
         '$store->{min} = $val if !defined $store->{min} || $val '
 
123
            . $op . ' $store->{min};',
 
124
      );
 
125
      $op = ($type eq 'num') ? '>' : 'gt';
 
126
      push @lines, (
 
127
         '$store->{max} = $val if !defined $store->{max} || $val '
 
128
            . $op . ' $store->{max};',
 
129
      );
 
130
      if ( $type eq 'num' ) {
 
131
         push @lines, '$store->{sum} += $val;';
 
132
      }
 
133
      push @lines, '};';
 
134
   }
 
135
 
 
136
   # Build a subroutine with the code.
 
137
   unshift @lines, (
 
138
      'sub {',
 
139
      'my ( $event ) = @_;',
 
140
      'my ($val, $last, $store);', # NOTE: define all variables here
 
141
      '$last = $results->[-1];',
 
142
      'if ( !$last || '
 
143
         . join(' || ',
 
144
            map { "\$last->[KEY]->[$_] ne (\$event->{$self->{groupby}->[$_]} || 0)" }
 
145
                (0 .. @{$self->{groupby}} -1))
 
146
         . ' ) {',
 
147
      '  $last = [['
 
148
         . join(', ',
 
149
            map { "(\$event->{$self->{groupby}->[$_]} || 0)" }
 
150
                (0 .. @{$self->{groupby}} -1))
 
151
         . '], 0, {} ];',
 
152
      '  push @$results, $last;',
 
153
      '}',
 
154
      '++$last->[CNT];',
 
155
   );
 
156
   push @lines, '}';
 
157
   my $results = $self->{results}; # Referred to by the eval
 
158
   my $code = join("\n", @lines);
 
159
   $self->{code} = $code;
 
160
 
 
161
   MKDEBUG && _d('Timeline handler:', $code);
 
162
   my $sub = eval $code;
 
163
   die if $EVAL_ERROR;
 
164
   return $sub;
 
165
}
 
166
 
 
167
sub report {
 
168
   my ( $self, $results, $callback ) = @_;
 
169
   $callback->("# " . ('#' x 72) . "\n");
 
170
   $callback->("# " . join(',', @{$self->{groupby}}) . " report\n");
 
171
   $callback->("# " . ('#' x 72) . "\n");
 
172
   foreach my $res ( @$results ) {
 
173
      my $t;
 
174
      my @vals;
 
175
      if ( ($t = $res->[ATT]->{ts}) && $t->{min} ) {
 
176
         my $min = parse_timestamp($t->{min});
 
177
         push @vals, $min;
 
178
         if ( $t->{max} && $t->{max} gt $t->{min} ) {
 
179
            my $max  = parse_timestamp($t->{max});
 
180
            my $diff = secs_to_time(unix_timestamp($max) - unix_timestamp($min));
 
181
            push @vals, $diff;
 
182
         }
 
183
         else {
 
184
            push @vals, '0:00';
 
185
         }
 
186
      }
 
187
      else {
 
188
         push @vals, ('', '');
 
189
      }
 
190
      $callback->(sprintf("# %19s %7s %3d %s\n", @vals, $res->[CNT], $res->[KEY]->[0]));
 
191
   }
 
192
}
 
193
 
 
194
sub _d {
 
195
   my ($package, undef, $line) = caller 0;
 
196
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
 
197
        map { defined $_ ? $_ : 'undef' }
 
198
        @_;
 
199
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
 
200
}
 
201
 
 
202
1;
 
203
}
 
204
# ###########################################################################
 
205
# End EventTimeline package
 
206
# ###########################################################################