• Your recent searches
Aion
10 results

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN 

```

Файл lib/Role/Values/Stringify.pm:
```perl
package Role::Values::Stringify;

use Aion -role;

sub valsify {
	my ($self) = @_;
	join ", ", map $self->{$_}, sort keys %$self;
}

1;
```

Файл lib/Class/All/Stringify.pm:
```perl
package Class::All::Stringify;

use Aion;

lib/Aion.md  view on Meta::CPAN 

```

Файл lib/Role/Values/Stringify.pm:
```perl
package Role::Values::Stringify;

use Aion -role;

sub valsify {
	my ($self) = @_;
	join ", ", map $self->{$_}, sort keys %$self;
}

1;
```

Файл lib/Class/All/Stringify.pm:
```perl
package Class::All::Stringify;

use Aion;

lib/Aion.pm  view on Meta::CPAN 

			local $" = ", ";
			die "@fakekeys is'nt features!"
		}

		return $self;
	}
}
END

    my @destroyers;
	my $initializers = join "", map {
		push @destroyers, $_->{construct}->destroyer if $_->{cleaner};
		$_->{construct}->initializer
	} sort { $a->{order} <=> $b->{order} } values %$FEATURE;
	
	my %var = (
		cls => $cls,
		initializers => $initializers,
	);
	
	$new =~ s/%\((\w+)\)s/$var{$1}/ge;

lib/Aion.pm  view on Meta::CPAN 

	1;

File lib/Role/Values/Stringify.pm:

	package Role::Values::Stringify;
	
	use Aion -role;
	
	sub valsify {
		my ($self) = @_;
		join ", ", map $self->{$_}, sort keys %$self;
	}
	
	1;

File lib/Class/All/Stringify.pm:

	package Class::All::Stringify;
	
	use Aion;

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

package Aion::Meta::Feature;

use common::sense;

use Aion::Meta::Util qw//;
use Aion::Meta::FeatureConstruct;
use List::Util qw/pairmap/;

Aion::Meta::Util::create_getters(qw/pkg name opt has construct order/);
Aion::Meta::Util::create_accessors(qw/
	required excessive isa 
	lazy builder default trigger release cleaner
	make_reader make_writer make_predicate make_clearer
/);

#  Конструктор
sub new {

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

		has => \@has,
		construct => Aion::Meta::FeatureConstruct->new($pkg, $name),
		order => scalar keys %{$meta->{feature}},
		stash => {},
	}, ref $cls || $cls;
}

# Строковое представление фичи
sub stringify {
	my ($self) = @_;
	my $has = join ', ', pairmap { "$a => ${\
		Aion::Meta::Util::val_to_str($b)
	}" } @{$self->{has}};
	return "has $self->{name} => ($has) of $self->{pkg}";
}

