—

              
package Types::SQL::Util;
use v5.14;
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.7.0';
# 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__
HideShow 192 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
Types::SQL::Util - extract DBIx::Class column_info from types
=head1 VERSION
version v0.7.0
=head1 SYNOPSIS
  use Types::SQL -types;
  use Types::Standard -types;
  use Types::SQL::Util;
  my $type = Maybe[ Varchar[64] ];
  my %info = column_info_from_type( $type );
=head1 DESCRIPTION
This module provides a utility function that translates types into
column information.
=head1 EXPORTS
=head2 C<column_info_from_type>
  my %info = column_info_from_type( $type );
This function returns a hash of column information for the
C<add_column> method of L<DBIx::Class::ResultSource>, based on the
type.
Besides the types from L<Types::SQL>, it also supports the following
types.
Unless noted, these come from L<Types::Standard>,
L<Types::Common::String> or L<Types::Common::Numeric>.
=head3 C<ArrayRef>
This treats the type as an array.
=head3 C<Bool>
This is treated as a C<boolean> type.
=head3 C<DateTime>
From L<Types::DateTime>. This is a C<timestamp>.
=head3 C<DateTimeUTC>
=head3 C<DateTimeWithZone>
From L<Types::DateTime>. These are C<timestamp with time zone>.
=head3 C<Enum>
This is treated as an C<enum> type, which can be used with
L<DBIx::Class::InflateColumn::Object::Enum>.
=head3 C<InstanceOf>
For L<Date>, L<DateTime>, L<DateTime::Tiny>, L<Time::Moment> and
L<Time::Piece> objects, this is treated as a C<timestamp>.
If you want a timestamp with a time zone, use L<Types::DateTime>
C<DateTimeWithZone> or C<DateTimeUTC> type.
L<Data::UUID> or L<Data::GUID> will be treated as C<uuid>.
=head3 C<Int>
This is treated as an C<integer> without a precision.
=head3 C<Maybe>
This treats the type in the parameter as nullable.
=head3 C<Num>
This is treated as a C<numeric> without a precision.
=head3 C<PositiveOrZeroInt>
This is treated as an C<unsigned integer> without a precision.
=head3 C<PositiveOrZeroNum>
This is treated as an C<unsigned numeric> without a precision.
=head3 C<SingleDigit>
This is treated as an C<unsigned integer> of size 1.
=head3 C<Str>
This is treated as a C<text> value without a size.
=head3 C<NonEmptyStr>
=head3 C<LowerCaseStr>
=head3 C<UpperCaseStr>
These are treated the same as L</Str>.  In the future, if
L<DBIx::Class> supports database-related constraints, this will be
added to the metadata.
=head3 C<SimpleStr>
This is treated as a C<text> value with a size of 255.
=head3 C<NonEmptySimpleStr>
=head3 C<LowerCaseSimpleStr>
=head3 C<UpperCaseSimpleStr>
These are treated the same as L</SimpleStr>. In the future, if
L<DBIx::Class> supports database-related constraints, this will be
added to the metadata.
=head3 C<Now>
From L<Types::DateTime>. This is a C<timestamp> with a default set to
the SQL C<current_timestamp> function.
=head3 C<Uuid>
From L<Types::UUID>. This is a C<uuid>.
=head1 CUSTOM TYPES
You can declare custom types from these types and still extract column
information from them:
  use Type::Library
    -base,
    -declare => qw/ CustomStr /;
  use Type::Utils qw/ -all /;
  use Types::SQL -types;
  use Types::SQL::Util;
  declare CustomStr, as Varchar [64];
  ...
  my $type = CustomStr;
  my %info = column_info_from_type($type);
=head1 SEE ALSO
L<Types::SQL>.
L<Types::Standard>
=head1 SOURCE
The development version is on github at L<https://github.com/robrwo/Types-SQL>
and may be cloned from L<git://github.com/robrwo/Types-SQL.git>
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website
L<https://github.com/robrwo/Types-SQL/issues>
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=head1 AUTHOR
Robert Rothenberg <rrwo@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2016-2023 by Robert Rothenberg.
This is free software, licensed under:
  The Artistic License 2.0 (GPL Compatible)
=cut