view release on metacpan or  search on metacpan

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

                $self->{_version} = $v;
            };
            if( $@ )
            {
                warn( "Warning only: error trying to get a version object from version string '$str': $@\n" ) if( $self->_warnings_is_enabled );
            }
        }
    }
    return( $self );
}

# Credit: Data::VString
sub satisfy
{
    my $this = shift( @_ );
    my $self = ( __PACKAGE__->_is_object( $this ) && $this->isa( 'Changes::Version' ) ) ? $this : $this->parse( shift( @_ ) );
    my $predicate = shift( @_ );
    # spaces are irrelevant
    $predicate =~ s/[[:blank:]\h\v]+//g;
    my $vers = $self->_version;
    my @p = split( ',', $predicate );
    my $cmp = 
    {
        '==' => sub{ $_[0] == $_[1] },
        '!=' => sub{ $_[0] != $_[1] },
        '<=' => sub{ $_[0] <= $_[1] },
        '>=' => sub{ $_[0] >= $_[1] },
        '<'  => sub{ $_[0] < $_[1] },
        '>'  => sub{ $_[0] > $_[1] },
    };
    for( @p )
    {
        if( /^(\d+([._]\d+)*)$/ )
        {
            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',
    };