File Coverage

blib/lib/Types/SQL/Util.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	24	26	92.3
condition	6	8	75.0
subroutine	6	6	100.0
pod	1	1	100.0
total	77	81	95.0

package Types::SQL::Util;

use strict;
use warnings;

use Exporter 5.57 qw/ import /;

use PerlX::Maybe qw/ maybe /;
use Safe::Isa 1.000008 qw/ $_isa $_call_if_can /;

our $VERSION = 'v0.6.1';

# RECOMMEND PREREQ: PerlX::Maybe::XS

# ABSTRACT: extract DBIx::Class column_info from types


our @EXPORT    = qw/ column_info_from_type /;
our @EXPORT_OK = @EXPORT;

my %CLASS_TYPES = (
    'Data::UUID'                 => 'uuid',
    'Data::GUID'                 => 'uuid',
    'Date'                       => 'timestamp',
    'DateTime'                   => 'timestamp',
    'DateTime::Tiny'             => 'timestamp',
    'JSON::PP::Boolean'          => 'boolean',
    'Time::Moment'               => 'timestamp',
    'Time::Piece'                => 'timestamp',
    'Types::Serialiser::Boolean' => 'boolean',
);


my %FROM_PARENT = (

    'Types::Standard' => {

        'ArrayRef' => sub {
            my %type = column_info_from_type( $_[0]->type_parameter );
            $type{data_type} .= '[]';
            return %type;
        },

        'Maybe' => sub {
            return (
                is_nullable => 1,
                column_info_from_type( $_[0]->type_parameter )
            );
        },

        'Object' => sub {
            my $class = $_[0]->$_call_if_can('class') or return;
            if ( my $data_type = $CLASS_TYPES{$class} ) {
                return ( data_type => $data_type );
            }
            return;
        },

      }

);

my %FROM_TYPE = (

    'Types::Standard' => {

        'Bool' => sub {
            return ( data_type => 'boolean' );
        },

        'Int' => sub {
            return ( data_type => 'integer', is_numeric => 1 );
        },

        'Num' => sub {
            return ( data_type => 'numeric', is_numeric => 1 );
        },


        'Str' => sub {
            return ( data_type => 'text', is_numeric => 0 );
        },

    },

    'Types::Common::Numeric' => {

        'PositiveInt' => sub {
            return (
                data_type  => 'integer',
                is_numeric => 1,
                extra      => { unsigned => 1 }
                );
        },

        'PositiveOrZeroInt' => sub {
            return (
                data_type  => 'integer',
                is_numeric => 1,
                extra      => { unsigned => 1 }
                );
        },

        'PositiveNum' => sub {
            return (
                data_type  => 'numeric',
                is_numeric => 1,
                extra      => { unsigned => 1 }
                );
        },

        'PositiveOrZeroNum' => sub {
            return (
                data_type  => 'numeric',
                is_numeric => 1,
                extra      => { unsigned => 1 }
                );
        },

        'SingleDigit' => sub {
            return (
                data_type  => 'integer',
                is_numeric => 1,
                size       => 1,
                extra      => { unsigned => 1 }
            );
        },

      },

    'Types::Common::String' => {

        'LowerCaseStr' => sub {
            return ( data_type => 'text', is_numeric => 0 );
        },

        'UpperCaseStr' => sub {
            return ( data_type => 'text', is_numeric => 0 );
        },

        'NonEmptyStr' => sub {
            return ( data_type => 'text', is_numeric => 0 );
        },

        'LowerCaseSimpleStr' => sub {
            return ( data_type => 'text', is_numeric => 0, size => 255 );
        },

        'UpperCaseSimpleStr' => sub {
            return ( data_type => 'text', is_numeric => 0, size => 255 );
        },

        'NonEmptySimpleStr' => sub {
            return ( data_type => 'text', is_numeric => 0, size => 255 );
        },

        'SimpleStr' => sub {
            return ( data_type => 'text', is_numeric => 0, size => 255 );
        },

    },

    'Types::DateTime' => {

        'DateTime' => sub {
            return ( data_type => 'timestamp' );
        },

        'DateTimeWithZone' => sub {
            return ( data_type => 'timestamp with time zone' );
        },

        'DateTimeUTC' => sub {
            return ( data_type => 'timestamp with time zone' );
        },

        'Now' => sub {
            return ( data_type => 'timestamp', default_value => \ "CURRENT_TIMESTAMP"  );
        },
    },

    'Types::UUID' => {

        'Uuid' => sub {
            return ( data_type => 'uuid' ),
        },

    },

);


sub column_info_from_type {
    my ($type) = @_;

    return { } unless $type->$_isa('Type::Tiny');

    my $name    = $type->name;
    my $methods = $type->my_methods;
    my $parent  = $type->has_parent ? $type->parent : undef;

    if ( $type->is_anon && $parent ) {
        $name    = $parent->name;
        $methods = $parent->my_methods;
    }

    if ( $methods && $methods->{dbic_column_info} ) {
        return $methods->{dbic_column_info}->($type);
    }

    my $from = ( $type->library ? $FROM_TYPE{ $type->library } : undef ) // { };

    if ( my $code = $from->{$name} ) {
        if ( my %info = $code->($type) ) {
            return %info;
        }
    }

    if ( $type->isa('Type::Tiny::Enum') ) {
        return (
            data_type  => 'enum',
            is_enum    => 1,
            is_numeric => 0,
            extra      => {
                list => $type->values,
            },
        );
    }

    if ( my $parent_lib = $parent->$_call_if_can('library') ) {
        if ( my $code = $FROM_PARENT{$parent_lib}{$name} ) {
            if ( my %info = $code->($type) ) {
                return %info;
            }
        }
    }

    if ( $parent ) {
        my @info = eval { column_info_from_type( $parent ) };
        return @info if @info;
    }

    die "Unsupported type: " . $type->display_name;
}


1;

__END__