Basic script to help manage semantic versions

semver

#!/usr/bin/env perl -w

use strict;
use List::Util qw(any);
use File::Basename qw(basename);

sub main {
  # We require 3 arguments
  if ($#ARGV != 2) {
    usage();
    exit(1);
  }

  # First argument is always a version
  my $ver = parse($ARGV[0]);
  if (!defined($ver)) {
    print STDERR "Cannot parse version: $ARGV[0]\n";
    exit(1);
  }

  # Second argument is an operation
  my $op = $ARGV[1];

  if (lc($op) eq 'incr' || lc($op) eq 'increment') {
    # Increment operations take a part to increment
    my $part = uc($ARGV[2]);
    if (!is_part($part)) {
      usage();
      exit(1);
    }
    print unparse(increment($ver, $part))."\n";
    exit(0);
  }

  if (lc($op) eq 'get' || lc($op) eq 'extract') {
    # Get operations take a part to increment
    my $part = uc($ARGV[2]);
    if (!is_part($part)) {
      usage();
      exit(1);
    }
    print extract($ver, $part)."\n";
    exit(0);
  }

  # For all comparison operations, the third argument is a version
  # Comparisons return by setting the exit code
  my $req = parse($ARGV[2]);
  if (!defined($req)) {
    print STDERR "Cannot parse version: $ARGV[2]\n";
    exit(1);
  }

  if ($op eq '==' || $op eq '=' || $op eq 'eq') {
    if (equalTo($ver, $req)) {
      exit(0);
    } else {
      exit(1);
    }
  }

  if ($op eq '!=' || $op eq 'ne') {
    if (equalTo($ver, $req)) {
      exit(1);
    } else {
      exit(0);
    }
  }

  if ($op eq '>' || $op eq 'gt') {
    if (greaterThan($ver, $req)) {
      exit(0);
    } else {
      exit(1);
    }
  }

  if ($op eq '>=' || $op eq 'ge') {
    if (atLeast($ver, $req)) {
      exit(0);
    } else {
      exit(1);
    }
  }

  if ($op eq '~>' || $op eq 'matches' || $op eq 'compatible') {
    if (compatibleWith($ver, $req)) {
      exit(0);
    } else {
      exit(1);
    }
  }

  usage();
  exit(1);
}
main();

sub usage {
  my $script = basename($0);
  print STDERR <<EOF;
Usage:
  $script 1.2.3 incr (major|minor|patch)
  $script 1.2.3 get (major|minor|patch)
  $script 1.2.3 == 1.2.3
  $script 1.2.3 != 2.3.4
  $script 1.2.3 >  1.2.2
  $script 1.2.3 >= 1.2.3
  $script 1.2.3 ~> 1.2.0
EOF
}

# Parse a Semantic Version into MAJOR, MINOR and PATCH
# Usage: parse('1.2.3')
sub parse {
  my $ver = $_[0];
  if ($ver =~ m/^v?(\d+)(?:\.(\d+)(?:\.(\d+))?)?(?:-[[:alnum:]\.]*)?$/i) {
    return [$1 + 0, ($2 || 0) + 0, ($3 || 0) + 0];
  }
  return undef;
}

# Turn a parsed Semantic Version back into a string
# Usage: unparse([1, 2, 3]);
sub unparse {
  if (ref($_[0]) ne 'ARRAY') {
    die "Expected array reference in unparse";
  }

  my @ver = @{$_[0]};
  return "$ver[0].$ver[1].$ver[2]";
}

# Increment some part of a Semantic Version.
# Usage: increment([1, 2, 3], 'MAJOR')
sub increment {
  if (ref($_[0]) ne 'ARRAY') {
    die "Expected array reference in increment";
  }
  if (!is_part($_[1])) {
    die "Unknown increment part: $_[1]";
  }

  my @ver = @{$_[0]};
  my $part = $_[1] || 'MAJOR';
  if ($part eq 'MAJOR') {
    return [$ver[0] + 1, 0, 0];
  } elsif ($part eq 'MINOR') {
    return [$ver[0], $ver[1] + 1, 0];
  } else { # if ($part eq 'PATCH')
    return [$ver[0], $ver[1], $ver[2] + 1];
  }
}

# Get the value of one of the parts of a Semantic Version.
# Usage: extract([1, 2, 3], 'MAJOR')
sub extract {
  if (ref($_[0]) ne 'ARRAY') {
    die "Expected array reference in increment";
  }
  if (!is_part($_[1])) {
    die "Unknown increment part: $_[1]";
  }

  my @ver = @{$_[0]};
  my $part = $_[1];
  if ($part eq 'MAJOR') {
    return $ver[0];
  } elsif ($part eq 'MINOR') {
    return $ver[1];
  } else { # if ($part eq 'PATCH')
    return $ver[2];
  }
}

sub is_part {
  my $part = $_[0];
  return defined($part) && any { $_ eq $part } ('MAJOR', 'MINOR', 'PATCH');
}

# True iff arg1 > arg2
sub greaterThan {
  my @ver = @{$_[0]};
  my @lb = @{$_[1]};

  # MAJOR
  if ($ver[0] > $lb[0]) {
    return 1;
  } elsif ($ver[0] < $lb[0]) {
    return 0;
  }
  # MINOR
  if ($ver[1] > $lb[1]) {
    return 1;
  } elsif ($ver[1] < $lb[1]) {
    return 0;
  }
  # PATCH
  if ($ver[2] > $lb[2]) {
    return 1;
  } else {
    return 0;
  }
}

# True iff arg1 == arg2
sub equalTo {
  my @ver = @{$_[0]};
  my @req = @{$_[1]};

  for (my $i = 0; $i < 3; $i++) {
    if ($ver[$i] != $req[$i]) {
      return 0;
    }
  }
  return 1;
}

# True iff arg1 >= arg2
sub atLeast {
  my $ver = $_[0];
  my $lb = $_[1];

  return greaterThan($ver, $lb) || equalTo($ver, $lb);
}

# True iff arg1 ~> arg2
sub compatibleWith {
  my @ver = @{$_[0]};
  my @req = @{$_[1]};

  if ($ver[0] == 0) {
    return $req[0] == 0 && $ver[1] == $req[1] && atLeast(\@ver, \@req);
  }
  return $ver[0] == $req[0] && atLeast(\@ver, \@req);
}