← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-log-parser-writer-bug-963225

« back to all changes in this revision

Viewing changes to lib/GeneralLogParser.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/GeneralLogParser.pm
 
1
# This program is copyright 2009-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
# GeneralLogParser package $Revision: 7522 $
 
19
# ###########################################################################
 
20
 
 
21
# Package: GeneralLogParser
 
22
# GeneralLogParser parses MySQL general logs.
 
23
{
 
24
package GeneralLogParser;
 
25
 
 
26
use strict;
 
27
use warnings FATAL => 'all';
 
28
use English qw(-no_match_vars);
 
29
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
30
 
 
31
use Data::Dumper;
 
32
$Data::Dumper::Indent    = 1;
 
33
$Data::Dumper::Sortkeys  = 1;
 
34
$Data::Dumper::Quotekeys = 0;
 
35
 
 
36
sub new {
 
37
   my ( $class ) = @_;
 
38
   my $self = {
 
39
      pending => [],
 
40
      db_for  => {},
 
41
   };
 
42
   return bless $self, $class;
 
43
}
 
44
 
 
45
my $genlog_line_1= qr{
 
46
   \A
 
47
   (?:(\d{6}\s+\d{1,2}:\d\d:\d\d))? # Timestamp
 
48
   \s+
 
49
   (?:\s*(\d+))                     # Thread ID
 
50
   \s
 
51
   (\w+)                            # Command
 
52
   \s+
 
53
   (.*)                             # Argument
 
54
   \Z
 
55
}xs;
 
56
 
 
57
# This method accepts an open filehandle, a callback function, and a mode
 
58
# (slow, log, undef).  It reads events from the filehandle and calls the
 
59
# callback with each event.
 
60
sub parse_event {
 
61
   my ( $self, %args ) = @_;
 
62
   my @required_args = qw(next_event tell);
 
63
   foreach my $arg ( @required_args ) {
 
64
      die "I need a $arg argument" unless $args{$arg};
 
65
   }
 
66
   my ($next_event, $tell) = @args{@required_args};
 
67
 
 
68
   my $pending = $self->{pending};
 
69
   my $db_for  = $self->{db_for};
 
70
   my $line;
 
71
   my $pos_in_log = $tell->();
 
72
   LINE:
 
73
   while (
 
74
         defined($line = shift @$pending)
 
75
      or defined($line = $next_event->())
 
76
   ) {
 
77
      MKDEBUG && _d($line);
 
78
      my ($ts, $thread_id, $cmd, $arg) = $line =~ m/$genlog_line_1/;
 
79
      if ( !($thread_id && $cmd) ) {
 
80
         MKDEBUG && _d('Not start of general log event');
 
81
         next;
 
82
      }
 
83
      # Don't save cmd or arg yet, we may need to modify them later.
 
84
      my @properties = ('pos_in_log', $pos_in_log, 'ts', $ts,
 
85
         'Thread_id', $thread_id);
 
86
 
 
87
      $pos_in_log = $tell->();
 
88
 
 
89
      @$pending = ();
 
90
      if ( $cmd eq 'Query' ) {
 
91
         # There may be more lines to this query.  Read lines until
 
92
         # the next id/cmd is found.  Append these lines to this
 
93
         # event's arg, push the next id/cmd to pending.
 
94
         my $done = 0;
 
95
         do {
 
96
            $line = $next_event->();
 
97
            if ( $line ) {
 
98
               my (undef, $next_thread_id, $next_cmd)
 
99
                  = $line =~ m/$genlog_line_1/;
 
100
               if ( $next_thread_id && $next_cmd ) {
 
101
                  MKDEBUG && _d('Event done');
 
102
                  $done = 1;
 
103
                  push @$pending, $line;
 
104
               }
 
105
               else {
 
106
                  MKDEBUG && _d('More arg:', $line);
 
107
                  $arg .= $line;
 
108
               }
 
109
            }
 
110
            else {
 
111
               MKDEBUG && _d('No more lines');
 
112
               $done = 1;
 
113
            }
 
114
         } until ( $done );
 
115
 
 
116
         chomp $arg;
 
117
         push @properties, 'cmd', 'Query', 'arg', $arg;
 
118
         push @properties, 'bytes', length($properties[-1]);
 
119
         push @properties, 'db', $db_for->{$thread_id} if $db_for->{$thread_id};
 
120
      }
 
121
      else {
 
122
         # If it's not a query it's some admin command.
 
123
         push @properties, 'cmd', 'Admin';
 
124
 
 
125
         if ( $cmd eq 'Connect' ) {
 
126
            if ( $arg =~ m/^Access denied/ ) {
 
127
               # administrator command: Access denied for user ...
 
128
               $cmd = $arg;
 
129
            }
 
130
            else {
 
131
               # The Connect command may or may not be followed by 'on'.
 
132
               # When it is, 'on' may or may not be followed by a database.
 
133
               my ($user, undef, $db) = $arg =~ /(\S+)/g;
 
134
               my $host;
 
135
               ($user, $host) = split(/@/, $user);
 
136
               MKDEBUG && _d('Connect', $user, '@', $host, 'on', $db);
 
137
 
 
138
               push @properties, 'user', $user if $user;
 
139
               push @properties, 'host', $host if $host;
 
140
               push @properties, 'db',   $db   if $db;
 
141
               $db_for->{$thread_id} = $db;
 
142
            }
 
143
         }
 
144
         elsif ( $cmd eq 'Init' ) {
 
145
            # The full command is "Init DB" so arg starts with "DB"
 
146
            # because our regex expects single word commands.
 
147
            $cmd = 'Init DB';
 
148
            $arg =~ s/^DB\s+//;
 
149
            my ($db) = $arg =~ /(\S+)/;
 
150
            MKDEBUG && _d('Init DB:', $db);
 
151
            push @properties, 'db',   $db   if $db;
 
152
            $db_for->{$thread_id} = $db;
 
153
         }
 
154
 
 
155
         push @properties, 'arg', "administrator command: $cmd";
 
156
         push @properties, 'bytes', length($properties[-1]);
 
157
      }
 
158
 
 
159
      # The Query_time attrib is expected by mk-query-digest but
 
160
      # general logs have no Query_time so we fake it.
 
161
      push @properties, 'Query_time', 0;
 
162
 
 
163
      # Don't dump $event; want to see full dump of all properties,
 
164
      # and after it's been cast into a hash, duplicated keys will
 
165
      # be gone.
 
166
      MKDEBUG && _d('Properties of event:', Dumper(\@properties));
 
167
      my $event = { @properties };
 
168
      if ( $args{stats} ) {
 
169
         $args{stats}->{events_read}++;
 
170
         $args{stats}->{events_parsed}++;
 
171
      }
 
172
      return $event;
 
173
   } # LINE
 
174
 
 
175
   @{$self->{pending}} = ();
 
176
   $args{oktorun}->(0) if $args{oktorun};
 
177
   return;
 
178
}
 
179
 
 
180
sub _d {
 
181
   my ($package, undef, $line) = caller 0;
 
182
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
 
183
        map { defined $_ ? $_ : 'undef' }
 
184
        @_;
 
185
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
 
186
}
 
187
 
 
188
1;
 
189
}
 
190
# ###########################################################################
 
191
# End GeneralLogParser package
 
192
# ###########################################################################