File Coverage

blib/lib/Types/CLike.pm

Criterion	Covered	Total	%
statement	27	35	77.1
branch	0	4	0.0
condition			n/a
subroutine	11	12	91.6
pod			n/a
total	38	51	74.5

package Types::CLike;

use v5.8.8;
use strict;
use warnings;

our $VERSION = '0.91'; # VERSION
# ABSTRACT: C-like data types for Moo(se)

our @EXPORT_OK = ();

use Type::Library -base;
use Types::Numbers;

my $meta = __PACKAGE__->meta;

# All of these types are just aliases of parameterized parents
sub __alias_subtype {
   $meta->add_type(
      name       => $_[0],
      parent     => $_[1],
      library    => __PACKAGE__,
   );
};

sub __integer_builder {
   my ($bits, $signed_names, $unsigned_names) = @_;

   __alias_subtype($_,   Types::Numbers::SignedInt[$bits]) for   @$signed_names;
   __alias_subtype($_, Types::Numbers::UnsignedInt[$bits]) for @$unsigned_names;
};

sub __money_builder {
   my ($bits, $scale, $names) = @_;
   __alias_subtype($_, Types::Numbers::FixedBinary[$bits, $scale]) for @$names;
};

sub __float_builder {
   my ($bits, $ebits, $names) = @_;
   __alias_subtype($_, Types::Numbers::FloatBinary[$bits, $ebits]) for @$names;
};

sub __decimal_builder {
   my ($digits, $emax, $names) = @_;
   __alias_subtype($_, Types::Numbers::FloatDecimal[$digits, $emax]) for @$names;
};

sub __char_builder {
   my ($bits, $names) = @_;
   __alias_subtype($_, Types::Numbers::Char[$bits]) for @$names;
}

### Integer definitions ###
                          # being careful with char here...
__integer_builder(  4, [qw(SNibble SSemiOctet Int4 Signed4)],            [qw(Nibble SemiOctet UInt4 Unsigned4)]),
__integer_builder(  8, [qw(SByte SOctet TinyInt Int8 Signed8)],          [qw(Byte Octet UnsignedTinyInt UInt8 Unsigned8)]),
__integer_builder( 16, [qw(Short SmallInt Int16 Signed16)],              [qw(UShort UnsignedSmallInt UInt16 Unsigned16)]),
__integer_builder( 24, [qw(MediumInt Int24 Signed24)],                   [qw(UnsignedMediumInt UInt24 Unsigned24)]),
__integer_builder( 32, [qw(Int Int32 Signed32)],                         [qw(UInt UnsignedInt UInt32 Unsigned32)]),
__integer_builder( 64, [qw(Long LongLong BigInt Int64 Signed64)],        [qw(ULong ULongLong UnsignedBigInt UInt64 Unsigned64)]),
__integer_builder(128, [qw(SOctaWord SDoubleQuadWord Int128 Signed128)], [qw(OctaWord DoubleQuadWord UInt128 Unsigned128)]),

### "Money" definitions ###
__money_builder( 32, 4, [qw(SmallMoney)]),
__money_builder( 64, 4, [qw(Money Currency)]),
__money_builder(128, 6, [qw(BigMoney)]),

### Float definitions ###
__float_builder( 16,  4, [qw(ShortFloat)]),
__float_builder( 16,  5, [qw(Half Float16 Binary16)]),
__float_builder( 32,  8, [qw(Single Real Float Float32 Binary32)]),
__float_builder( 40,  8, [qw(ExtendedSingle Float40)]),
__float_builder( 64, 11, [qw(Double Float64 Binary64)]),
__float_builder( 80, 15, [qw(ExtendedDouble Float80)]),
__float_builder(104,  8, [qw(Decimal)]),
__float_builder(128, 15, [qw(Quadruple Quad Float128 Binary128)]),

### Decimal definitions ###
__decimal_builder( 7,   96, [ 'Decimal32']),
__decimal_builder(16,  384, [ 'Decimal64']),
__decimal_builder(34, 6144, ['Decimal128']),

### Char definitions ###
__char_builder( 8, [qw(Char Char8)]),
__char_builder(16, [qw(Char16)]),
__char_builder(32, [qw(Char32)]),
__char_builder(48, [qw(Char48)]),
__char_builder(64, [qw(Char64)]),

my %base_tags = (
   'c'       => [qw(Char Byte Short UShort Int UInt Long ULong Float Double ExtendedDouble)],
   'stdint'  => [ map { ('Int'.$_, 'UInt'.$_) } (4,8,16,32,64,128) ],
   'c#'      => [qw(SByte Byte Char16 Short UShort Int UInt Long ULong Float Double Decimal)],
   'ieee754' => ['Binary16', map { ('Binary'.$_, 'Decimal'.$_) } (32,64,128) ],
   'tsql'    => [qw(TinyInt SmallInt Int BigInt SmallMoney Money Float64 Real)],
   'mysql'   => [ (map { ($_, 'Unsigned'.$_) } qw(TinyInt SmallInt MediumInt Int BigInt)), qw(Float Double)],
   'ansisql' => [qw(SmallInt Int Float Real Double)],
);

sub _exporter_expand_tag {
   my $class = shift;
   my ($name, $value, $globals) = @_;

   my $p = '';
   my $base_name = $name;
   $base_name =~ s/^((?:is|assert|to)_|\+)// and $p = $1;

   $base_tags{$base_name} and return map [ "$p$_" => $value ], @{ $base_tags{$base_name} };

   return $class->SUPER::_exporter_expand_tag(@_);
}

42;

__END__