view release on metacpan or  search on metacpan

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

            next if( $vers == version->parse( $1 ) );
            return(0);
        }
        if( /^([=!<>]=|[<>])(\d+([._]\d+)*)$/ )
        {
            next if( $cmp->{ $1 }->( $vers, version->parse( $2 ) ) );
            return(0);
        }
        if( /^(\d+([._]\d+)*)\.\.(\d+([._]\d+)*)$/ )
        {
            if( ( version->parse( $1 ) <= $vers ) &&
                ( $vers <= version->parse( $3 ) ) )
            {
                next;
            }
            return(0);
        }
        return( $self->error( "Bad predicate '$_'" ) );
    }
    return(1);
}

sub target { return( shift->_set_get_scalar_as_object( 'target', @_ ) ); }

sub type { return( shift->reset(@_)->_set_get_scalar_as_object({
    field => 'type',
    callbacks => 
    {
        add => sub
        {
            my $self = shift( @_ );
            if( $self->{type} eq 'decimal' )
            {
                $self->{qv} = 0;
            }
            elsif( $self->{type} eq 'dotted' )
            {
                # By default
                $self->{qv} = 1;
            }
            return( $self->{type} );
        }
    }
}, @_ ) ); }

sub _bool
{
    my $self = shift( @_ );
    # return( $self->_compare( $self->_version, version->new("0"), 1 ) );
    return( $self->_compare( $self, "0", 1 ) );
}