# Создаёт свойство
sub mk_property {
	my ($self) = @_;

	my $meta = $Aion::META{$self->pkg};

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

package Aion::Meta::RequiresFeature;

use common::sense;

use Aion::Meta::Util qw//;
use List::Util qw/pairmap/;
use Scalar::Util qw/looks_like_number reftype blessed refaddr/;

Aion::Meta::Util::create_getters(qw/pkg name opt has/);

#  Конструктор
sub new {
	my ($cls, $pkg, $name, @has) = @_;
	bless {pkg => $pkg, name => $name, opt => {@has}, has => \@has}, ref $cls || $cls;
}

# Строковое представление фичи
sub stringify {
	my ($self) = @_;
	my $has = join ', ', pairmap { "$a => ${\
		Aion::Meta::Util::val_to_str($b)
	}" } @{$self->{has}};
	return "req $self->{name} => ($has) of $self->{pkg}";
}

# Сравнивает с фичей, но только значения которые есть в этой
sub compare {
	my ($self, $feature) = @_;

	die "Requires ${\$self->stringify}" unless UNIVERSAL::isa($feature, 'Aion::Meta::Feature');

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


sub val_to_str($;$);
sub val_to_str($;$) {
	my ($v, $depth) = @_;
	
	if (!defined $v) { 'undef' }
	elsif (ref $v eq 'ARRAY') {
		if($depth > MAX_DEPTH) { '[...]' }
		else {
			$depth++;
			join '', '[', join(', ', map({ val_to_str($_, $depth) } (
				@$v > MAX_ARRAY_SIZE ? @$v[0..MAX_ARRAY_SIZE] : @$v
			)), @$v > MAX_ARRAY_SIZE ? '...' : ()), ']';
		}
	}
	elsif (ref $v eq 'HASH') {
		if($depth > MAX_DEPTH) { '{...}' }
		else {
			$depth++;
			join '', '{', join(', ', map({
				qq{$_ => ${\val_to_str($v->{$_}, $depth)}} } (
					keys %$v > MAX_HASH_SIZE
					? (sort keys %$v)[0..MAX_HASH_SIZE]
					: sort keys %$v
				)), keys %$v > MAX_HASH_SIZE ? '...' : ()), '}';
		}
	}
	else {
		my $no_str = ref $v || Scalar::Util::looks_like_number($v);

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


	$self
}

#@category strings

# Строковое представление
sub stringify {
	my ($self) = @_;

	my @args = map Aion::Meta::Util::val_to_str($_), @{$self->{args}};

	$self->is_union? join "", "( ", join(" | ", @args), " )":
	$self->is_intersection? join "", "( ", join(" & ", @args), " )":
	$self->is_exclude? "~$args[0]":
	join("", $self->{name}, @args? ("[", join(", ", @args), "]") : ());
}

# Сообщение об ошибке
sub detail {
	(my $self, local $_, my $name) = @_;

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

sub is_exclude { shift->{name} eq 'Exclude' }
sub is_enum { shift->{name} eq 'Enum' }
sub is_range_type { exists $range_lbound{Scalar::Util::refaddr shift->{coerce}} }
sub range_lbound { $range_lbound{Scalar::Util::refaddr shift->{coerce}} }
sub is_range { shift->range_lbound == '-Inf' }

# Формирует ключ с отсортированными типизированными параметрами
sub typed_sorted_args_key {
	my ($self) = @_;
	my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
	join "-", $coerceaddr, join(",", map { join ":", length($_), $_ } sort map $_->key, @{$self->{args}});
}

# Формирует ключ с отсортированными нетипизированными параметрами
sub sorted_args_key {
	my ($self) = @_;
	my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
	join "-", $coerceaddr, join(",", map { join ":", length($_), $_ } sort @{$self->{args}});
}

# Возвращает уникальный ключ для типа, использующийся в хешах и сравнения
# Должен быть заменён на созданные типы
my %keyfn;
my $undefined = [];
sub key {
	my ($self) = @_;
	$self->{key} //= do {
		my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
		my $keyfn = $keyfn{$coerceaddr};
		$keyfn
			? $keyfn->($self)
			: join "-", $coerceaddr, exists $self->{args} && @{$self->{args}} || exists $self->{N} || exists $self->{M}
				? join(",", map {
					my $key = UNIVERSAL::isa($_, __PACKAGE__)? $_->key: "" . ($_ // $undefined);
					join ":", length($key), $key 
				} @{$self->{args}})
				: ();
	};
}

# Устанавливает/возвращает функцию построения ключа для типа как класса
sub keyfn {
	my ($self, $fn) = @_;

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

	my ($self) = @_;
	my @as;
	for(my $i=$self->{as}; $i; $i = $i->{as}) { unshift @as, $i }
	unshift @as, Any unless @as && $as[0] eq Any;
	@as
}

# Ключ для сравнения типов в <=> и cmp
sub ckey {
	my ($self) = @_;
	$self->{ckey} //= join " <- ", map $_->stringify, $self->asen, $self;
}

# Сравнение для сортировки
sub compare {
	my ($self, $other) = @_;
	$self->ckey cmp $other->ckey;
}

# A потомок B
sub instanceof {

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


	$self->_simplify eq None? None: $self;
}

# A as B as C <=> A & B & C
sub _unfolding {
	my ($self) = @_;
	
	my @u;
	for(my $i=$self; $i; $i = $i->{as}) {
		unshift(@u, $i->clone(args => [map $_->_unfolding, @{$i->{args}}])), last if $i->is_set_theoretic;
		unshift @u, $i if $i->{test} != \&true;
	}

	@u == 0? Any:
	@u == 1? $u[0]: Aion::Types::Intersection(\@u);
}

# Проталкивание исключений к термам, заодно уменьшает размерность с приведением
sub _pushing {
	my ($self) = @_;
	
	if($self->is_exclude) {
		my $inner = $self->{args}[0];
		# ~(~A) => A
		return $inner->{args}[0]->_pushing if $inner->is_exclude;
		# ~(A | B) => ~A & ~B
		return _intersection(map { (~$_)->_pushing } @{$inner->{args}}) if $inner->is_union;
		# ~(A & B) => ~A | ~B
		return _union(map { (~$_)->_pushing } @{$inner->{args}}) if $inner->is_intersection;
		# Range[A, B] => Range[-Inf, Invert[A]] | Range[Invert[B], Inf]
		if($inner->is_range_type) {
			my ($min, $max) = @{$inner->{args}};
			if($inner->is_range) {
				return None if $min == '-Inf' && $max == 'Inf';
				return $inner->clone(args => [Aion::Type::Lim->from($max)->inc, 'Inf']) if $min == '-Inf';
				return $inner->clone(args => ['-Inf', Aion::Type::Lim->from($min)->dec]) if $max == 'Inf';
		        return $inner->clone(args => ['-Inf', Aion::Type::Lim->from($min)->dec]) | $inner->clone(args => [Aion::Type::Lim->from($max)->inc, 'Inf']);
			}
			
			return None if $min == 0 && $max == 'Inf';	
			return $inner->clone(args => [$max+1, 'Inf']) if $min == 0;		
			return $inner->clone(args => [0, $min-1]) if $max == 'Inf';		
			return $inner->clone(args => [0, $min-1]) | $inner->clone(args => [$max+1, 'Inf']);
		}
		return $self;
	}

	return _intersection(map $_->_pushing, @{$self->{args}}) if $self->is_intersection;
	return _union(map $_->_pushing, @{$self->{args}}) if $self->is_union;

	$self
}

# Сжимает в ДНФ
sub _distribute {
	my ($self) = @_;

	# (A|B) & (C|D|E) & F => (A&C&F) | (A&D&F) | (A&E&F) | (B&C&F) | (B&D&F) | (B&E&F)
	if($self->is_intersection) {
		my @disjuncts = map { my $x = $_->_distribute; $x->is_union? [@{$x->{args}}]: [$x] } @{$self->{args}};
		
		my $dnf = List::Util::reduce {
			[ map { my $p = $_; map { [@$p, $_] } @$b } @$a ]
		} [[]], @disjuncts;
		
		return _union(map _intersection(@$_), @$dnf);
	}

	return _union(map $_->_distribute, @{$self->{args}}) if $self->is_union;
	
	$self
}

# Объединение интервалов
sub _union_ranges {
	my ($ranges) = @_;

	# Отсекаем пустые
	my @ranges = grep $_->{args}[0] <= $_->{args}[1], @$ranges;

	# Сортируем в порядке возрастания нижней границы
	(my $range, @ranges) = sort { $a->{args}[0] <=> $b->{args}[0] } @ranges;

	@ranges = map {
		my ($min1, $max1) = @{$range->{args}};
		my ($min2, $max2) = @{$_->{args}};
		if($max1 > $min2) {	$range = $range->clone(args => [$min1, List::Util::max($max1, $max2)]); () }
		else { my $arange = $range; $range = $_; $arange }
	} @ranges;
	push @ranges, $range;

	if(@ranges == 1) {
		my ($min, $max) = @{$range->{args}};
		return Any if $min == $range->range_lbound && $max == 'Inf';

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

		$range = $range->clone(args => [$min2, $max]);
	}

	$range
}

# Объединение перечислений
sub _union_enums($,$) {
	my ($enums, $exclude_enums) = @_;
	
	my %enum = map {($_=>$_)} map @{$_->{args}}, @$enums;
	return $enums->[0]->clone(args => [sort values %enum])->init unless @$exclude_enums;

	my $first_exclude_enum = shift(@$exclude_enums);
	my %exclude_enum = map {($_=>$_)} @{$first_exclude_enum->{args}};
	for my $exclude_enum (@$exclude_enums) {
		delete @exclude_enum{grep { !($_ ~~ $exclude_enum->{args}) } keys %exclude_enum};
		return Any unless keys %exclude_enum;
	}
	
	delete @exclude_enum{keys %enum};

	return Any unless keys %exclude_enum;

	~$first_exclude_enum->clone(args => [sort values %exclude_enum])->init;
}

# Пересечение перечислений
sub _intersection_enums($,$) {
	my ($enums, $exclude_enums) = @_;
	
	my %exclude_enum = map {($_=>$_)} map @{$_->{args}}, @$exclude_enums;
	return ~$exclude_enums->[0]->clone(args => [sort values %exclude_enum])->init unless @$enums;
	
	my $first_enum = shift(@$enums);
	my %enum = map {($_=>$_)} @{$first_enum->{args}};

	for my $enum (@$enums) {
		delete @enum{grep { !($_ ~~ $enum->{args}) } keys %enum};
		return None unless keys %enum;
	}

	delete @enum{keys %exclude_enum};

	return None unless keys %enum;

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

	my $enums_fn = shift;
	my %bag; my @any; my @enums; my @exclude_enums;
	for my $candidate (@_) {
		my $addr = Scalar::Util::refaddr $candidate->{coerce};
		if(exists $range_lbound{$addr}) { push @{$bag{$addr}}, $candidate }
		elsif($candidate->is_enum) { push @enums, $candidate }
		elsif($candidate->is_exclude && $candidate->{args}[0]->is_enum) { push @exclude_enums, $candidate->{args}[0] }
		else { push @any, $candidate }
	}
	
	return @any, @enums || @exclude_enums? $enums_fn->(\@enums, \@exclude_enums): (), map $ranges_fn->($_), values %bag;
}

# Создание пересечения с приведением
sub _intersection(@) {
	my %x = map {($_->key => $_)} _ranges_bag \&_intersection_ranges, \&_intersection_enums, map { $_->is_intersection? @{$_->{args}}: $_ } @_;
	# ~Any & A = ~Any
	return None if exists $x{None->key};
	# Any & A = A
	delete $x{Any->key};
	# Intersection[A] = A
	return (values %x)[0] if 1 == keys %x;
	# Intersection[] = Any
	return Any if 0 == keys %x;
	# A & ~A = ~Any
	return None if List::Util::first { $_->is_exclude && exists $x{$_->{args}[0]->key} } values %x;
	Aion::Types::Intersection([values %x]);
}

# Создание объединения с приведением
sub _union(@) {
	my %x = map {($_->key => $_)} _ranges_bag \&_union_ranges, \&_union_enums, map { $_->is_union? @{$_->{args}}: $_ } @_;
	# Any | A = Any
	return Any if exists $x{Any->key};
	# ~Any | A = A
	delete $x{None->key};
	# Union[A] = A
	return (values %x)[0] if 1 == keys %x;
	# Union[] = None
	return None if 0 == keys %x;
	# A | ~A = Any
	return Any if List::Util::first { $_->is_exclude && exists $x{$_->{args}[0]->key} } values %x;

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

    grep { /^Isa\((.*)\)\z/s? do { _Isa($pkg, $referent, $1); 0 }: 1 } @attributes
}

sub _Isa {
	my ($pkg, $referent, $data) = @_;
	my $subname = Sub::Util::subname $referent;
	$subname =~ s/^.*:://;

	die "Anonymous subroutine cannot use :Isa!" if $subname eq '__ANON__';
	
	my @signature = eval "package $pkg; map { UNIVERSAL::isa(\$_, 'Aion::Type')? \$_: __PACKAGE__->can(\$_)? __PACKAGE__->can(\$_)->(): Aion::Types::External([\$_]) } ($data)";
	die if $@;

	die "$pkg\::$subname has no return type!" if @signature == 0;

	require Aion::Meta::Subroutine;
	my $subroutine = Aion::Meta::Subroutine->new(
		pkg => $pkg,
		subname => $subname,
		signature => \@signature,
		referent => $referent,

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

		$require->compare($subroutine) if $require;

		my $overload = $Aion::META{$pkg}{subroutine}{$subname};
		$overload->compare($subroutine) if $overload;
		
		$subroutine->wrap_sub;
	}	
}

BEGIN {
my $INIT_ARGS = sub { @{&ARGS} = map External([$_]), &ARGS };
my $INIT_KW_ARGS = sub { @{&ARGS} = List::Util::pairmap { $a => External([$b]) } &ARGS };

my $COMBINE_SUBS = sub {
    my ($f1, $f2) = @_;
    sub { $f1->(); $f2->() }
};

my $COMBINE_WHERE = sub {
    my ($f1, $f2) = @_;
    sub { $f1->() && $f2->() }
};

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

		return $Aion::Type::SELF->{N} if $param == -1;
		return $Aion::Type::SELF->{M} if $param == -2;
		return $Aion::Type::SELF if $param == -256;
		return @{$Aion::Type::SELF->{args}} if $param == -1024;
		die "Parameter number invalid!";
	}

	return $arg if !$arg->{args} || !List::Util::first { UNIVERSAL::isa($_, 'Aion::Type') } @{$arg->{args}};

	$arg = bless {%$arg}, 'Aion::Type';
	$arg->{args} = [map $REPLACE_PARAM->($_), @{$arg->{args}}];
	$arg->init if $arg->{init};

	$arg
};

my $INIT_REPLACE_PARAM = sub {
	$Aion::Type::SELF->{as} = $REPLACE_PARAM->($Aion::Type::SELF->{as});
};

# Создание типа

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

						: (),
				)
			}
		}
		subtype "Bool", as &Item, where { ref $_ eq "" and /^(1|0|)\z/ };
		subtype "BoolLike", as &Item, where {
			return 1 if overload::Method($_, 'bool');
			my $m = overload::Method($_, '0+');
			Bool()->include($m ? $m->($_) : $_) };
		subtype "Enum[e...]", as &Item,
			init_where { M = +{ map {($_ => $_)} ARGS } }
			where { exists M->{$_} };
		subtype "Undef", as &Item, where { !defined $_ };
		subtype "Maybe[A]", as &Undef | A;
		subtype "Defined", as &Item, where { defined $_ };
			subtype "Value", as &Defined, where { "" eq ref $_ };
				subtype "Version", as &Value, where { "VSTRING" eq ref \$_ };
				subtype "Str", as &Value, where { "SCALAR" eq ref \$_ };
					subtype "Uni", as &Str,	where { utf8::is_utf8($_) || /[\x80-\xFF]/a };
					subtype "Bin", as &Str, where { !utf8::is_utf8($_) && !/[\x80-\xFF]/a };
					subtype "NonEmptyStr", as &Str,	where { /\S/ };

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

				subtype "LValueRef", as &Ref, where { ref $_ eq "LVALUE" };
				subtype "FormatRef", as &Ref, where { ref $_ eq "FORMAT" };
				subtype "CodeRef", as &Ref, where { ref $_ eq "CODE" };
					subtype "NamedCode[subname]", as &CodeRef, where { Sub::Util::subname($_) ~~ A };
					subtype "ProtoCode[prototype]", as &CodeRef, where { Sub::Util::prototype($_) ~~ A };
					subtype "ForwardRef", as &CodeRef, where { !subref_is_reachable($_) };
					subtype "ImplementRef", as &CodeRef, where { subref_is_reachable($_) };
					subtype "Isa[type...]", as &CodeRef,
						init_where {
						    my $pkg = caller(2);
							SELF->{args} = [ map { External([UNIVERSAL::isa($_, 'Aion::Type')? $_: $pkg->can($_)? $pkg->can($_)->(): $_]) } ARGS ];
						}
						where {
							my $subroutine = $Aion::Isa{pack "J", refaddr $_} or return "";
							my $signature = $subroutine->{signature};
							my $args = ARGS;
							return "" if @$signature != @$args;
							my $i = 0;
							for my $type (@$args) {
								return "" unless $signature->[$i++] eq $type;
							}

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

	subtype "PositiveInt", as &Int & Range([0, 'Inf']);
	subtype "Nat", as &Int & Range([1, 'Inf']);

	my $_none = ~&Any;
	sub None() { $_none }
};

