← Back to branch summary

~hingo/percona-toolkit/pqd-mongodb-24

« back to all changes in this revision

Viewing changes to lib/VersionParser.pm

  • Committer: Brian Fraser
  • Date: 2012-07-20 20:25:10 UTC
  • mfrom: (303.2.27 new-versionparser)
  • Revision ID: brian.fraser@percona.com-20120720202510-zoia5ndqchpcysec
Merged new-versionparser

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/VersionParser.pm
22
22
# VersionParser parses a MySQL version string.
23
23
package VersionParser;
24
24
 
25
 
use strict;
26
 
use warnings FATAL => 'all';
 
25
use Mo;
 
26
use Scalar::Util qw(blessed);
27
27
use English qw(-no_match_vars);
28
28
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
29
29
 
30
 
sub new {
31
 
   my ( $class ) = @_;
32
 
   bless {}, $class;
33
 
}
34
 
 
35
 
sub parse {
36
 
   my ( $self, $str ) = @_;
37
 
   my @version_parts = $str =~ m/(\d+)/g;
38
 
   # Turn a version like 5.5 into 5.5.0
39
 
   @version_parts = map { $_ || 0 } @version_parts[0..2];
40
 
   my $result = sprintf('%03d%03d%03d', @version_parts);
41
 
   PTDEBUG && _d($str, 'parses to', $result);
42
 
   return $result;
43
 
}
44
 
 
45
 
# Compares versions like 5.0.27 and 4.1.15-standard-log.  Caches version number
46
 
# for each DBH for later use.
47
 
sub version_cmp {
48
 
   my ($self, $dbh, $target, $cmp) = @_;
49
 
   my $version = $self->version($dbh);
50
 
   my $result;
51
 
 
52
 
   if ( $cmp eq 'ge' ) {
53
 
      $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
54
 
   }
55
 
   elsif ( $cmp eq 'gt' ) {
56
 
      $result = $self->{$dbh} gt $self->parse($target) ? 1 : 0;
57
 
   }
58
 
   elsif ( $cmp eq 'eq' ) {
59
 
      $result = $self->{$dbh} eq $self->parse($target) ? 1 : 0;
60
 
   }
61
 
   elsif ( $cmp eq 'ne' ) {
62
 
      $result = $self->{$dbh} ne $self->parse($target) ? 1 : 0;
63
 
   }
64
 
   elsif ( $cmp eq 'lt' ) {
65
 
      $result = $self->{$dbh} lt $self->parse($target) ? 1 : 0;
66
 
   }
67
 
   elsif ( $cmp eq 'le' ) {
68
 
      $result = $self->{$dbh} le $self->parse($target) ? 1 : 0;
69
 
   }
70
 
   else {
71
 
      die "Asked for an unknown comparizon: $cmp"
72
 
   }
73
 
 
74
 
   PTDEBUG && _d($self->{$dbh}, $cmp, $target, ':', $result);
75
 
   return $result;
76
 
}
77
 
 
78
 
sub version_ge {
79
 
   my ( $self, $dbh, $target ) = @_;
80
 
   return $self->version_cmp($dbh, $target, 'ge');
81
 
}
82
 
 
83
 
sub version_gt {
84
 
   my ( $self, $dbh, $target ) = @_;
85
 
   return $self->version_cmp($dbh, $target, 'gt');
86
 
}
87
 
 
88
 
sub version_eq {
89
 
   my ( $self, $dbh, $target ) = @_;
90
 
   return $self->version_cmp($dbh, $target, 'eq');
91
 
}
92
 
 
93
 
sub version_ne {
94
 
   my ( $self, $dbh, $target ) = @_;
95
 
   return $self->version_cmp($dbh, $target, 'ne');
96
 
}
97
 
 
98
 
sub version_lt {
99
 
   my ( $self, $dbh, $target ) = @_;
100
 
   return $self->version_cmp($dbh, $target, 'lt');
101
 
}
102
 
 
103
 