sub _bubble
{
    my $self = shift( @_ );
    my $frag = shift( @_ );
    my $val  = shift( @_ );
    # We die, because this is an internal method and those cases should not happen unless this were a design bug
    if( !defined( $frag ) || !length( $frag ) )
    {
        die( "No fragment was provided to cascade" );
    }
    elsif( $frag !~ /^(major|minor|patch|alpha|\d+)$/ )
    {
        die( "Unsupported version fragment '$frag'. Only use 'major', 'minor', 'patch' or 'alpha' or a number starting from 1 (1 = major, 2 = minor, etc)." );
    }
    # Not for us. We bubble only when a value is negative resulting from a cascading decrease
    # e.g. 3.12.-1 -> 3.11.0, or 3.0.-1 -> 2.9.0, or 2.-1 -> 1.0
    elsif( $val >= 0 )
    {
        return;
    }
    my $type = $self->type;
    my $extra = $self->extra;
    my $frag_is_int = ( $frag =~ /^\d+$/ ? 1 : 0 );
    my $frag2num =
    {
        major => 1,
        minor => 2,
        patch => 3,
    };
    my $num2frag =
    {
        1 => 'major',
        2 => 'minor',
        3 => 'patch',
    };

    if( $frag eq 'alpha' )
    {
        $self->alpha( undef );
        return;
    }
    die( "Fragment provided '$frag' cannot be 0." ) if( $frag_is_int && $frag == 0 );
    my $level = $frag_is_int ? $frag : $frag2num->{ $frag };

    # Should not be happening
    if( $type eq 'decimal' && $level > 2 )
    {
        $self->patch( undef );
        $self->alpha( undef );
        @$extra = ();
        return;
    }

    for( my $i = $level; $level >= 1; $i-- )
    {
        if( $val < 0 )
        {
            my $new_val = 0;
            unless( $i == 1 )
            {
                my $up_val;
                my $j = $i - 1;
                if( exists( $num2frag->{ $j } ) )
                {
                    my $coderef = $self->can( $num2frag->{ $j } ) ||
                        die( "Cannot find reference for method ", $num2frag->{ $j } );
                    $up_val = $coderef->( $self );
                }
                else
                {
                    $up_val = $extra->[ $j - 4 ];
                }
                # Set value for next iteration
                $val = ( $up_val // 0 ) - 1;
                $new_val = ( $up_val > 0 ) ? 9 : 0;
            }

            if( exists( $num2frag->{ $i } ) )
            {
                # my $coderef = $self->can( $num2frag->{ $i } ) ||
                #     die( "Cannot find reference for method ", $num2frag->{ $i } );
                # $coderef->( $self, 0 );
                $self->{ $num2frag->{ $i } } = $new_val;
            }
            else
            {
                $extra->[ $i - 4 ] = $new_val;
            }
        }
        else
        {
            if( exists( $num2frag->{ $i } ) )
            {
                # my $coderef = $self->can( $num2frag->{ $i } ) ||
                #     die( "Cannot find reference for method ", $num2frag->{ $i } );
                # $coderef->( $self, 0 );
                $self->{ $num2frag->{ $i } } = $val;
            }
            else
            {
                $extra->[ $i - 4 ] = $val;
            }
            last;
        }
    }
    $self->_cascade( $level );
}

sub _cascade
{
    my $self = shift( @_ );
    my $frag = shift( @_ );
    # We die, because this is an internal method and those cases should not happen unless this were a design bug
    if( !defined( $frag ) || !length( $frag ) )
    {
        die( "No fragment was provided to cascade" );
    }
    elsif( $frag !~ /^(major|minor|patch|alpha|\d+)$/ )
    {
        die( "Unsupported version fragment '$frag'. Only use 'major', 'minor', 'patch' or 'alpha' or a number starting from 1 (1 = major, 2 = minor, etc)." );
    }
    my $type = $self->type;
    my $extra = $self->extra;
    my $frag_is_int = ( $frag =~ /^\d+$/ ? 1 : 0 );
    if( $frag eq 'major' || ( $frag_is_int && $frag == 1 ) )
    {
        $self->alpha( undef );
        $self->patch(0);
        # $self->patch( $type eq 'decimal' ? undef : 0 );
        $self->minor(0);
    }
    elsif( $frag eq 'minor' || ( $frag_is_int && $frag == 2 ) )
    {
        $self->alpha( undef );
        $self->patch(0);
        # $self->patch( $type eq 'decimal' ? undef : 0 );
    }
    elsif( $frag eq 'patch' || ( $frag_is_int && $frag == 3 ) )
    {
        $self->alpha( undef );
    }
    elsif( $frag eq 'alpha' )
    {
        # Nothing to do
    }
    elsif( $type eq 'dotted' && $frag_is_int )
    {
        my $offset = ( $frag - 4 );
        my $len = $extra->length;
        # Before the fragment offset, we set the value to 0 if it is undefined or empty, and
        # after the fragment offset everything else is reset to 0
        for( my $i = 0; $i < ( $offset < $len ? $len : $offset ); $i++ )
        {
            if( (
                    $i < $offset && 
                    ( !defined( $extra->[$i] ) || !length( $extra->[$i] ) )
                ) || $i > $offset )
            {
                $extra->[$i] = 0;
            }
        }
        $self->alpha( undef );
    }
}

sub _compare
{
    my( $left, $right, $swap ) = @_;
    my $class = ref( $left );
    return(0) if( ${^GLOBAL_PHASE} eq 'DESTRUCT' );
    unless( $left->_is_a( $right => $class ) )
    {
        $right = $class->new( $right, debug => $left->debug );
    }

    if( $swap )

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

    elsif( !$self->_is_a( $val => 'Module::Generic::Number' ) )
    {
        $val = $self->new_number( "$val" );
        if( !defined( $val ) )
        {
            $err = $self->error->message;
        }
    }
    my $n = $val->scalar;
    my $eval;
    if( $op eq '++' || $op eq '--' )
    {
        $eval = "\$n${op}";
    }
    else
    {
        $eval = $swap ? ( defined( $other ) ? $other : 'undef' ) . "${op} \$n" : "\$n ${op} " . ( defined( $other ) ? $other : 'undef' );
    }
    my $rv = eval( $eval );
    $err = $@ if( $@ );
    if( defined( $err ) )
    {
        warn( $err, "\n" ) if( $self->_warnings_is_enabled );
        # Return unchanged
        # return( $swap ? $other : $self );
        return;
    }

    if( $swap )
    {
        return( ref( $rv ) ? $rv->scalar : $rv );
    }
    else
    {
        my $new = $clone;
        my $new_val;
        if( $op eq '++' || $op eq '--' )
        {
            $new = $self;
            $new_val = $n;
        }
        else
        {
            $new_val = int( $rv );
        }

        if( $new_val < 0 )
        {
            $new->_bubble( $frag, $new_val );
        }
        else
        {
            if( defined( $coderef ) )
            {
                $coderef->( $new, $new_val );
            }
            else
            {
                $extra->[( $frag - 4 )] = $new_val;
            }
            $new->_cascade( $frag );
        }
        $new->reset(1);
        return( $new );
    }
}

sub _inc_dec
{
    my $self = shift( @_ );
    my $op = shift( @_ ) || return( $self->error( "No op was provided." ) );
    return( $self->error( "Op can only be 'inc' or 'dec'" ) ) if( $op !~ /^(inc|dec)$/ );
    my $frag = shift( @_ );
    my $unit = shift( @_ );
    if( !defined( $frag ) || !length( "$frag" ) )
    {
        return( $self->error( "No version fragment was specified to ", ( $op eq 'inc' ? 'increase' : 'decrease' ), " the version number." ) );
    }
    elsif( $frag !~ /^(major|minor|patch|alpha|\d+)$/ )
    {
        return( $self->error( "Unsupported version fragment '$frag' to ", ( $op eq 'inc' ? 'increase' : 'decrease' ), ". Only use 'major', 'minor', 'patch' or 'alpha' or a number starting from 1 (1 = major, 2 = minor, etc)." ) );
    }
    if( defined( $unit ) && $unit !~ /^\d+$/ )
    {
        return( $self->error( "Unit to ", ( $op eq 'inc' ? 'increase' : 'decrease' ), " fragment $frag value must be an integer." ) );
    }
    my $extra = $self->extra;
    my $frag_is_int = ( $frag =~ /^\d+$/ ? 1 : 0 );
    my $map =
    {
    1 => 'major',
    2 => 'minor',
    3 => 'patch',
    };
    my $coderef;
    if( ( $frag_is_int && exists( $map->{ $frag } ) ) || !$frag_is_int )
    {
        $coderef = $self->can( $map->{ $frag } // $frag ) ||
            die( "Cannot find code reference for method ", ( $frag_is_int ? $map->{ $frag } : $frag ) );
    }
    my $n = defined( $coderef ) ? $coderef->( $self ) : $extra->[ $frag - 4 ];
    # The offset specified is out of bound
    if( $frag_is_int && ( $frag - 4 ) > $extra->size )
    {
        $n = (
            $op eq 'inc'
                ? ( defined( $unit ) ? $unit : 1 )
                : 0
        );
    }
    elsif( defined( $unit ) && $unit == 1 )
    {
        $op eq 'inc' ? ( $n += $unit ) : ( $n -= $unit );
    }
    else
    {
        $op eq 'inc' ? $n++ : $n--;
    }

    if( defined( $coderef ) )
    {
        $coderef->( $self, $n );
    }
    else
    {
        $extra->[( $frag - 4 )] = $n;
    }
    $self->_cascade( $frag );
    $self->reset(1);
    return( $self );
}

sub _noop
{
    my( $self, $other, $swap, $nomethod, $bitwise ) = @_;
    warn( "This operation $nomethod is not supported by Changes::Version\n" ) if( $self->_warnings_is_enabled );
}

sub _stringify
{
    my $self = shift( @_ );
    my $comp = $self->new_array;
    my $def = {};
    for( qw( major minor patch alpha ) )
    {
        $def->{ $_ } = $self->$_;
    }
    my $type = $self->type;
    $def->{major} = 0 if( !defined( $def->{major} ) || !length( $def->{major} ) );
    if( $self->qv || ( ( $type // '' ) eq 'dotted' ) )
    {
        $def->{minor} = 0 if( !defined( $def->{minor} ) || !length( "$def->{minor}" ) );
        $def->{patch} = 0 if( !defined( $def->{patch} ) || !length( "$def->{patch}" ) );
    }
    elsif( ( $type // '' ) eq 'decimal' )
    {
        # We need to avoid the scenario where we would have a major and alpha, but not minor.
        # For example: 3_6 would trigger version error "Invalid version format (alpha without decimal)"
        $def->{minor} = 0 if( ( !defined( $def->{minor} ) || !length( "$def->{minor}" ) ) && defined( $def->{alpha} ) && length( "$def->{alpha}" ) );
    }
    my $ok = 0;
    if( !$self->extra->is_empty )
    {
        $ok++;
        $comp->push( $self->extra->list );
    }
    for( qw( patch minor major ) )
    {
        next if( !length( $def->{ $_ } ) && !$ok );
        # We stop skipping version fragments as soon as one is defined
        $ok++;
        $comp->unshift( $def->{ $_ } );
    }
    my $v = ( $self->qv ? 'v' : '' ) . $comp->map(sub{ 0 + $_ })->join( '.' )->scalar;
    $v .= '_' . $def->{alpha} if( defined( $def->{alpha} ) && length( $def->{alpha} ) );
    return( $v );
}

sub _verify
{
    my $self = shift( @_ );
    return(0) if( ${^GLOBAL_PHASE} eq 'DESTRUCT' );
    unless( defined( $self ) && ref( $self ) eq 'Changes::Version' )
    {
        return(0);
    }
    if( eval{ exists( $self->{_version} ) } &&
        Module::Generic->_is_a( $self->{_version} => 'version' ) )