$_->keyfn(\&Aion::Type::typed_sorted_args_key) for Union[], Intersection[];
(Enum[])->keyfn(\&Aion::Type::sorted_args_key);

%Aion::Type::range_lbound = map { (Scalar::Util::refaddr $_->{coerce} => $_->{name} eq 'Range'? '-Inf': 0) } Range[], Lim[], LimKeys[], Len[];

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Types - a library of standard validators and it is used to create new validators

t/aion.t  view on Meta::CPAN 

#@< EOF
# 
# Файл lib/Role/Values/Stringify.pm:
#@> lib/Role/Values/Stringify.pm
#>> package Role::Values::Stringify;
#>> 
#>> use Aion -role;
#>> 
#>> sub valsify {
#>> 	my ($self) = @_;
#>> 	join ", ", map $self->{$_}, sort keys %$self;
#>> }
#>> 
#>> 1;
#@< EOF
# 
# Файл lib/Class/All/Stringify.pm:
#@> lib/Class/All/Stringify.pm
#>> package Class::All::Stringify;
#>> 
#>> use Aion;

t/aion/meta/requires-feature.pm  view on Meta::CPAN 

use common::sense; use open qw/:std :utf8/;  use Carp qw//; use File::Basename qw//; use File::Find qw//; use File::Slurper qw//; use File::Spec qw//; use File::Path qw//; use Scalar::Util qw//;  use Test::More 0.98;  BEGIN {     $SIG{__DIE__} = sub ...
# 
# use common::sense;
# 
# use Aion::Meta::Util qw//;
# use List::Util qw/pairmap/;
# use Scalar::Util qw/looks_like_number reftype blessed refaddr/;
# 
# Aion::Meta::Util::create_getters(qw/pkg name opt has/);
# 
# #  Конструктор
# sub new {
# 	my ($cls, $pkg, $name, @has) = @_;
# 	bless {pkg => $pkg, name => $name, opt => {@has}, has => \@has}, ref $cls || $cls;
# }
# 
# # Строковое представление фичи
# sub stringify {
# 	my ($self) = @_;
# 	my $has = join ', ', pairmap { "$a => ${\
# 		Aion::Meta::Util::val_to_str($b)
# 	}" } @{$self->{has}};
# 	return "req $self->{name} => ($has) of $self->{pkg}";
# }
# 
# # Сравнивает с фичей, но только значения которые есть в этой
# sub compare {
# 	my ($self, $feature) = @_;
# 
# 	die "Requires $self" unless UNIVERSAL::isa($feature, 'Aion::Meta::Feature');



( run in 0.834 second using v1.01-cache-2.11-cpan-524268b4103 )