lib/Test/Valgrind/Version.pm

   1 package Test::Valgrind::Version;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 Test::Valgrind::Version - Object class for valgrind versions.
   9
  10 =head1 VERSION
  11
  12 Version 1.18
  13
  14 =cut
  15
  16 our $VERSION = '1.18';
  17
  18 =head1 DESCRIPTION
  19
  20 This class is used to parse, store and compare C<valgrind> versions.
  21
  22 =cut
  23
  24 use base 'Test::Valgrind::Carp';
  25
  26 use Scalar::Util ();
  27
  28 my $instanceof = sub {
  29  Scalar::Util::blessed($_[0]) && $_[0]->isa($_[1]);
  30 };
  31
  32 =head1 METHODS
  33
  34 =head2 C<new>
  35
  36     my $vg_version = Test::Valgrind::Version->new(
  37      command_output => qx{valgrind --version},
  38     );
  39
  40     my $vg_version = Test::Valgrind::Version->new(
  41      string => '1.2.3',
  42     );
  43
  44 Creates a new L<Test::Valgrind::Version> object representing a C<valgrind> version from one of these two sources :
  45
  46 =over 4
  47
  48 =item *
  49
  50 if the C<command_output> option is specified, then C<new> will try to parse it as the output of C<valgrind --version>.
  51
  52 =item *
  53
  54 otherwise the C<string> option must be passed, and its value will be parsed as a 'dotted-integer' version number.
  55
  56 =back
  57
  58 An exception is raised if the version number cannot be inferred from the supplied data.
  59
  60 =cut
  61
  62 sub new {
  63  my ($class, %args) = @_;
  64
  65  my $output = $args{command_output};
  66  my $string;
  67  if (defined $output) {
  68   ($string) = $output =~ /^valgrind-([0-9]+(?:\.[0-9]+)*)/;
  69  } else {
  70   $string = $args{string};
  71   return $string if $string->$instanceof(__PACKAGE__);
  72   if (defined $string and $string =~ /^([0-9]+(?:\.[0-9]+)*)/) {
  73    $string = $1;
  74   } else {
  75    $string = undef;
  76   }
  77  }
  78  $class->_croak('Invalid argument') unless defined $string;
  79
  80  my @digits = map int, split /\./, $string;
  81  my $last   = $#digits;
  82  for my $i (reverse 0 .. $#digits) {
  83   last if $digits[$i];
  84   --$last;
  85  }
  86
  87  bless {
  88   _digits => [ @digits[0 .. $last] ],
  89   _last   => $last,
  90  }, $class;
  91 }
  92
  93 BEGIN {
  94  local $@;
  95  eval "sub $_ { \$_[0]->{$_} }" for qw<_digits _last>;
  96  die $@ if $@;
  97 }
  98
  99 =head1 OVERLOADING
 100
 101 This class overloads numeric comparison operators (C<< <=> >>, C<< < >>, C<< <= >>, C< == >, C<< => >> and C<< > >>), as well as stringification.
 102
 103 =cut
 104
 105 sub _spaceship {
 106  my ($left, $right, $swap) = @_;
 107
 108  unless ($right->$instanceof(__PACKAGE__)) {
 109   $right = __PACKAGE__->new(string => $right);
 110  }
 111  ($right, $left) = ($left, $right) if $swap;
 112
 113  my $left_digits  = $left->_digits;
 114  my $right_digits = $right->_digits;
 115
 116  my $last_cmp = $left->_last <=> $right->_last;
 117  my $last     = ($last_cmp < 0) ? $left->_last : $right->_last;
 118
 119  for my $i (0 .. $last) {
 120   my $cmp = $left_digits->[$i] <=> $right_digits->[$i];
 121   return $cmp if $cmp;
 122  }
 123
 124  return $last_cmp;
 125 }
 126
 127 sub _stringify {
 128  my $self   = shift;
 129  my @digits = @{ $self->_digits };
 130  push @digits, 0 until @digits >= 3;
 131  join '.', @digits;
 132 }
 133
 134 use overload (
 135  '<=>'    => \&_spaceship,
 136  '""'     => \&_stringify,
 137  fallback => 1,
 138 );
 139
 140 =head1 SEE ALSO
 141
 142 L<Test::Valgrind>.
 143
 144 =head1 AUTHOR
 145
 146 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 147
 148 You can contact me by mail or on C<irc.perl.org> (vincent).
 149
 150 =head1 BUGS
 151
 152 Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>.
 153 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 154
 155 =head1 SUPPORT
 156
 157 You can find documentation for this module with the perldoc command.
 158
 159     perldoc Test::Valgrind::Component
 160
 161 =head1 COPYRIGHT & LICENSE
 162
 163 Copyright 2015,2016 Vincent Pit, all rights reserved.
 164
 165 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 166
 167 =cut
 168
 169 1; # End of Test::Valgrind::Version