File Coverage

blib/lib/Version/Dotted.pm

Criterion	Covered	Total	%
statement	102	102	100.0
branch	23	24	95.8
condition	5	5	100.0
subroutine	23	23	100.0
pod	6	6	100.0
total	159	160	99.3

#   ---------------------------------------------------------------------- copyright and license ---
#
#   file: lib/Version/Dotted.pm
#
#   Copyright © 2016 Van de Bugger.
#
#   This file is part of perl-Version-Dotted.
#
#   perl-Version-Dotted is free software: you can redistribute it and/or modify it under the terms
#   of the GNU General Public License as published by the Free Software Foundation, either version
#   3 of the License, or (at your option) any later version.
#
#   perl-Version-Dotted is distributed in the hope that it will be useful, but WITHOUT ANY
#   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
#   PURPOSE. See the GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License along with
#   perl-Version-Dotted. If not, see .
#
#   ---------------------------------------------------------------------- copyright and license ---

#pod =for :this This is C module/class documentation. Read it first, but use one of its
#pod subclasses.
#pod
#pod =for :those General topics like getting source, building, installing, bug reporting and some others
#pod are covered in the F.
#pod
#pod =for test_synopsis my ( $v, $i, $p );
#pod
#pod =head1 SYNOPSIS
#pod
#pod     use Version::Dotted;        # import nothing
#pod     use Version::Dotted 'qv';   # import qv
#pod
#pod     # Construct:
#pod     $v = Version::Dotted->new( v1.2.3 );    # same as qv( v1.2.3 )
#pod     $v = qv( v1.2.3 );      # v1.2.3
#pod     $v = qv( '1.2.0' );     # v1.2 (trailing zero parts ignored)
#pod     $v = qv( 'v1' );        # v1
#pod
#pod     # Access individual parts:
#pod     $p = $v->part( $i );    # Get i-th part.
#pod
#pod     # Stringify:
#pod     $v->stringify;          # "v1.2.3" (always with 'v' prefix)
#pod     "$v";                   # ditto
#pod
#pod     # Bump the version:
#pod     $v->bump( $i );         # Bump i-th part
#pod                             # and drop all parts behind i-th.
#pod
#pod     # Compare:
#pod     $v > v1.2.3;
#pod     $v == '1.2.3';
#pod
#pod =head1 DESCRIPTION
#pod
#pod =head2 Purpose
#pod
#pod C is an official Perl module for comparing versions. For example, (starting from Perl
#pod 5.12.0) C with a specified version:
#pod
#pod     package Assa v1.2.3;
#pod
#pod automatically assigns C<$VERSION> variable a version object (an object of C class).
#pod
#pod C is I a replacement for C. C should be used to declare
#pod package's version implicitly (as shown in the example above) or explicitly:
#pod
#pod     package Assa;
#pod     use version 0.77; our $VERSION = version->declare( 'v1.2.3' );
#pod
#pod C and its specialized descendants C and
#pod C are intended for cases where you need to I version object, for
#pod example, in C C plugin:
#pod
#pod     sub after_release {
#pod         my ( $self ) = @_;
#pod         my $v = qv( $self->zilla->version ); # Version of just-release distro.
#pod         $v->bump( 'trial' );                 # Version of the next release.
#pod         ...
#pod     };
#pod
#pod or detect version release status, for example, in C plugin:
#pod
#pod     sub provide_release_status {
#pod         my ( $self ) = @_;
#pod         my $v = qv( $self->zilla->version );
#pod         return $v->is_trial ? "testing" : "stable";
#pod     };
#pod
#pod =head2 Dotted Version
#pod
#pod Dotted (aka dotted-decimal) version is a series of parts joined with dots, each part is a cardinal
#pod (non-negative) integer. Every part (except the first) should be in range [0..999], the first part
#pod can be bigger than 999.
#pod
#pod C creates only dotted version objects.
#pod
#pod See also L.
#pod
#pod =head2 Release Status
#pod
#pod Unfortunately, Perl terminology in this area in not well-defined and not consistently used:
#pod
#pod =over
#pod
#pod =item *
#pod
#pod The C module names a version containing underscore "alpha version" and refers to CPAN.
#pod
#pod =item *
#pod
#pod C defines status as one of: C, C, and C. Word "alpha"
#pod is used in the description of C release, while C release is described as "beta".
#pod There is also requirement that C release version should not contain underscore.
#pod
#pod =item *
#pod
#pod pause.perl.org site has section named "Developer Releases" which is about releasing "code for
#pod testing". Such releases should either have underscore in version or "-TRIAL" suffix.
#pod
#pod =item *
#pod
#pod meta::cpan site in the list of module releases shows "DEV" after versions containing underscore.
#pod
#pod =item *
#pod
#pod C tool has C<--trial> command line option to build a "release that PAUSE will not index".
#pod
#pod =back
#pod
#pod I think using word "alpha" by C module is a confusing, because C does not provide
#pod any support for "beta" and "release candidate". Thus, "alpha" term is dropped in favor of more
#pod generic term "trial": trial could be any of "alpha", "beta", "release candidate", "unstable", or
#pod "testing".
#pod
#pod C does not define C method but its descendants do.
#pod
#pod =head2 Parent(s)
#pod
#pod C is heavily influenced by C, but C is I a
#pod subclass of C, C I a subclass of C.
#pod
#pod The class narrows C — C creates only I (aka dotted-decimal)
#pod version objects, support for creating decimal versions is not provided. Support for "alpha"
#pod versions is dropped too (subclasses provide support for "trial" versions instead).
#pod
#pod The class extends C — C objects are I.
#pod
#pod =head2 Error Reporting
#pod
#pod The class reports error by C. It gives the caller flexibility: warning may be
#pod either suppressed
#pod
#pod     no warnings 'Version::Dotted';
#pod
#pod or made fatal:
#pod
#pod     use warnings FATAL => 'Version::Dotted';
#pod
#pod =cut

