Aion

 view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

    my ($s, $construct) = @_;
    $s =~ s{%\((\w*)\)s}{
        die "has: not construct `$1`\!" unless exists $construct->{$1};
        _resolv($construct->{$1}, $construct);
    }ge;
    $s
}

# конструктор
sub new {
	my ($self, @errors) = create_from_params(@_);

	die join "", "has:\n\n", map "* $_\n", @errors if @errors;

	$self
}

# Устанавливает свойства и выдаёт объект и ошибки
sub create_from_params {
	my ($cls, %value) = @_;

	$cls = ref $cls || $cls;
	is_aion $cls;

	my $self = bless {}, $cls;

	my @init;
	my @required;
	my @errors;
    my $FEATURE = $Aion::META{$cls}{feature};

	while(my ($name, $feature) = each %$FEATURE) {

		if(exists $value{$name}) {
			my $val = delete $value{$name};

			if(!$feature->{excessive}) {
				$val = $feature->{coerce}->coerce($val) if $feature->{coerce};

				push @errors, $feature->{isa}->detail($val, "Feature $name")
                    if ISA =~ /w/ && $feature->{isa} && !$feature->{isa}->include($val);
				$self->{$name} = $val;
				push @init, $feature if $feature->{init};
			}
			else {
				push @errors, "Feature $name cannot set in new!";
			}
		} elsif($feature->{required}) {
            push @required, $name;
        } elsif(exists $feature->{default}) {
			$self->{$name} = $feature->{default};
			push @init, $feature if $feature->{init};
		}

	}

	for my $feature (@init) {
		for my $init (@{$feature->{init}}) {
			$init->($self, $feature);
		}
	}

	do {local $" = ", "; unshift @errors, "Features @required is required!"} if @required > 1;
	unshift @errors, "Feature @required is required!" if @required == 1;

	my @fakekeys = sort keys %value;
	unshift @errors, "@fakekeys is not feature!" if @fakekeys == 1;
	do {local $" = ", "; unshift @errors, "@fakekeys is not features!"} if @fakekeys > 1;

	return $self, @errors;
}

1;

__END__

=encoding utf-8

=head1 NAME

lib/Aion/Type.md  view on Meta::CPAN

push @{$Int->{coerce}}, [$Bool, sub { 0+$_ }];
push @{$Int->{coerce}}, [$Num, sub { int($_+.5) }];

$Int->coerce(5.5)    # => 6
$Int->coerce(undef)  # => 0
$Int->coerce("abc")  # => abc
```

## detail ($element, $feature)

Return message belongs to error.

```perl
my $Int = Aion::Type->new(name => "Int");

$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5

my $Num = Aion::Type->new(name => "Num", detail => sub {
    my ($val, $name) = @_;
    "Error: $val is'nt $name!"
});

lib/Aion/Type.md  view on Meta::CPAN


Property `init` won't use with `make`.

```perl
eval { Aion::Type->new(name=>"Rim", init => sub {...})->make(__PACKAGE__) }; $@ # ~> init_where won't work in Rim
```

If subroutine make'nt, then died.

```perl
eval { Aion::Type->new(name=>"Rim")->make }; $@ # ~> syntax error
```

## make_arg ($pkg)

It make subroutine with arguments, who return type.

```perl
BEGIN {
    Aion::Type->new(name=>"Len", test => sub {
        $Aion::Type::SELF->{args}[0] <= length($_) && length($_) <= $Aion::Type::SELF->{args}[1]
    })->make_arg(__PACKAGE__);
}

"IX" ~~ Len[2,2]    # => 1
```

If subroutine make'nt, then died.

```perl
eval { Aion::Type->new(name=>"Rim")->make_arg }; $@ # ~> syntax error
```

## make_maybe_arg ($pkg)

It make subroutine with or without arguments, who return type.

```perl
BEGIN {
    Aion::Type->new(
        name => "Enum123",

lib/Aion/Type.md  view on Meta::CPAN

}

3 ~~ Enum123            # -> 1
3 ~~ Enum123[4,5,6]     # -> ""
5 ~~ Enum123[4,5,6]     # -> 1
```

If subroutine make'nt, then died.

```perl
eval { Aion::Type->new(name=>"Rim")->make_maybe_arg }; $@ # ~> syntax error
```

# OPERATORS

## &{}

It make the object is callable.

```perl
my $PositiveInt = Aion::Type->new(

lib/Aion/Type.pm  view on Meta::CPAN

	
	push @{$Int->{coerce}}, [$Bool, sub { 0+$_ }];
	push @{$Int->{coerce}}, [$Num, sub { int($_+.5) }];
	
	$Int->coerce(5.5)    # => 6
	$Int->coerce(undef)  # => 0
	$Int->coerce("abc")  # => abc

=head2 detail ($element, $feature)

Return message belongs to error.

	my $Int = Aion::Type->new(name => "Int");
	
	$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5
	
	my $Num = Aion::Type->new(name => "Num", detail => sub {
	    my ($val, $name) = @_;
	    "Error: $val is'nt $name!"
	});
	

lib/Aion/Type.pm  view on Meta::CPAN

	}
	
	"IX" ~~ Rim     # => 1

Property C<init> won't use with C<make>.

	eval { Aion::Type->new(name=>"Rim", init => sub {...})->make(__PACKAGE__) }; $@ # ~> init_where won't work in Rim

If subroutine make'nt, then died.

	eval { Aion::Type->new(name=>"Rim")->make }; $@ # ~> syntax error

=head2 make_arg ($pkg)

It make subroutine with arguments, who return type.

	BEGIN {
	    Aion::Type->new(name=>"Len", test => sub {
	        $Aion::Type::SELF->{args}[0] <= length($_) && length($_) <= $Aion::Type::SELF->{args}[1]
	    })->make_arg(__PACKAGE__);
	}
	
	"IX" ~~ Len[2,2]    # => 1

If subroutine make'nt, then died.

	eval { Aion::Type->new(name=>"Rim")->make_arg }; $@ # ~> syntax error

=head2 make_maybe_arg ($pkg)

It make subroutine with or without arguments, who return type.

	BEGIN {
	    Aion::Type->new(
	        name => "Enum123",
	        test => sub { $_ ~~ [1,2,3] },
	        a_test => sub { $_ ~~ $Aion::Type::SELF->{args} },
	    )->make_maybe_arg(__PACKAGE__);
	}
	
	3 ~~ Enum123            # -> 1
	3 ~~ Enum123[4,5,6]     # -> ""
	5 ~~ Enum123[4,5,6]     # -> 1

If subroutine make'nt, then died.

	eval { Aion::Type->new(name=>"Rim")->make_maybe_arg }; $@ # ~> syntax error

=head1 OPERATORS

=head2 &{}

It make the object is callable.

	my $PositiveInt = Aion::Type->new(
	    name => "PositiveInt",
	    test => sub { /^\d+$/ },

lib/Aion/Types.md  view on Meta::CPAN

"Hi, my dear!" ~~ BeginAndEnd["Hi,", "!"]   # -> 1
"Hi my dear!" ~~ BeginAndEnd["Hi,", "!"]   # -> ""

BeginAndEnd["Hi,", "!"]   # => BeginAndEnd['Hi,', '!']
```



## message ($code)

Use with `subtype` for make the message on error, if the value excluded the type. In `$code` use subroutine: `SELF` - the current type, `ARGS`, `A`, `B`, `C`, `D` - arguments of type (if is), and the testing value in `$_`. It can be stringified using...

## coerce ($type, from => $from, via => $via)

It add new coerce ($via) to `$type` from `$from`-type.

```perl
BEGIN {subtype Four => where {4 eq $_}}

"4a" ~~ Four	# -> ""

lib/Aion/Types.md  view on Meta::CPAN

Strings, include numbers.

```perl
1.1 ~~ Str         # -> 1
"" ~~ Str          # -> 1
1.1.0 ~~ Str       # -> ""
```

## Uni

Unicode strings: with utf8-flag or decode to utf8 without error.

```perl
"↭" ~~ Uni    # -> 1
123 ~~ Uni    # -> ""
do {no utf8; "↭" ~~ Uni}    # -> 1
```

## Bin

Binary strings: without utf8-flag and octets with numbers less then 128.

lib/Aion/Types.pm  view on Meta::CPAN

			where { $_ =~ N && $_ =~ M };
	}
	
	"Hi, my dear!" ~~ BeginAndEnd["Hi,", "!"]   # -> 1
	"Hi my dear!" ~~ BeginAndEnd["Hi,", "!"]   # -> ""
	
	BeginAndEnd["Hi,", "!"]   # => BeginAndEnd['Hi,', '!']

=head2 message ($code)

Use with C<subtype> for make the message on error, if the value excluded the type. In C<$code> use subroutine: C<SELF> - the current type, C<ARGS>, C<A>, C<B>, C<C>, C<D> - arguments of type (if is), and the testing value in C<$_>. It can be stringif...

=head2 coerce ($type, from => $from, via => $via)

It add new coerce ($via) to C<$type> from C<$from>-type.

	BEGIN {subtype Four => where {4 eq $_}}
	
	"4a" ~~ Four	# -> ""
	
	Four->coerce("4a")	# -> "4a"

lib/Aion/Types.pm  view on Meta::CPAN

=head2 Str

Strings, include numbers.

	1.1 ~~ Str         # -> 1
	"" ~~ Str          # -> 1
	1.1.0 ~~ Str       # -> ""

=head2 Uni

Unicode strings: with utf8-flag or decode to utf8 without error.

	"↭" ~~ Uni    # -> 1
	123 ~~ Uni    # -> ""
	do {no utf8; "↭" ~~ Uni}    # -> 1

=head2 Bin

Binary strings: without utf8-flag and octets with numbers less then 128.

	123 ~~ Bin    # -> 1

t/aion/type.t  view on Meta::CPAN

push @{$Int->{coerce}}, [$Bool, sub { 0+$_ }];
push @{$Int->{coerce}}, [$Num, sub { int($_+.5) }];

::is scalar do {$Int->coerce(5.5)}, "6", '$Int->coerce(5.5)    # => 6';
::is scalar do {$Int->coerce(undef)}, "0", '$Int->coerce(undef)  # => 0';
::is scalar do {$Int->coerce("abc")}, "abc", '$Int->coerce("abc")  # => abc';

# 
# ## detail ($element, $feature)
# 
# Return message belongs to error.
# 
done_testing; }; subtest 'detail ($element, $feature)' => sub { 
my $Int = Aion::Type->new(name => "Int");

::is scalar do {$Int->detail(-5, "Feature car")}, "Feature car must have the type Int. The it is -5", '$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5';

my $Num = Aion::Type->new(name => "Num", detail => sub {
    my ($val, $name) = @_;
    "Error: $val is'nt $name!"
});

t/aion/type.t  view on Meta::CPAN

# 
# Property `init` won't use with `make`.
# 

::like scalar do {eval { Aion::Type->new(name=>"Rim", init => sub {...})->make(__PACKAGE__) }; $@}, qr!init_where won't work in Rim!, 'eval { Aion::Type->new(name=>"Rim", init => sub {...})->make(__PACKAGE__) }; $@ # ~> init_where won\'t work in Rim'...

# 
# If subroutine make'nt, then died.
# 

::like scalar do {eval { Aion::Type->new(name=>"Rim")->make }; $@}, qr!syntax error!, 'eval { Aion::Type->new(name=>"Rim")->make }; $@ # ~> syntax error';

# 
# ## make_arg ($pkg)
# 
# It make subroutine with arguments, who return type.
# 
done_testing; }; subtest 'make_arg ($pkg)' => sub { 
BEGIN {
    Aion::Type->new(name=>"Len", test => sub {
        $Aion::Type::SELF->{args}[0] <= length($_) && length($_) <= $Aion::Type::SELF->{args}[1]
    })->make_arg(__PACKAGE__);
}

::is scalar do {"IX" ~~ Len[2,2]}, "1", '"IX" ~~ Len[2,2]    # => 1';

# 
# If subroutine make'nt, then died.
# 

::like scalar do {eval { Aion::Type->new(name=>"Rim")->make_arg }; $@}, qr!syntax error!, 'eval { Aion::Type->new(name=>"Rim")->make_arg }; $@ # ~> syntax error';

# 
# ## make_maybe_arg ($pkg)
# 
# It make subroutine with or without arguments, who return type.
# 
done_testing; }; subtest 'make_maybe_arg ($pkg)' => sub { 
BEGIN {
    Aion::Type->new(
        name => "Enum123",

t/aion/type.t  view on Meta::CPAN

}

::is scalar do {3 ~~ Enum123}, scalar do{1}, '3 ~~ Enum123            # -> 1';
::is scalar do {3 ~~ Enum123[4,5,6]}, scalar do{""}, '3 ~~ Enum123[4,5,6]     # -> ""';
::is scalar do {5 ~~ Enum123[4,5,6]}, scalar do{1}, '5 ~~ Enum123[4,5,6]     # -> 1';

# 
# If subroutine make'nt, then died.
# 

::like scalar do {eval { Aion::Type->new(name=>"Rim")->make_maybe_arg }; $@}, qr!syntax error!, 'eval { Aion::Type->new(name=>"Rim")->make_maybe_arg }; $@ # ~> syntax error';

# 
# # OPERATORS
# 
# ## &{}
# 
# It make the object is callable.
# 
done_testing; }; subtest '&{}' => sub { 
my $PositiveInt = Aion::Type->new(

t/aion/types.t  view on Meta::CPAN

::is scalar do {"Hi, my dear!" ~~ BeginAndEnd["Hi,", "!"]}, scalar do{1}, '"Hi, my dear!" ~~ BeginAndEnd["Hi,", "!"]   # -> 1';
::is scalar do {"Hi my dear!" ~~ BeginAndEnd["Hi,", "!"]}, scalar do{""}, '"Hi my dear!" ~~ BeginAndEnd["Hi,", "!"]   # -> ""';

::is scalar do {BeginAndEnd["Hi,", "!"]}, "BeginAndEnd['Hi,', '!']", 'BeginAndEnd["Hi,", "!"]   # => BeginAndEnd[\'Hi,\', \'!\']';

# 
# 
# 
# ## message ($code)
# 
# Use with `subtype` for make the message on error, if the value excluded the type. In `$code` use subroutine: `SELF` - the current type, `ARGS`, `A`, `B`, `C`, `D` - arguments of type (if is), and the testing value in `$_`. It can be stringified usi...
# 
# ## coerce ($type, from => $from, via => $via)
# 
# It add new coerce ($via) to `$type` from `$from`-type.
# 
done_testing; }; subtest 'coerce ($type, from => $from, via => $via)' => sub { 
BEGIN {subtype Four => where {4 eq $_}}

::is scalar do {"4a" ~~ Four}, scalar do{""}, '"4a" ~~ Four	# -> ""';

t/aion/types.t  view on Meta::CPAN

# Strings, include numbers.
# 
done_testing; }; subtest 'Str' => sub { 
::is scalar do {1.1 ~~ Str}, scalar do{1}, '1.1 ~~ Str         # -> 1';
::is scalar do {"" ~~ Str}, scalar do{1}, '"" ~~ Str          # -> 1';
::is scalar do {1.1.0 ~~ Str}, scalar do{""}, '1.1.0 ~~ Str       # -> ""';

# 
# ## Uni
# 
# Unicode strings: with utf8-flag or decode to utf8 without error.
# 
done_testing; }; subtest 'Uni' => sub { 
::is scalar do {"↭" ~~ Uni}, scalar do{1}, '"↭" ~~ Uni    # -> 1';
::is scalar do {123 ~~ Uni}, scalar do{""}, '123 ~~ Uni    # -> ""';
::is scalar do {do {no utf8; "↭" ~~ Uni}}, scalar do{1}, 'do {no utf8; "↭" ~~ Uni}    # -> 1';

# 
# ## Bin
# 
# Binary strings: without utf8-flag and octets with numbers less then 128.



( run in 0.697 second using v1.01-cache-2.11-cpan-65fba6d93b7 )