sub version_le {
104
 
   my ( $self, $dbh, $target ) = @_;
105
 
   return $self->version_cmp($dbh, $target, 'le');
 
30
use overload (
 
31
   '""'     => "version",
 
32
   # All the other operators are defined through these
 
33
   '<=>'    => "cmp",
 
34
   'cmp'    => "cmp",
 
35
   fallback => 1,
 
36
);
 
37
 
 
38
use Carp ();
 
39
 
 
40
our $VERSION = 0.01;
 
41
 
 
42
has major => (
 
43
    is       => 'ro',
 
44
    isa      => 'Int',
 
45
    required => 1,
 
46
);
 
47
 
 
48
has [qw( minor revision )] => (
 
49
    is  => 'ro',
 
50
    isa => 'Num',
 
51
);
 
52
 
 
53
has flavor => (
 
54
    is      => 'ro',
 
55
    isa     => 'Str',
 
56
    default => sub { 'Unknown' },
 
57
);
 
58
 
 
59
has innodb_version => (
 
60
    is      => 'ro',
 
61
    isa     => 'Str',
 
62
    default => sub { 'NO' },
 
63
);
 
64
 
 
65
sub series {
 
66
   my $self = shift;
 
67
   return $self->_join_version($self->major, $self->minor);
106
68
}
107
69
 
108
70
sub version {
109
 
   my ( $self, $dbh ) = @_;
110
 
   if ( !$self->{$dbh} ) {
111
 
      $self->{$dbh} = $self->parse(
112
 
         $dbh->selectrow_array('SELECT VERSION()'));
113
 
   }
114
 
   return $self->{$dbh};
 
71
   my $self = shift;
 
72
   return $self->_join_version($self->major, $self->minor, $self->revision);
 
73
}
 
74
 
 
75
sub is_in {
 
76
   my ($self, $target) = @_;
 
77
 
 
78
   return $self eq $target;
 
79
}
 
80
 
 
81
# Internal
 
82
# The crux of these two versions is to transform a version like 5.1.01 into
 
83
# 5, 1, and 0.1, and then reverse the process. This is so that the version
 
84
# above and 5.1.1 are differentiated.
 
85
sub _join_version {
 
86
    my ($self, @parts) = @_;
 
87
 
 
88
    return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
 
89
}
 
90
# Internal
 
91
sub _split_version {
 
92
   my ($self, $str) = @_;
 
93
   my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
 
94
   return @version_parts[0..2];
 
95
}
 
96
 
 
97
# Returns the version formatted as %d%02d%02d; that is, 5.1.20 would become
 
98
# 50120, 5.1.2 would become 50102, and 5.1.02 would become 50100
 
99
sub normalized_version {
 
100
   my ( $self ) = @_;
 
101
   my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major,
 
102
                                                      $self->minor,
 
103
                                                      $self->revision);
 
104
   PTDEBUG && _d($self->version, 'normalizes to', $result);
 
105
   return $result;
 
106
}
 
107
 
 
108
# Returns a comment in the form of /*!$self->normalized_version $cmd */
 
109
sub comment {
 
110
   my ( $self, $cmd ) = @_;
 
111
   my $v = $self->normalized_version();
 
112
 
 
113
   return "/*!$v $cmd */"
 
114
}
 
115
 
 
116
my @methods = qw(major minor revision);
 
117
sub cmp {
 
118
   my ($left, $right) = @_;
 
119
   # If the first object is blessed and ->isa( self's class ), then
 
120
   # just use that; Otherwise, contruct a new VP object from it.
 
121
   my $right_obj = (blessed($right) && $right->isa(ref($left)))
 
122
                   ? $right
 
123
                   : ref($left)->new($right);
 
124
 
 
125
   my $retval = 0;
 
126
   for my $m ( @methods ) {
 
127
      last unless defined($left->$m) && defined($right_obj->$m);
 
128
      $retval = $left->$m <=> $right_obj->$m;
 
129
      last if $retval;
 
130
   }
 
131
   return $retval;
 
132
}
 
133
 
 
134
sub BUILDARGS {
 
135
   my $self = shift;
 
136
 
 
137
   if ( @_ == 1 ) {
 
138
      my %args;
 
139
      if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
 
140
         PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
 
141
         my $dbh = $_[0];
 
142
         local $dbh->{FetchHashKeyName} = 'NAME_lc';
 
143
         my $query = eval {
 
144
            $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} })
 
145
         };
 
146
         if ( $query ) {
 
147
            $query = { map { $_->{variable_name} => $_->{value} } @$query };
 
148
            @args{@methods} = $self->_split_version($query->{version});
 
149
            $args{flavor} = delete $query->{version_comment}
 
150
                  if $query->{version_comment};
 
151
         }
 
152
         elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) {
 
153
            @args{@methods} = $self->_split_version($query);
 
154
         }
 
155
         else {
 
156
            Carp::confess("Couldn't get the version from the dbh while "
 
157
                        . "creating a VersionParser object: $@");
 
158
         }
 
159
         $args{innodb_version} = eval { $self->_innodb_version($dbh) };
 
160
      }
 
161
      elsif ( !ref($_[0]) ) {
 
162
         @args{@methods} = $self->_split_version($_[0]);
 
163
      }
 
164
 
 
165
      for my $method (@methods) {
 
166
         delete $args{$method} unless defined $args{$method};
 
167
      }
 
168
      @_ = %args if %args;
 
169
   }
 
170
 
 
171
   return $self->SUPER::BUILDARGS(@_);
115
172
}
116
173
 
117
174
# Returns DISABLED if InnoDB doesn't appear as YES or DEFAULT in SHOW ENGINES,
118
175
# BUILTIN if there is no innodb_version variable in SHOW VARIABLES, or
119
176
# <value> if there is an innodb_version variable in SHOW VARIABLES, or
120
177
# NO if SHOW ENGINES is broken or InnDB doesn't appear in it.
121
 
sub innodb_version {
 
178
sub _innodb_version {
122
179
   my ( $self, $dbh ) = @_;
123
180
   return unless $dbh;
124
181
   my $innodb_version = "NO";
156
213
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
157
214
}
158
215
 
 
216
no Mo;
159
217
1;
160
218
}
161
219
# ###########################################################################