package Version::Dotted;

use strict;
use warnings;
use warnings::register;
use version 0.77 qw{};

# ABSTRACT: TODO
our $VERSION = 'v0.0.0_06'; # TRIAL VERSION

use parent 'version';
use overload (
    'cmp' => \&_cmp,
    '<=>' => \&_cmp,
);

sub _min_len { 1 };     ## no critic ( RequireFinalReturn )
sub _max_len { 1000 };  ## no critic ( RequireFinalReturn )
# TODO: INTMAX?

sub _warn {
    my ( $self, $message ) = @_;
    warnings::warnif( 'Version::Dotted', $message );
    return;
};

# --------------------------------------------------------------------------------------------------

#pod =Method C
#pod
#pod Constructs a new version object.
#pod
#pod     $version = Version::Dotted->new( $arg );
#pod
#pod The constructor accepts one argument and creates dotted version object. An argument can be either
#pod integer number (C<1>),  floating point number (C<1.2>), v-string (C), or string (with or
#pod without leading v: C<'1.2'>, C<'v1.2'>), or version object. Trailing zero parts are stripped,
#pod leading zeros in parts are insignificant:
#pod
#pod     Version::Dotted->new( 1.2.0 ) == Version::Dotted->new( v1.2 )
#pod     Version::Dotted->new( 1.002 ) == Version::Dotted->new( v1.2 )
#pod
#pod TODO: Issue a warning if argument is not v-string or string?
#pod
#pod Actually, C has a notion of "minimum number of parts": version object is
#pod maintained to have at least minimum number of parts. In C minimum number of parts
#pod is C<1>, but subclasses may raise the bar.
#pod
#pod =caveat Leading Zeros
#pod
#pod Leading zeros in parts are insignificant:
#pod
#pod     qv( v01.02.03 ) == v1.2.3;
#pod     qv( 1.002 )     == v1.2;
#pod
#pod However, Perl interprets numbers with leading zero as octal, so aware of:
#pod
#pod     qv( 010     ) == v8;
#pod     qv( 010.011 ) == v89;   # concatenation of two numbers 010 and 011
#pod
#pod To avoid surprises stick to using v-strings or strings:
#pod
#pod     qv( v010      ) == v10;
#pod     qv( v010.011  ) == v10.10;
#pod     qv( '010.011' ) == v10.10;
#pod
#pod =caveat Floating Point Numbers with Trailing Zeroes
#pod
#pod Perl ignores trailing zeros in floating point numbers:
#pod
#pod     1.200 == 1.2;
#pod
#pod so
#pod
#pod     qv( 1.200 ) == v1.2;    # not v1.200
#pod
#pod To avoid such surprises stick to using v-strings or strings:
#pod
#pod     qv( v1.200  ) == v1.200;
#pod     qv( '1.200' ) == v1.200;
#pod
#pod =cut

