Aion

 view release on metacpan or  search on metacpan

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;
}

# Строковое представление фичи

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

		if (overload::Method($value, '==')) {
			return "" unless $value == $other_value;
		}
		elsif (overload::Method($value, 'eq')) {
			return "" unless $value eq $other_value;
		}
		else {
			return "" unless refaddr $value == refaddr $other_value;
		}
	}
	elsif (looks_like_number($value)) {
		return "" unless looks_like_number($other_value) && $value == $other_value;
	}
	elsif (reftype $value eq 'ARRAY') {
		for(my $i = 0; $i <= $#$value; $i++) {
			return "" unless _deep_equal($value->[$i], $other_value->[$i]);
		}
	}
	elsif (reftype $value eq 'HASH') {
		for my $k (keys %$value) {
			return "" unless exists $other_value->{$k} && _deep_equal($value->{$k}, $other_value->{$k});
		}

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

			$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);

		if(ref $v eq 'Regexp') {
			$v = "$v";
			$v =~ s{^\(\?\^?([a-z]*):(.*)\)$}{qr/$2/$1}si;
		}
		else {
			$v = overload::Overloaded($v) && !overload::Method($v, '""')
				? join("#", Scalar::Util::reftype($v), Scalar::Util::refaddr($v))
				: "$v";
		}

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

package Aion::Type;
# Базовый класс для типов и преобразователей
use common::sense;

use Aion::Meta::Util qw//;
use Scalar::Util qw/looks_like_number/;

use overload
	"fallback" => 1,
	"&{}" => sub {
		my ($self) = @_;
		sub { $self->test }
	},	# Чтобы тип мог быть выполнен, как функция
	'""' => "stringify",									# Отображать тип в трейсбеке в строковом представлении
	"|" => sub {
		my ($type1, $type2) = @_;

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

package Aion::Types;
# Типы-валидаторы для Aion

use common::sense;

use Aion::Meta::Util qw/subref_is_reachable/;
use Aion::Type;
use List::Util qw/all any first/;
use Exporter qw/import/;
require overload;
use Scalar::Util qw/looks_like_number reftype refaddr blessed/;
use Sub::Util qw//;

our @EXPORT = our @EXPORT_OK = grep {
	*{$Aion::Types::{$_}}{CODE}	&& !/^(_|(NaN|import|all|any|first|looks_like_number|reftype|refaddr|blessed|subref_is_reachable)\z)/n
} keys %Aion::Types::;

# Обрабатываем атрибут :Isa
sub MODIFY_CODE_ATTRIBUTES {
    my ($pkg, $referent, @attributes) = @_;

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

sub _Isa {

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

					subtype "Tel", as &Str, where { /^\+\d{7,}\z/ };
					subtype "Url", as &Str, where { /^https?:\/\// };
					subtype "Path", as &Str, where { /^\// };
					subtype "Html", as &Str, where { /^\s*<(!doctype\s+html|html)\b/i };
					subtype "StrDate", as &Str, where { /^\d{4}-\d{2}-\d{2}\z/ };
					subtype "StrDateTime", as &Str, where { /^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}\z/ };
					subtype "StrMatch[regexp]", as &Str, where { $_ =~ A };
					subtype "ClassName", as &Str, where { !!$_->can('new') };
					subtype "RoleName", as &Str, where { !$_->can('new') && !!(@{"$_\::ISA"} || first { *{$_}{CODE} } values %{"$_\::"}) };
					subtype "StrRat", as &Str, where { m!\s*/\s*!? &Num->include($`) && &Num->include($`): &Num->test };
					subtype "Num", as &Str, where { looks_like_number($_) && /[\dfn]\z/i };
						subtype "PositiveNum", as &Num, where { $_ >= 0 };
						subtype "Int", as &Num,	where { /^[-+]?\d+\z/ };
							subtype "PositiveInt", as &Int, where { $_ >= 0 };
							subtype "Nat", as &Int, where { $_ > 0 };


			subtype "Ref", as &Defined, where { "" ne ref $_ };
				subtype "Tied`[class]", as &Ref,
					where { my $ref = reftype($_); !!(
						$ref eq "HASH"? tied %$_:

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

			subtype "Overload`[m...]", as &Like,
				where { !!overload::Overloaded($_) }
				awhere { my $x = $_; all { overload::Method($x, $_) } ARGS };
			subtype "InstanceOf[class...]", as &Like, where { my $x = $_; all { $x->isa($_) } ARGS };
			subtype "ConsumerOf[role...]", as &Like, where { my $x = $_; all { $x->DOES($_) } ARGS };
			subtype "StrLike", as &Like, where { !blessed($_) or !!overload::Method($_, '""') };
				subtype "Len[from, to?]", as &StrLike,
					init_where => $init_limit,
					where { SELF->{min} <= length($_) && length($_) <= SELF->{max} };

			subtype "NumLike", as &Like, where { looks_like_number($_) };
				subtype "Float", as &NumLike, where { -3.402823466E+38 <= $_ && $_ <= 3.402823466E+38 };

				my $_from; my $_to;
				subtype "Double", as &NumLike, where {
					$_from //= do { require Math::BigFloat; Math::BigFloat->new('-1.7976931348623157e+308') };
					$_to   //= do { require Math::BigFloat; Math::BigFloat->new( '1.7976931348623157e+308') };
					$_from <= $_ && $_ <= $_to;
				};
				subtype "Range[from, to]", as &NumLike, where { A <= $_ && $_ <= B };

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;
# }
# 
# # Строковое представление фичи

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

# 		if (overload::Method($value, '==')) {
# 			return "" unless $value == $other_value;
# 		}
# 		elsif (overload::Method($value, 'eq')) {
# 			return "" unless $value eq $other_value;
# 		}
# 		else {
# 			return "" if refaddr $value != refaddr $other_value;
# 		}
# 	}
# 	elsif (looks_like_number($value)) {
# 		return "" unless looks_like_number($other_value) && $value == $other_value;
# 	}
# 	elsif (reftype $value eq 'ARRAY') {
# 		for(my $i = 0; $i <= $#$value; $i++) {
# 			return "" unless _deep_equal($value->[$i], $other_value->[$i]);
# 		}
# 	}
# 	elsif (reftype $value eq 'HASH') {
# 		for my $k (keys %$value) {
# 			return "" unless exists $other_value->{$k} && _deep_equal($value->{$k}, $other_value->{$k});
# 		}



( run in 1.065 second using v1.01-cache-2.11-cpan-39bf76dae61 )