view release on metacpan or  search on metacpan

lib/Version/Semantic.pm  view on Meta::CPAN

#<<<
package Version::Core; ## no critic ( RequireFilenameMatchesPackage )
BEGIN {
our $VERSION = 'v2.2.0';
}
#>>>

use overload '<=>' => 'compare_to', '""' => 'to_string';

sub prefix { shift->{ prefix } }
sub major  { shift->{ major } }
sub minor  { shift->{ minor } }
sub patch  { shift->{ patch } }

# Derived attribute
sub version_core { shift->{ version_core } }

sub has_prefix { exists shift->{ prefix } }

sub corever_re { $corever_re }

# Constructor as factory method
sub parse {
  my $options = ( ref $_[ -1 ] eq 'HASH' ) ? pop : {};
  my ( $class, $version ) = @_;
  $version //= '';

  my $ver_re = $class ne __PACKAGE__ ? $semver_re : $corever_re;
  unless ( $version =~ m/\A$ver_re\z/ ) {
    $croak->( "Version '$version' is not a ${ \( $class ne __PACKAGE__ ? 'semantic': 'core' ) } version" )
      if $options->{ fatal };
    return
  }

  $class->new( %+ )
}

sub new {
  my $invocant = shift;
  my $class    = ref $invocant || $invocant;

  my $self = do {

    # Validate @_
    my $length;
    my @tmp = @_;
    while ( ( $length = scalar( my ( $name, $value ) = splice @tmp, 0, 2 ) ) == 2 ) {
      $croak->( "Parameter with undefined name passed to \"$class\" constructor" )
        unless defined $name
    }
    $croak->( "Odd number of arguments passed to \"$class\" constructor" )
      if $length == 1;

    # Remove parameters that have undef values
    my %tmp = @_;
    for ( keys %tmp ) {
      delete $tmp{ $_ } unless defined $tmp{ $_ }
    }

    bless { ref $invocant ? %$invocant : (), %tmp } => $class
  };

  delete $self->{ version_core };

  my %params         = map  { $_ => 1 } $self->_init;
  my @unknown_params = grep { not exists $params{ $_ } } keys %$self;
  # Diagnostic message is copied from 'class' feature
  $croak->( "Unrecognised parameters for \"$class\" constructor: " . join( ', ', @unknown_params ) )
    if @unknown_params;

  $self->{ version_core } = ( $self->{ prefix } // '' ) . join( '.', map { $self->{ $_ } } qw( major minor patch ) );

  $self
}

{
  my %isa = (
    prefix => $prefix_re,
    major  => $num_id_re,
    minor  => $num_id_re,
    patch  => $num_id_re,
  );

  sub _init {
    my $self = shift;

    foreach ( qw( major minor patch ) ) {
      # Diagnostic message is copied from 'class' feature
      $croak->( "Required parameter '$_' is missing for \"${ \ __PACKAGE__ }\" constructor" )
        unless exists $self->{ $_ }
    }

    foreach ( keys %isa ) {
      next unless exists $self->{ $_ };
      $croak->( "Parameter '$_' has invalid value '$self->{ $_ }'" )
        unless $self->{ $_ } =~ m/\A $isa{ $_ } \z/x
    }

    qw( prefix major minor patch )
  }
}

sub increment {
  # Obvious strategies are major, minor, and patch
  my ( $self, $strategy ) = @_;
  $strategy //= 'patch';

  return $self->new( patch => $self->patch + 1 )
    if $strategy eq 'patch';
  return $self->new( minor => $self->minor + 1, patch => 0 )
    if $strategy eq 'minor';
  return $self->new( major => $self->major + 1, minor => 0, patch => 0 )
    if $strategy eq 'major';

  $croak->( "Version incrementation strategy '$strategy' is not implemented" )
}

# https://semver.org/spec/v2.0.0.html#spec-item-11
sub compare_to {
  my ( $self, $other ) = @_;