sub new {
    my ( $class, $arg ) = @_;
    my $v;
    if ( eval { $arg->isa( 'version' ) } ) {
        $v = $class->declare( 0 );                      # Create a new version object.
        $v->{ version } = [ @{ $arg->{ version } } ];   # Copy version parts.
    } else {
        if ( not defined $arg ) {
            $class->_warn( "Use of undefined value to construct version" );
            $arg = 'v0';
        };
        $v = $class->declare( $arg );
    };
    return $v->_norm();
};

# --------------------------------------------------------------------------------------------------

# If $arg is a version object, return it as-is. Otherwise create a version object and return it.
sub _obj {
    my ( $self, $arg ) = @_;
    if ( not eval { $arg->isa( 'version' ) } ) {
        $arg = $self->new( $arg );
    };
    return $arg;
};

# --------------------------------------------------------------------------------------------------

#pod =method C
#pod
#pod Returns i-th part of the version.
#pod
#pod     $int = $v->part( $i );  # Get i-th part.
#pod
#pod If index is larger than actual number of version parts minus one, C is returned.
#pod
#pod Negative part index causes warning but works like index to regular Perl array: C<-1> is index
#pod of the last version part, C<-2> — second last, etc.
#pod
#pod =cut

sub part {
    my ( $self, $idx ) = @_;
    $idx >= 0 or $self->_warn( "Negative version part index '$idx'" );
    return $self->{ version }->[ $idx ];
};

# --------------------------------------------------------------------------------------------------

#pod =method C
#pod
#pod Bumps i-th version part and drops all the parts behind i-th.
#pod
#pod     $v->bump( $i );
#pod
#pod If index is larger than actual number of version parts (minus one), missed parts are autovivified
#pod with zero values. If result of bumping is bigger than allowed upper boundary for the part (C<999>
#pod for all the parts except the first), warning is printed.
#pod
#pod Negative part index causes warning but works.
#pod
#pod The method returns reference to version object.
#pod
#pod     $v = qv( v1.2.3 );  # v1.2.3
#pod     $v->bump( 3 );      # v1.2.3.1
#pod     $v->bump( 2 );      # v1.2.4
#pod     $v->bump( 1 );      # v1.3
#pod     $v->bump( 0 );      # v2
#pod
#pod =cut

sub bump {
    my ( $self, $idx ) = @_;
    my $v = $self->{ version };
    if ( $idx < - abs( @$v ) ) {
        $self->_warn( "Invalid version part index '$idx'" );
        return;
    };
    $idx >= 0 or $self->_warn( "Negative version part index '$idx'" );
    ++ $v->[ $idx ];
    if ( $idx == -1 ) {
        # -1 denotes the last part, nothing to delete behind it.
    } else {
        # Ok, it is not the last part, let us delete everything behind it:
        splice( @$v, $idx + 1 );
    };
    return $self->_norm();
};

# --------------------------------------------------------------------------------------------------

#pod =operator C=E>
#pod
#pod Compares two versions.
#pod
#pod     $v <=> $other;
#pod
#pod The operator is inherited from parent's class (see L).
#pod However, there is a difference: if C<$other> is not a version object, it converted to a version
#pod object using C (I C).
#pod
#pod Other comparison operators (e. g. C>, C>, C=>, etc) are created by Perl.
#pod
#pod =operator C
#pod
#pod The same as C=E>.
#pod
#pod =cut

sub _cmp {
    my ( $self, $other, $swap ) = @_;
    $other = $self->_obj( $other );
    no strict 'refs';                       ## no critic ( ProhibitNoStrict )
    return &{ 'version::(cmp' }( $self, $other, $swap );
};

