File Coverage

blib/lib/Test/Valgrind/Version.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	17	20	85.0
condition	3	3	100.0
subroutine	11	11	100.0
pod	1	1	100.0
total	86	89	96.6

package Test::Valgrind::Version;

use strict;
use warnings;

=head1 NAME

Test::Valgrind::Version - Object class for valgrind versions.

=head1 VERSION

Version 1.18

=cut

our $VERSION = '1.18';

=head1 DESCRIPTION

This class is used to parse, store and compare C versions.

=cut

use base 'Test::Valgrind::Carp';

use Scalar::Util ();

my $instanceof = sub {
 Scalar::Util::blessed($_[0]) && $_[0]->isa($_[1]);
};

=head1 METHODS

=head2 C

    my $vg_version = Test::Valgrind::Version->new(
     command_output => qx{valgrind --version},
    );

    my $vg_version = Test::Valgrind::Version->new(
     string => '1.2.3',
    );

Creates a new L object representing a C version from one of these two sources :

=over 4

=item *

if the C option is specified, then C will try to parse it as the output of C.

=item *

otherwise the C option must be passed, and its value will be parsed as a 'dotted-integer' version number.

=back

An exception is raised if the version number cannot be inferred from the supplied data.

=cut

sub new {
 my ($class, %args) = @_;

 my $output = $args{command_output};
 my $string;
 if (defined $output) {
  ($string) = $output =~ /^valgrind-([0-9]+(?:\.[0-9]+)*)(?!\.)/;
 } else {
  $string = $args{string};
  return $string if $string->$instanceof(__PACKAGE__);
  if (defined $string and $string =~ /^([0-9]+(?:\.[0-9]+)*)(?!\.)/) {
   $string = $1;
  } else {
   $string = undef;
  }
 }
 $class->_croak('Invalid argument') unless defined $string;

 my @digits = map int, split /\./, $string;
 my $last   = $#digits;
 for my $i (reverse 0 .. $#digits) {
  last if $digits[$i];
  --$last;
 }

 bless {
  _digits => [ @digits[0 .. $last] ],
  _last   => $last,
 }, $class;
}

BEGIN {
 local $@;
 eval "sub $_ { \$_[0]->{$_} }" for qw<_digits _last>;
 die $@ if $@;
}

=head1 OVERLOADING

This class overloads numeric comparison operators (C<< <=> >>, C<< < >>, C<< <= >>, C< == >, C<< => >> and C<< > >>), as well as stringification.

=cut

sub _spaceship {
 my ($left, $right, $swap) = @_;

 unless ($right->$instanceof(__PACKAGE__)) {
  $right = __PACKAGE__->new(string => $right);
 }
 ($right, $left) = ($left, $right) if $swap;

 my $left_digits  = $left->_digits;
 my $right_digits = $right->_digits;

 my $last_cmp = $left->_last <=> $right->_last;
 my $last     = ($last_cmp < 0) ? $left->_last : $right->_last;

 for my $i (0 .. $last) {
  my $cmp = $left_digits->[$i] <=> $right_digits->[$i];
  return $cmp if $cmp;
 }

 return $last_cmp;
}

sub _stringify {
 my $self   = shift;
 my @digits = @{ $self->_digits };
 push @digits, 0 until @digits >= 3;
 join '.', @digits;
}

use overload (
 '<=>'    => \&_spaceship,
 '""'     => \&_stringify,
 fallback => 1,
);

=head1 SEE ALSO

L.

=head1 AUTHOR

Vincent Pit, C<<  >>, L.

You can contact me by mail or on C (vincent).

=head1 BUGS

Please report any bugs or feature requests to C, or through the web interface at L.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Test::Valgrind::Component

=head1 COPYRIGHT & LICENSE

Copyright 2015 Vincent Pit, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

1; # End of Test::Valgrind::Version