← Back to branch summary

~percona-toolkit-dev/percona-toolkit/2.2

« back to all changes in this revision

Viewing changes to lib/EventExecutor.pm

  • Committer: Daniel Nichter
  • Date: 2013-03-12 15:21:13 UTC
  • mfrom: (507.1.37 pt-upgrade-2.2)
  • Revision ID: daniel@percona.com-20130312152113-jfkrxi3p8ca84oin
Merge pt-upgrade-2.2.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/EventExecutor.pm
 
1
# This program is copyright 2013 Percona Ireland Ltd.
 
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
# EventExecutor package
 
19
# ###########################################################################
 
20
{
 
21
package EventExecutor;
 
22
 
 
23
use strict;
 
24
use warnings FATAL => 'all';
 
25
use English qw(-no_match_vars);
 
26
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
 
27
 
 
28
use Time::HiRes qw(time);
 
29
use Data::Dumper;
 
30
 
 
31
use Lmo;
 
32
 
 
33
has 'default_database' => (
 
34
   is       => 'rw',
 
35
   isa      => 'Maybe[Str]',
 
36
   required => 0,
 
37
);
 
38
 
 
39
##
 
40
# Private
 
41
##
 
42
 
 
43
has 'stats' => (
 
44
   is       => 'ro',
 
45
   isa      => 'HashRef',
 
46
   required => 0,
 
47
   default  => sub { return {} },
 
48
);
 
49
 
 
50
sub exec_event {
 
51
   my ($self, %args) = @_;
 
52
   my @required_args = qw(host event);
 
53
   foreach my $arg ( @required_args ) {
 
54
      die "I need a $arg argument" unless $args{$arg};
 
55
   }
 
56
   my $host  = $args{host};
 
57
   my $event = $args{event};
 
58
 
 
59
   my $results = {
 
60
      query_time => undef,
 
61
      sth        => undef,
 
62
      warnings   => undef,
 
63
      error      => undef,
 
64
   };
 
65
 
 
66
   eval {
 
67
      my $db = $event->{db} || $event->{Schema} || $self->default_database;
 
68
      if ( $db && (!$host->{current_db} || $host->{current_db} ne $db) ) {
 
69
         PTDEBUG && _d('New current db:', $db);
 
70
         $host->dbh->do("USE `$db`");
 
71
         $host->{current_db} = $db;
 
72
      }
 
73
      my $sth = $host->dbh->prepare($event->{arg});
 
74
      my $t0 = time;
 
75
      $sth->execute();
 
76
      my $t1 = time - $t0;
 
77
      $results->{query_time} = sprintf('%.6f', $t1);
 
78
      $results->{sth}        = $sth;
 
79
      $results->{warnings}   = $self->get_warnings(dbh => $host->dbh);
 
80
   };
 
81
   if ( my $e = $EVAL_ERROR ) {
 
82
      PTDEBUG && _d($e);
 
83
      chomp($e);
 
84
      $e =~ s/ at \S+ line \d+, \S+ line \d+\.$//;
 
85
      $results->{error} = $e;
 
86
   }
 
87
   PTDEBUG && _d('Result on', $host->name, Dumper($results));
 
88
   return $results;
 
89
}
 
90
 
 
91
sub get_warnings {
 
92
   my ($self, %args) = @_;
 
93
   my @required_args = qw(dbh);
 
94
   foreach my $arg ( @required_args ) {
 
95
      die "I need a $arg argument" unless $args{$arg};
 
96
   }
 
97
   my $dbh = $args{dbh};
 
98
   my $warnings = $dbh->selectall_hashref('SHOW WARNINGS', 'code');
 
99
   return $warnings;
 
100
}
 
101
 
 
102
sub _d {
 
103
   my ($package, undef, $line) = caller 0;
 
104
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
 
105
        map { defined $_ ? $_ : 'undef' }
 
106
        @_;
 
107
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
 
108
}
 
109
 
 
110
no Lmo;
 
111
1;
 
112
}
 
113
# ###########################################################################
 
114
# End EventExecutor package
 
115
# ###########################################################################