#!/usr/bin/env perl
use warnings;
use strict;
use Type::Tiny::XS (); # for speed
use Ref::Util::XS (); # for speed
use Type::Tiny;
BEGIN {
package MyPgTypes {
use Type::Library -base;
use Types::Standard qw/ Optional LaxNum /;
use Types::Common::Numeric qw/ PositiveInt PositiveOrZeroInt /;
use Type::Params qw/ compile /;
# ###
https://www.postgresql.org/docs/12/datatype-numeric.html#DATATYPE-NUMERIC-DECIMAL
# The precision of a numeric is the total count of significant digits in the whole number,
# that is, the number of digits to both sides of the decimal point. The scale of a numeric
# is the count of decimal digits in the fractional part, to the right of the decimal point.
# So the number 23.5141 has a precision of 6 and a scale of 4. Integers can be considered
# to have a scale of zero.
# NUMERIC(precision, scale) - The precision must be positive, the scale zero or positive.
# NUMERIC(precision) - selects a scale of 0.
# NUMERIC - creates a column in which numeric values of any precision and scale can be stored,
# up to the implementation limit on precision.
# The maximum allowed precision when explicitly specified in the type declaration is 1000.
# If the scale of a value to be stored is greater than the declared scale of the column,
# the system will round the value to the specified number of fractional digits. Then, if
# the number of digits to the left of the decimal point exceeds the declared precision
# minus the declared scale, an error is raised.
# ###
my $checker = compile( PositiveInt, Optional[PositiveOrZeroInt] );
my $num = __PACKAGE__->add_type(
name => 'PgNumeric',
parent => LaxNum,
# Must use a coderef as the constraint for now because
https://rt.cpan.org/Ticket/Display.html?id=131238
constraint => sub { /\A(?:-?\d+(?:\.\d+)?|(?i)NaN)\z/ },
inlined => sub {
my ($self, $varname) = @_;
return ( undef, sprintf(q{ %s =~ /\A(?:-?\d+(?:\.\d+)?|(?i)NaN)\z/ }, $varname) );
},
constraint_generator => sub {
my ($precision, $scale) = $checker->(@_);
die "precision too large, max is 1000" if $precision > 1000;
die "precision must be greater than scale" unless $precision > $scale;
my $int = $precision - $scale;
my $re = $scale ? qr/\A(?:-?\d{1,$int}(?:\.\d{1,$scale})?|(?i)NaN)\z/ : qr/\A(?:-?\d{1,$int}|(?i)NaN)\z/;
return sub { $_ =~ $re };
},
inline_generator => sub {
my ($precision, $scale) = $checker->(@_);
die "precision too large, max is 1000" if $precision > 1000;
die "precision must be greater than scale" unless $precision > $scale;
my $int = $precision - $scale;
my $re = $scale ? qq{/\\A(?:-?\\d{1,$int}(?:\.\\d{1,$scale})?|(?i)NaN)\\z/} : qq{/\\A(?:-?\\d{1,$int}|(?i)NaN)\\z/};
return sub {
my ($self, $varname) = @_;
return ( undef, "$varname =~ $re" );
};
},
);
__PACKAGE__->make_immutable;
}
MyPgTypes->import(':all');
}
use Test::More;
use Test::TypeTiny;
should_pass($_, PgNumeric) for "1","1.1","12345.67890","-1","-1.1","-12345.67890","NaN","nan";
should_fail($_, PgNumeric) for ".1","1.","","x","1.x","-.1","-1.","-","-x","-1.x";
should_pass($_, PgNumeric[10,5]) for "1","1.1","12345.67890","-1","-1.1","-12345.67890","NaN","nan";
should_fail($_, PgNumeric[10,5]) for ".1","1.","","x","1.x","-.1","-1.","-","-x","-1.x",
"123456.67890","12345.678901","-123456.67890","-12345.678901";
my $t = PgNumeric[10,5];
is $t->display_name, 'PgNumeric[10,5]', 'display_name is as expected';
done_testing;
