view release on metacpan or  search on metacpan

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 {
	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,
	);
	
	if(!subref_is_reachable($referent)) {
		$Aion::META{$pkg}{require}{$subname} = $subroutine;
	} else {
		my $require = delete $Aion::META{$pkg}{require}{$subname};
		$require->compare($subroutine) if $require;

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

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

# Создание типа
sub subtype(@) {
	my $subtype = shift;
	my %o = @_;

	my ($as, $init_where, $where, $awhere, $message) = delete @o{qw/as init_where where awhere message/};

	$as = External([$as]) if defined $as;
	
	die "subtype $subtype unused keys left: " . join ", ", keys %o if keys %o;

	die "subtype format is Name or Name[args] or Name`[args]" if $subtype !~ /^([A-Z_]\w*)(?:(\`)?\[(.*)\])?$/i;
	my ($name, $is_maybe_arg, $is_arg) = ($1, $2, $3);

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

	" <html1>" ~~ Html         # -> ""

=head2 StrDate

Date in C<yyyy-mm-dd> format.

	"2001-01-12" ~~ StrDate # -> 1
	"01-01-01" ~~ StrDate   # -> ""

=head2 StrDateTime

Date and time in the format C<yyyy-mm-dd HH:MM:SS>.

	"2012-12-01 00:00:00" ~~ StrDateTime  # -> 1
	"2012-12-01 00:00:00 " ~~ StrDateTime # -> ""

=head2 StrMatch[regexp]

Matches a string against a regular expression.

	' abc ' ~~ StrMatch[qr/abc/]  # -> 1
	' abbc ' ~~ StrMatch[qr/abc/] # -> ""

=head2 ClassName

The class name is a package with a C<new> method.

	'Aion::Type' ~~ ClassName  # -> 1
	'Aion::Types' ~~ ClassName # -> ""

=head2 RoleName

The role name is a package without the C<new> method, with C<@ISA>, or with any one method.

	package ExRole1 {
		sub any_method {}
	}
	
	package ExRole2 {
		our @ISA = qw/ExRole1/;
	}
	
	
	'ExRole1' ~~ RoleName    # -> 1
	'ExRole2' ~~ RoleName    # -> 1
	'Aion::Type' ~~ RoleName # -> ""
	'Nouname::Empty::Package' ~~ RoleName # -> ""

=head2 StrRat

String representation of rational numbers.

Since in perl rational numbers are supported using the C<bigrat> pragma, which turns all rational numbers into C<Math::BigRat>, it is used in a ghost to C<Rat>.

	"6/7" ~~ StrRat  # -> 1
	"-6/7" ~~ StrRat # -> 1
	"+6/7" ~~ StrRat # -> 1
	6 ~~ StrRat      # -> 1
	"inf" ~~ StrRat  # -> 1
	"+Inf" ~~ StrRat # -> 1
	"NaN" ~~ StrRat  # -> 1
	"-nan" ~~ StrRat # -> 1
	6.5 ~~ StrRat    # -> 1
	"6.5 " ~~ StrRat # -> ''

=head2 Rat

Rational numbers. Short for C<Object['Math::BigRat']>. Has a ghost.

	use Math::BigRat;
	use Math::BigFloat;
	use Math::BigInt;
	
	"6/7" ~~ Rat # -> ""
	Math::BigRat->new("6/7") ~~ Rat # -> 1

=head2 Num

Numbers.

	-6.5 ~~ Num   # -> 1
	6.5e-7 ~~ Num # -> 1
	"6.5 " ~~ Num # -> ""

=head2 PositiveNum

Positive numbers.

	0 ~~ PositiveNum    # -> 1
	0.1 ~~ PositiveNum  # -> 1
	-0.1 ~~ PositiveNum # -> ""
	-0 ~~ PositiveNum   # -> 1

=head2 Float

A machine floating point number is 4 bytes.

	-4.8 ~~ Float             # -> 1
	-3.402823466E+38 ~~ Float # -> 1
	+3.402823466E+38 ~~ Float # -> 1
	-3.402823467E+38 ~~ Float # -> ""

=head2 Double

A machine floating point number is 8 bytes.

	use Scalar::Util qw//;
	
	                      -4.8 ~~ Double # -> 1
	'-1.7976931348623157e+308' ~~ Double # -> 1
	'+1.7976931348623157e+308' ~~ Double # -> 1
	'-1.7976931348623159e+308' ~~ Double # -> ""

=head2 Range[from, to]

Numbers between C<from> and C<to>.

	1 ~~ Range[1, 3]   # -> 1
	2.5 ~~ Range[1, 3] # -> 1
	3 ~~ Range[1, 3]   # -> 1
	3.1 ~~ Range[1, 3] # -> ""