# --------------------------------------------------------------------------------------------------

# Normalize version representation.
sub _norm {
    my ( $self ) = @_;
    my $v = $self->{ version };
    my $m = $self->_min_len;
    # Make sure there are no undefined elements in the array (which can appear after `bump`):
    $_ // ( $_ = 0 ) for @$v;
    # Make sure we have at least $m parts:
    while ( @$v < $m ) {
        push( @$v, 0 );
    };
    # Drop zero parts from the end (but keep at lest $m parts):
    while ( @$v > $m and $v->[ -1 ] == 0 ) {
      -- $#$v;
    };
    # Update version string representation:
    my $s = 'v' . join( '.', @$v );
    $self->{ original } = $s;
    # Check number of parts:
    @$v <= $self->_max_len or $self->_warn( "Bad version '$s': too many parts" );
    # Verify all the parts after the first are in range [0..999]:
    for my $i ( 1 .. $#$v ) {
        $v->[ $i ] <= 999
            or $self->_warn( "Bad version '$s': too large part #$i '$v->[ $i ]'" );
    };
    return $self;
};

# --------------------------------------------------------------------------------------------------

#pod =Method C
#pod
#pod This method issues warning "Operation 'parse' is not supported" and always returns C.
#pod
#pod (The parent's method creates decimal version object. However, this class is intended to create only
#pod dotted-decimal version objects.)
#pod
#pod =cut

sub parse {
    my ( $class ) = @_;
    $class->_warn( "Operation 'parse' is not supported" );
    return;
};

# --------------------------------------------------------------------------------------------------

#pod =method C
#pod
#pod The method prints a warning and always returns C.
#pod
#pod =cut

sub is_alpha {
    my ( $self ) = @_;
    $self->_warn( "Operation 'is_alpha' is not supported" );
    return;
};

# --------------------------------------------------------------------------------------------------

#pod =method C
#pod
#pod The method prints a warning and always returns C.
#pod
#pod =cut

sub numify {
    my ( $self ) = @_;
    $self->_warn( "operation 'numify' is not supported" );
    return;
};

# --------------------------------------------------------------------------------------------------

#pod =method C
#pod
#pod     $str = $v->stringify;
#pod
#pod The method is inherited from the parent class.
#pod
#pod Since the C class constructs only dotted version objects, result of
#pod stringification is always a dotted version string with leading C<'v'>, e. g.:
#pod
#pod     Version::Dotted->new( 1.2 )->stringify eq 'v1.2';
#pod
#pod =operator ""
#pod
#pod The same as C.
#pod
#pod     $v->stringify eq "$v";
#pod
#pod =cut

# --------------------------------------------------------------------------------------------------

#pod =head1 EXPORT
#pod
#pod The module exports nothing by default. The module installs C function (I a method) into
#pod caller namespace by explicit request:
#pod
#pod     use Version::Dotted 'qv';
#pod
#pod If caller module already has C function, warning is issued and function is redefined.
#pod
#pod Note: C exports C by default, if caller package does not have C function yet.
#pod
#pod The module (unlike to C) does not play any tricks with importer's C and/or
#pod C.
#pod
#pod =func qv
#pod
#pod Shortcut for Cnew>.
#pod
#pod     $v = Version::Dotted->new( $arg );
#pod     $v = qv( $arv );    # ditto
#pod
#pod Note: There is I function C, C function is installed into importer
#pod package by explicit request, see L.
#pod
#pod =cut

#   We have to redefine parents' import. Otherwise we will export `qv` into importer namespace by
#   default. Explicit import of `qv` is a good idea, though.

sub import {                                    ## no critic ( RequireArgUnpacking )
    my ( $class, @list ) = @_;
    my $pkg = caller();
    my %args = map( { $_ => 1 } @list );
    if ( delete( $args{ qv } ) ) {
        my $qv = $pkg . '::qv';
        no strict 'refs';                       ## no critic ( ProhibitNoStrict )
        no warnings qw{ redefine prototype };   ## no critic ( ProhibitNoWarnings )
        $class->_warn( "Subroutine '$qv' redefined" ) if defined &$qv;
        *$qv = sub ($) {
            return $class->new( @_ );
        };
    };
    if ( %args ) {
        $class->_warn( "Bad $class import: " . join( ', ', map( { "'$_'" } keys( %args ) ) ) );
    };
    return;
};

