Redesigned VersionParser.

Now using Mo and overloading, so that $version_object < 5.1
is the new way to test things.
This commit is contained in:
Brian Fraser
2012-07-11 15:05:00 -03:00
parent bcc618ba5b
commit acd5281e3c

View File

@@ -22,103 +22,150 @@
# VersionParser parses a MySQL version string.
package VersionParser;
use strict;
use warnings FATAL => 'all';
use Mo;
use Scalar::Util qw(blessed);
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
sub new {
my ( $class ) = @_;
bless {}, $class;
}
use overload (
'""' => "version",
# All the other operators are defined through these
'<=>' => "cmp",
'cmp' => "cmp",
fallback => 1,
);
sub parse {
my ( $self, $str ) = @_;
my @version_parts = $str =~ m/(\d+)/g;
# Turn a version like 5.5 into 5.5.0
@version_parts = map { $_ || 0 } @version_parts[0..2];
my $result = sprintf('%03d%03d%03d', @version_parts);
PTDEBUG && _d($str, 'parses to', $result);
return $result;
}
our $VERSION = 0.01;
# Compares versions like 5.0.27 and 4.1.15-standard-log. Caches version number
# for each DBH for later use.
sub version_cmp {
my ($self, $dbh, $target, $cmp) = @_;
my $version = $self->version($dbh);
my $result;
has major => (
is => 'ro',
isa => 'Int',
required => 1,
);
if ( $cmp eq 'ge' ) {
$result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
}
elsif ( $cmp eq 'gt' ) {
$result = $self->{$dbh} gt $self->parse($target) ? 1 : 0;
}
elsif ( $cmp eq 'eq' ) {
$result = $self->{$dbh} eq $self->parse($target) ? 1 : 0;
}
elsif ( $cmp eq 'ne' ) {
$result = $self->{$dbh} ne $self->parse($target) ? 1 : 0;
}
elsif ( $cmp eq 'lt' ) {
$result = $self->{$dbh} lt $self->parse($target) ? 1 : 0;
}
elsif ( $cmp eq 'le' ) {
$result = $self->{$dbh} le $self->parse($target) ? 1 : 0;
}
else {
die "Asked for an unknown comparizon: $cmp"
}
has [qw( minor revision )] => (
is => 'ro',
isa => 'Num',
);
PTDEBUG && _d($self->{$dbh}, $cmp, $target, ':', $result);
return $result;
}
has flavor => (
is => 'ro',
isa => 'Str',
default => sub { 'Unknown' },
);
sub version_ge {
my ( $self, $dbh, $target ) = @_;
return $self->version_cmp($dbh, $target, 'ge');
}
has innodb_version => (
is => 'ro',
isa => 'Str',
default => sub { 'NO' },
);
sub version_gt {
my ( $self, $dbh, $target ) = @_;
return $self->version_cmp($dbh, $target, 'gt');
}
sub version_eq {
my ( $self, $dbh, $target ) = @_;
return $self->version_cmp($dbh, $target, 'eq');
}
sub version_ne {
my ( $self, $dbh, $target ) = @_;
return $self->version_cmp($dbh, $target, 'ne');
}
sub version_lt {
my ( $self, $dbh, $target ) = @_;
return $self->version_cmp($dbh, $target, 'lt');
}
sub version_le {
my ( $self, $dbh, $target ) = @_;
return $self->version_cmp($dbh, $target, 'le');
sub series {
my $self = shift;
return $self->_join_version($self->major, $self->minor);
}
sub version {
my ( $self, $dbh ) = @_;
if ( !$self->{$dbh} ) {
$self->{$dbh} = $self->parse(
$dbh->selectrow_array('SELECT VERSION()'));
my $self = shift;
return $self->_join_version($self->major, $self->minor, $self->revision);
}
sub is_in {
my ($self, $target) = @_;
return $self eq $target;
}
# Internal
sub _join_version {
my ($self, @parts) = @_;
return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
}
# Internal
sub _split_version {
my ($self, $str) = @_;
my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
# Turn a version like 5.5 into 5.5.0
return @version_parts[0..2];
}
# Returns the version formatted as %d%02d%02d; that is, 5.1.20 would become
# 50120
sub normalized_version {
my ( $self ) = @_;
my @version_parts = map { $_ || 0 } $self->_split_version( $self->version );
my $result = sprintf('%d%02d%02d', @version_parts);
PTDEBUG && _d($self->version, 'normalizes to', $result);
return $result;
}
# Returns a comment in the form of /*!$self->normalized_version $cmd */
sub comment {
my ( $self, $cmd ) = @_;
my $v = $self->normalized_version();
return "/*!$v $cmd */"
}
my @methods = qw(major minor revision);
sub cmp {
my ($left, $right) = @_;
my $right_obj = (blessed($right) && $right->isa(ref($left)))
? $right
: ref($left)->new($right);
my $retval = 0;
for my $m ( @methods ) {
last unless defined($left->$m) && defined($right_obj->$m);
$retval = $left->$m <=> $right_obj->$m;
last if $retval;
}
return $self->{$dbh};
return $retval;
}
sub BUILDARGS {
my $self = shift;
if ( @_ == 1 ) {
my %args;
if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
my $dbh = $_[0];
my $query;
PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
if ( eval { $query = $dbh->selectall_hashref(q<SHOW VARIABLES LIKE 'version%'>) } ) {
@args{@methods} = $self->_split_version($query->{version});
$args{flavor} = delete $query->{version_comment}
if $query->{version_comment};
}
elsif ( eval { ($query) = $dbh->selectrow_array('SELECT VERSION()') } ) {
@args{@methods} = $self->_split_version($query);
}
else {
PTDEBUG && _d("Couldn't get the version from the dbh: $@");
# No need to die here; ->new will die on it's own since the version
# is missing
}
$args{innodb_version} = eval { $self->_innodb_version($dbh) };
}
elsif ( !ref($_[0]) ) {
@args{@methods} = $self->_split_version($_[0]);
}
for my $method (@methods) {
delete $args{$method} unless defined $args{$method};
}
@_ = %args if %args;
}
return $self->SUPER::BUILDARGS(@_);
}
# Returns DISABLED if InnoDB doesn't appear as YES or DEFAULT in SHOW ENGINES,
# BUILTIN if there is no innodb_version variable in SHOW VARIABLES, or
# <value> if there is an innodb_version variable in SHOW VARIABLES, or
# NO if SHOW ENGINES is broken or InnDB doesn't appear in it.
sub innodb_version {
sub _innodb_version {
my ( $self, $dbh ) = @_;
return unless $dbh;
my $innodb_version = "NO";
@@ -156,6 +203,7 @@ sub _d {
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
no Mo;
1;
}
# ###########################################################################