1;

# --------------------------------------------------------------------------------------------------

#pod =head1 SEE ALSO
#pod
#pod =begin :list
#pod
#pod = L
#pod
#pod Parent class. It provides most of functionality, can work with decimal versions, but does not
#pod provide any modifiers. Release status depends on presence of underscore character in version.
#pod
#pod = L
#pod
#pod An alternative to C. It works with both decimal and dotted versions, provides modification
#pod operations. Release status depends on presence of underscore character in version.
#pod
#pod = L
#pod
#pod TODO
#pod
#pod = L
#pod
#pod Subclass implementing Perlish approach to Semantic Versioning.
#pod
#pod = L
#pod
#pod Subclass implementing odd/even versioning scheme.
#pod
#pod =end :list
#pod
#pod =head1 COPYRIGHT AND LICENSE
#pod
#pod Copyright (C) 2016 Van de Bugger
#pod
#pod License GPLv3+: The GNU General Public License version 3 or later
#pod .
#pod
#pod This is free software: you are free to change and redistribute it. There is
#pod NO WARRANTY, to the extent permitted by law.
#pod
#pod
#pod =cut

#   ------------------------------------------------------------------------------------------------
#
#   file: doc/what.pod
#
#   This file is part of perl-Version-Dotted.
#
#   ------------------------------------------------------------------------------------------------

#pod =encoding UTF-8
#pod
#pod =head1 WHAT?
#pod
#pod C and its subclasses complement standard C class with version
#pod modification operations, which can be useful in distribution release tools.
#pod
#pod =cut

# end of file #
#   ------------------------------------------------------------------------------------------------
#
#   file: doc/why.pod
#
#   This file is part of perl-Version-Dotted.
#
#   ------------------------------------------------------------------------------------------------

#pod =encoding UTF-8
#pod
#pod =head1 WHY?
#pod
#pod In my C C plugin I need to bump current distribution version.
#pod
#pod I C is an official Perl module (and also a module recommended by C) to
#pod compare versions:
#pod
#pod     if ( version->parse( $Module::VERSION ) < '0.10.1' ) {
#pod         plan skip_all => "Module $Module::VERSION too old";
#pod     };
#pod
#pod
#pod
#pod When I had a need to manipulate versions, I started to use C (another module
#pod recommended by C) because C does not provide any method to modify version
#pod object. I wanted to bump version of a distribution automatically after release, and
#pod C did the job for me:
#pod
#pod     my $v = Perl::Version->new( $self->zilla->version );
#pod     $v->inc_alpha();
#pod
#pod (The idea is: If I just released v0.10.1, the version of the next release would be automatically
#pod set to v0.10.1_01. If I released v0.10.1_01, the next version would be v0.10.1_02, and so on. If I
#pod decided it is time to release non-trial version, I would manually set version to v0.10.2 or
#pod whatever else, e. g. v0.11.0 or v1.0.0.)
#pod
#pod Everything was ok. However, I accidentally found that
#pod
#pod     version->parse( 'v0.10.1_01' ) > 'v0.10.2'  # is true
#pod
#pod Oops. That's was quite surprising, because some time ago this expression had opposite result:
#pod
#pod     version->parse( 'v0.10.1_01' ) < 'v0.10.2'  # was true
#pod
#pod Little investigation shown the breaking change is in C 0.9913: earlier versions interpret
#pod underscore as version part delimiter ('v0.10.1_01' is the same as 'v0.10.1.1'+trial), but 0.9913
#pod and later versions do not ('v0.10.1_01' is the same as 'v.10.101'+trial).
#pod
#pod Ignoring underscore is probably a right thing to do, because it is the way how Perl itself
#pod interprets v-strings:
#pod
#pod     v0.10.1_01 eq v0.10.101     # is true
#pod
#pod but it is definitely a change which makes C useless (to me).
#pod
#pod =cut

# end of file #


# end of file #

__END__