##----------------------------------------------------------------------------
## Database Object Interface - ~/lib/DB/Object/Fields/Field.pm
## Version v1.3.0
## Copyright(c) 2025 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2020/01/01
## Modified 2026/03/22
## All rights reserved
## 
## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package DB::Object::Fields::Field;
BEGIN
{
    use strict;
    use warnings;
    use common::sense;
    use parent qw( Module::Generic );
    use vars qw( $VERSION $FIELD_NAMES $EXCEPTION_CLASS );
    use DB::Object::Fields::Overloaded;
    use Module::Generic::Array;
    use overload (
        '""'    => 'as_string',
        'bool'  => sub{1},
        '+'     => sub{ &_op_overload( @_, '+' ) },
        '-'     => sub{ &_op_overload( @_, '-' ) },
        '*'     => sub{ &_op_overload( @_, '*' ) },
        '/'     => sub{ &_op_overload( @_, '/' ) },
        '%'     => sub{ &_op_overload( @_, '%' ) },
        '<'     => sub{ &_op_overload( @_, '<' ) },
        '>'     => sub{ &_op_overload( @_, '>' ) },
        '<='    => sub{ &_op_overload( @_, '<=' ) },
        '>='    => sub{ &_op_overload( @_, '>=' ) },
        # In most SQL driver, '<>' is more portable tan '!='
        '!='    => sub{ &_op_overload( @_, '<>' ) },
        '<<'    => sub{ &_op_overload( @_, '<<' ) },
        '>>'    => sub{ &_op_overload( @_, '>>' ) },
        'lt'    => sub{ &_op_overload( @_, '<' ) },
        'gt'    => sub{ &_op_overload( @_, '>' ) },
        'le'    => sub{ &_op_overload( @_, '<=' ) },
        'ge'    => sub{ &_op_overload( @_, '>=' ) },
        'ne'    => sub{ &_op_overload( @_, '<>' ) },
        '&'     => sub{ &_op_overload( @_, '&' ) },
        '^'     => sub{ &_op_overload( @_, '^' ) },
        '|'     => sub{ &_op_overload( @_, '|' ) },
        '=='    => sub{ &_op_overload( @_, '=' ) },
        'eq'    => sub{ &_op_overload( @_, 'IS' ) },
        # Full Text Search operator
        '~~'    => sub{ &_op_overload( @_, '@@' ) },
        fallback => 1,
    );
    use Wanted;
    our $VERSION = 'v1.3.0';
    our $FIELD_NAMES = [qw(
        check_name comment datatype default foreign_name index_name is_array is_check
        is_foreign is_nullable is_primary is_unique name pos prefixed size type
    )];
    our $EXCEPTION_CLASS = $DB::Object::EXCEPTION_CLASS;
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    $self->{check_name}     = undef;
    $self->{comment}        = undef;
    $self->{datatype}       = undef;
    $self->{default}        = undef;
    $self->{foreign_name}   = undef;
    $self->{index_name}     = undef;
    $self->{is_array}       = undef;
    $self->{is_check}       = undef;
    $self->{is_foreign}     = undef;
    $self->{is_nullable}    = undef;
    $self->{is_primary}     = undef;
    $self->{is_unique}      = undef;
    $self->{name}           = undef;
    $self->{pos}            = undef;
    $self->{prefixed}       = 0;
    $self->{query_object}   = undef;
    $self->{size}           = undef;
    $self->{table_object}   = undef;
    $self->{type}           = undef;
    $self->{_init_params_order}   = [qw( table_object query_object default pos type prefixed name )];
    $self->{_init_strict_use_sub} = 1;
    $self->{_exception_class}     = $EXCEPTION_CLASS;
    $self->SUPER::init( @_ ) || return( $self->pass_error );
    $self->{_fields} = $FIELD_NAMES;
#     return( $self->error( "No table object was provided." ) ) if( !$self->{table_object} );
#     return( $self->error( "Table object provided is not an object." ) ) if( !$self->_is_object( $self->{table_object} ) );
#     return( $self->error( "Table object provided is not a DB::Object::Tables object." ) ) if( !$self->{table_object}->isa( 'DB::Object::Tables' ) );
#     return( $self->error( "No name was provided for this field." ) ) if( !$self->{name} );
    $self->{trace} = $self->_get_stack_trace;
    return( $self );
}

sub as_string { return( shift->name ); }

# We attach this field to its table object
sub attach
{
    my $self = shift( @_ );
    my $tbl  = shift( @_ ) ||
        return( $self->error( "No DB::Object::Tables object was provided." ) );
    my $base_class = $self->base_class( $tbl );
    unless( $self->_is_a( $tbl => "${base_class}::Tables" ) )
    {
        return( $self->error( "Value provided is not a ${base_class}::Tables object." ) );
    }
    $self->table_object( $tbl ) || return( $self->pass_error );
    $self->debug( $tbl->debug );
    return( $self );
}

sub base_class
{
    my $self  = shift( @_ );
    my $this  = @_ ? shift( @_ ) : $self;
    my $class = ref( $this ) ? ref( $this ) : $this;
    no warnings 'once';
    my @supported_classes = CORE::values( %$DB::Object::DRIVER2PACK );
    push( @supported_classes, 'DB::Object' );
    my $ok_classes = CORE::join( '|', CORE::map{ CORE::quotemeta( $_ ) } @supported_classes );
    my $base_class = ( $class =~ /^($ok_classes)/ )[0];
    return( $base_class );
}

sub clone
{
    my $self = shift( @_ );
    # Fields to clone: we explicitly want to avoid cloning query_object, because it is not necessary and because it contains an object to the database connection that we do not want to clone.
    # Likewise, the query object, we do not want to clone either.
    # my $keys = [qw( default is_nullable name pos prefixed size type )];
    my $keys = $self->_fields;
    $keys    = $self->new_array( $FIELD_NAMES ) if( !scalar( @$keys ) );
    my $hash = {};
    @$hash{ @$keys } = @$self{ @$keys };
    # $hash->{datatype} = {};
    # for( qw( alias constant name re type ) )
    # {
    #     $hash->{datatype}->{ $_ } = $self->datatype->$_;
    # }
    my $dt = $self->datatype;
    $hash->{datatype} = 
    {
        alias    => $dt->alias->clone,
        constant => $dt->{constant},
        name     => $dt->{name},
        re       => $dt->{re},
        type     => $dt->{type},
    };
    $self->_load_class( 'Clone' ) || return( $self->pass_error );
    my $copy = Clone::clone( $hash );
    $copy->{query_object} = $self->query_object;
    $copy->{table_object} = $self->table_object;
    $copy->{debug}        = $self->debug;
    my $new = $self->new( %$copy ) || return( $self->pass_error );
    return( $new );
}

sub check_name { return( shift->_set_get_scalar( 'check_name', @_ ) ); }

sub comment { return( shift->_set_get_scalar( 'comment', @_ ) ); }

# A data type constant
# sub constant { return( shift->_set_get_hash_as_object( 'constant', @_ ) ); }
sub constant { return( shift->datatype->constant( @_ ) ); }

sub database { return( shift->database_object->database ); }

sub database_object { return( shift->table_object->database_object ); }

sub datatype { return( shift->_set_get_class( 'datatype', {
    alias => { type => 'array_as_object' },
    constant => { type => 'scalar' },
    name => { type => 'scalar_as_object' },
    re => { type => 'object', package => 'Regexp' },
    type => { type => 'scalar_as_object' },
}, @_ ) ); }

sub default { return( shift->_set_get_scalar( 'default', @_ ) ); }

sub foreign_name { return( shift->_set_get_scalar( 'foreign_name', @_ ) ); }

sub first { return( shift->_find_siblings(1) ); }

sub index_name { return( shift->_set_get_scalar( 'index_name', @_ ) ); }

sub is_array { return( shift->_set_get_boolean( 'is_array', @_ ) ); }

sub is_check { return( shift->_set_get_boolean( 'is_check', @_ ) ); }

sub is_foreign { return( shift->_set_get_boolean( 'is_foreign', @_ ) ); }

sub is_nullable { return( shift->_set_get_boolean( 'is_nullable', @_ ) ); }

sub is_primary { return( shift->_set_get_boolean( 'is_primary', @_ ) ); }

sub is_unique { return( shift->_set_get_boolean( 'is_unique', @_ ) ); }

sub last
{
    my $self = shift( @_ );
    my $fields = $self->table_object->fields;
    my $pos = scalar( keys( %$fields ) );
    return( $self->_find_siblings( $pos ) );
}

sub name
{
    my $self = shift( @_ );
    no overloading;
    if( @_ )
    {
        my $name = shift( @_ );
        if( !defined( $name ) || !CORE::length( $name // '' ) )
        {
            return( $self->error( "You can not set the table column name to be undefined or an empty string." ) );
        }
        $self->{name} = $name;
    }
    my $name  = $self->{name};
    my $alias = $self->query_object->table_alias;
    if( $self->{prefixed} )
    {
        my @prefix = ();
        if( length( $alias ) )
        {
            CORE::push( @prefix, $alias );
        }
        else
        {
            # if the value is higher than 1, we also add the database name as a prefix
            # For example $tbl->fields->some_field->prefixed(2)->name
            push( @prefix, $self->database ) if( $self->{prefixed} > 2 );
            push( @prefix, $self->table_object->schema ) if( $self->{prefixed} > 1 && CORE::length( $self->table_object->schema ) );
            push( @prefix, $self->table );
        }
        push( @prefix, $name );
        return( join( '.', @prefix ) );
    }
    else
    {
        return( $name );
    }
}

sub next
{
    my $self = shift( @_ );
    return( $self->_find_siblings( $self->pos + 1 ) );
}

sub pos { return( shift->_set_get_scalar( 'pos', @_ ) ); }

sub prefixed
{
    my $self = shift( @_ );
    if( @_ )
    {
        $self->{prefixed} = ( $_[0] =~ /^\d+$/ ? $_[0] : ( $_[0] ? 1 : 0 ) );
    }
    else
    {
        $self->{prefixed} = 1;
    }
    return( want( 'OBJECT' ) ? $self : $self->{prefixed} );
}

sub prev
{
    my $self = shift( @_ );
    return( $self->_find_siblings( $self->pos - 1 ) );
}

# sub query_object { return( shift->_set_get_object_without_init( 'query_object', 'DB::Object::Query', @_ ) ); }
sub query_object { return( shift->table_object->query_object ); }

sub schema { return( shift->table_object->schema ); }

sub size { return( shift->_set_get_number( 'size', @_ ) ); }

sub table { return( shift->table_object->name ); }

sub table_name { return( shift->table_object->name ); }

sub table_object { return( shift->_set_get_object_without_init( 'table_object', 'DB::Object::Tables', @_ ) ); }

sub type { return( shift->_set_get_scalar( 'type', @_ ) ); }

sub _fields { return( shift->_set_get_array_as_object( '_fields', @_ ) ); }

sub _find_siblings
{
    my $self = shift( @_ );
    my $pos  = shift( @_ );
    return( $self->error( "No field position provided." ) ) if( !CORE::length( $pos ) );
    return if( $pos < 0 );
    my $fields = $self->table_object->fields;
    my $next_field;
    foreach my $f ( sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ) )
    {
        if( $fields->{ $f } == $pos )
        {
            $next_field = $f;
            CORE::last;
        }
    }
    return if( !defined( $next_field ) );
    my $o = $self->table_object->fields_object->_initiate_field_object( $next_field ) ||
    return( $self->pass_error( $self->table_object->fields_object->error ) );
    return( $o );
}

# Ref:
# <https://www.postgresql.org/docs/10/functions-comparison.html>
# <https://www.postgresql.org/docs/10/functions-math.html>
# <https://dev.mysql.com/doc/refman/5.7/en/comparison-operators.html>
# <https://sqlite.org/lang_expr.html>
sub _op_overload
{
    my( $self, $val, $swap, $op ) = @_;
    if( $self->_is_a( $val => [qw( DB::Object::IN DB::Object::LIKE )] ) )
    {
        return( $val->_opt_overload( $self, 1, $op ) );
    }

    my $field = $self->name;
    my $map =
    {
        '!=' => '<>',
        'lt' => '<',
        'gt' => '>',
        'le' => '<=',
        'ge' => '>=',
        # '=' works for all types, but IS does not work with everything.
        # For example:
        # select * from ip_table where ip_addr IS inet '192.168.2.12' OR inet '192.168.2.12' << ip_addr
        # does not work, but
        # select * from ip_table where ip_addr = inet '192.168.2.12' OR inet '192.168.2.12' << ip_addr
        # works better
        '==' => '=',
    };
    $op = $map->{ $op } if( exists( $map->{ $op } ) );
    my $dbo = $self->database_object;
    my $qo = $self->query_object;
    my $placeholder_re = $dbo->_placeholder_regexp;
    my $const = $self->datatype->constant;
    # $op = 'IS' if( $op eq '=' and $val eq 'NULL' );
    # If the value specified in the operation is a placeholder, or a field object or a statement object, we do not want to quote process it
    unless( $val =~ /^$placeholder_re$/ || 
            ( $self->_is_object( $val ) && 
              (
                $val->isa( 'DB::Object::Fields::Field' ) ||
                $val->isa( 'DB::Object::Statement' )
              )
            ) || 
            $dbo->placeholder->has( \$val ) ||
            $self->_is_scalar( $val ) ||
            uc( $val ) eq 'NULL' )
    {
        $val = $dbo->quote( $val, $const ) if( $dbo );
    }

    my $types;
    # If the value is a statement object, stringify it, surround it with parenthesis and use it
    if( $self->_is_a( $val, 'DB::Object::Statement' ) )
    {
        $self->messagec( 5, "Merging {green}", $val->query_object->elements->length, "{/} elements from this statement object associated with out field {green}", $self->as_string, "{/}" );
        $qo->elements->merge( $val->query_object->elements );
        $val = '(' . $val->as_string . ')';
    }
    elsif( $dbo->placeholder->has( $self->_is_scalar( $val ) ? $val : \$val ) )
    {
        $types = $dbo->placeholder->replace( $self->_is_scalar( $val ) ? $val : \$val );
    }
    # A placeholder, but don't know the type
    elsif( $val =~ /^$placeholder_re$/ )
    {
        $types = Module::Generic::Array->new( [''] );
    }
    elsif( $self->_is_scalar( $val ) )
    {
        $val = $$val;
    }
#     return( DB::Object::Fields::Overloaded->new(
#         expression => 
#             (
#                 $swap
#                     ? "${val} ${op} ${field}" 
#                     : "${field} ${op} ${val}"
#             ),
#         field => $self,
#         # binded => ( $val =~ /^$placeholder_re$/ || $types ) ? 1 : 0,
#         ( $val =~ /^$placeholder_re$/ ? ( placeholder => $val ) : () ),
#         type => $self->type,
#         # query_object => $self->query_object,
#         debug => $self->debug,
#         ( $val !~ /^$placeholder_re$/ ? ( value => $val ) : () ),
#         # binded_offset => ( $val =~ /^$placeholder_re$/ && defined( $+{offset} ) ) ? ( $+{offset} - 1 ) : undef,
#         # types => $types,
#     ) );
    my $over = DB::Object::Fields::Overloaded->new(
        expression => 
            (
                $swap
                    ? "${val} ${op} ${field}" 
                    : "${field} ${op} ${val}"
            ),
        field => $self,
        # binded => ( $val =~ /^$placeholder_re$/ || $types ) ? 1 : 0,
        ( $val =~ /^$placeholder_re$/ ? ( placeholder => $val ) : () ),
        # Actually type() will return us the actual data type, not the driver constant
        # type => $self->type,
        ( defined( $const ) ? ( type => $const ) : () ),
        query_object => $qo,
        debug => $self->debug,
        ( $val !~ /^$placeholder_re$/ ? ( value => $val ) : () ),
        # binded_offset => ( $val =~ /^$placeholder_re$/ && defined( $+{offset} ) ) ? ( $+{offset} - 1 ) : undef,
        # types => $types,
    );
    return( $over );
}

sub FREEZE
{
    my $self       = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class      = CORE::ref( $self );

    # We keep a strict allow-list to avoid accidentally freezing DBI handles or other
    # process-local state.
    my @props = grep( $_ ne 'datatype', @{$self->{_fields}} );

    my $hash = {};
    foreach my $prop ( @props )
    {
        if( CORE::exists( $self->{ $prop } ) &&
            defined( $self->{ $prop } ) &&
            CORE::ref( $self->{ $prop } ) ne 'CODE' )
        {
            $hash->{ $prop } = $self->{ $prop };
        }
    }

    my $datatype = $self->datatype;
    my $dtype_ref = {};
    if( $datatype )
    {
        $dtype_ref->{alias}     = $datatype->alias;
        $dtype_ref->{constant}  = $datatype->constant;
        $dtype_ref->{name}      = $datatype->name;
        $dtype_ref->{re}        = $datatype->re;
        $dtype_ref->{type}      = $datatype->type;
    }
    $hash->{datatype} = $dtype_ref;

    # Return an array reference rather than a list so this works with Sereal and CBOR.
    # Before Sereal version 4.023, Sereal did not support multiple values returned.
    if( $serialiser eq 'Sereal' )
    {
        require Sereal::Encoder;
        require version;

        if( version->parse( Sereal::Encoder->VERSION ) < version->parse( '4.023' ) )
        {
            CORE::return( [$class, $hash] );
        }
    }

    # But Storable wants a list with the first element being the serialised element
    CORE::return( $class, $hash );
}

sub STORABLE_freeze { return( shift->FREEZE( @_ ) ); }

sub STORABLE_thaw { return( shift->THAW( @_ ) ); }

sub THAW
{
    # STORABLE_thaw would issue $cloning as the 2nd argument, while CBOR would issue
    # 'CBOR' as the second value.
    my( $self, undef, @args ) = @_;
    my $ref   = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
    my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
    my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
    my $dtype = CORE::delete( $hash->{datatype} );
    my $new;
    # Storable pattern requires to modify the object it created rather than returning a new one
    if( CORE::ref( $self ) )
    {
        foreach( CORE::keys( %$hash ) )
        {
            $self->{ $_ } = CORE::delete( $hash->{ $_ } );
        }
        $new = $self;
    }
    else
    {
        $new = CORE::bless( $hash => $class );
    }
    $new->datatype( %$dtype ) if( $dtype );
    CORE::return( $new );
}

1;
# NOTE: POD
__END__

=encoding utf8

=head1 NAME

DB::Object::Fields::Field - Table Field Object

=head1 SYNOPSIS

    my $dbh = DB::Object->connect({
        driver => 'Pg',
        conf_file => $conf,
        database => 'my_shop',
        host => 'localhost',
        login => 'super_admin',
        schema => 'auth',
        # debug => 3,
    }) || bailout( "Unable to connect to sql server on host localhost: ", DB::Object->error );
    my $tbl_object = $dbh->customers || die( "Unable to get the customers table object: ", $dbh->error, "\n" );
    my $fields = $tbl_object->fields;
    print( "Fields for table \"", $tbl_object->name, "\": ", Dumper( $fields ), "\n" );
    my $c = $tbl_object->fo->currency;
    print( "Got field object for currency: \"", ref( $c ), "\": '$c'\n" );
    printf( "Name: %s\n", $c->name );
    printf( "Type: %s\n", $c->type );
    printf( "Default: %s\n", $c->default );
    printf( "Is nullable: %s\n", $c->is_nullable );
    printf( "Is primary key: %s\n", $c->is_primary );
    printf( "Is an array: %s\n", $c->is_array );
    printf( "Position: %s\n", $c->pos );
    # For example for varchar, this could be 255 based on the table schema
    printf( "Size: %s\n", $c->size );
    printf( "Table: %s\n", $c->table );
    printf( "Database: %s\n", $c->database );
    printf( "Schema: %s\n", $c->schema );
    printf( "Field comment: %s\n", $c->comment );
    printf( "Constant value: %s\n", $c->datatype->constant ); # 12
    printf( "Constant name: %s\n", $c->datatype->name ); # For example: SQL_VARCHAR
    printf( "Constant type: %s\n", $c->datatype->type ); # varchar
    printf( "Next field: %s (%s)\n", $c->next, ref( $c->next ) );
    print( "Showing name fully qualified: ", $c->prefixed(3)->name, "\n" );
    # would print: my_shop.public.customers.currency
    print( "Trying again (should keep prefix): ", $c->name, "\n" );
    # would print again: my_shop.public.customers.currency
    print( "Now cancel prefixing at the table fields level.\n" );
    $tbl_object->fo->prefixed( 0 );
    print( "Showing name fully qualified again (should not be prefixed): ", $c->name, "\n" );
    # would print currency
    print( "First element is: ", $c->first, "\n" );
    print( "Last element is: ", $c->last, "\n" );
    # Works also with the operators +, -, *, /, %, <, <=, >, >=, !=, <<, >>, &, |, ^, ==
    my $table = $dbh->dummy;
    $table->select( $c + 10 ); # SELECT currency + 10 FROM dummy;
    $c == 'NULL' # currency IS NULL

You can also use a L<DB::Object::Statement> as a value in the operation:

    my $tbl = $dbh->services || die( "Unable to get the table object \"services\": ", $dbh->error );
    my $userv_tbl = $dbh->user_services || die( "Unable to get the table object \"user_services\": ", $tbl->->error );
    $tbl->where( $tbl->fo->name == '?' );
    my $sub_sth = $tbl->select( 'id' ) || die( "Unable to prepare the sql query to get the service id: ", $tbl->error );
    $userv_tbl->where(
        $dbh->AND(
            $tbl->fo->user_id == '?',
            $tbl->fo->service_id == $sub_sth
        )
    );
    my $query = $userv_tbl->delete->as_string || die( $tbl->error );

This would yield:

    DELETE FROM user_services WHERE user_id = ? AND name = (SELECT id FROM services WHERE name = ?)

=head1 VERSION

    v1.3.0

=head1 DESCRIPTION

This is a table field object as instantiated by L<DB::Object::Fields>

=head1 CONSTRUCTOR

=head2 new

Takes an hash or hash reference of parameters and this will create a new L<DB::Object::Fields::Field> object.

=over 4

=item * C<check_name>

Specifies the name of the check constraint associated wit this field.

=item * C<comment>

Specifies the field comment, if any.

=item * C<datatype>

Specifies an hash of key-value pairs, namely: C<name>, C<constant>, C<type> and C<re>

=item * C<debug>

Toggles debug mode on/off

=item * C<default>

Specifies the  default field value.

=item * C<foreign_name>

Specifies the name of the foreign key constraint associated wit this field.

=item * C<index_name>

Specifies the index name to which this field is related.

=item * C<is_array>

Specifies a boolean value whether the field value represents an array or not.

=item * C<is_check>

Specifies a boolean value whether the field is associated with a check constraint or not.

=item * C<is_foreign>

Specifies a boolean value whether the field is associated with a foreign key constraint or not.

=item * C<is_nullable>

Specifies a boolean value whether the field value can be null or not.

=item * C<is_primary>

Specifies a boolean value whether the field is the primary key for its table or not.

=item * C<is_unique>

Specifies a boolean value whether the field is part of a unique index or not.

=item * C<name>

The table column name.

An error will be returned if this value is not provided upon instantiation.

=item * C<pos>

The table column position in the table.

=item * C<prefixed>

Defaults to 0

=item * C<query_object>

The L<DB::Object::Query> object.

=item * C<size>

Set the field size, such as for varchar.

Defaults to C<undef>

=item * C<table_object>

The L<DB::Object::Tables> object.

An error will be returned if this value is not provided upon instantiation.

=item * C<type>

The column data type.

=back

=head1 METHODS

=head2 as_string

This returns the name of the field, possibly prefixed

This is also called to stringify the object

    print( "Field is: $field\n" );

=head2 attach

This takes a table object, and attach it to our current object.

This returns the current object upon success, or upon error, it sets an L<error object|DB::Object::Exception>, and returns C<undef> in scalar context, or an empty list in list context.

=head2 base_class

Returns the base class, such as C<DB::Object::Postgres> or C<DB::Object::SQLite>

=head2 clone

Makes a clone of the object and returns it.

However, it does not makes a clone of the entire field object, but instead leaves out the L<query object|DB::Object::Query> and the L<table object|DB::Object::Tables>

=head2 constant

A data type constant set by L<DB::Object::Table/structure>. This helps determine how to deal with some fields.

This is an hash object that contains 3 properties:

=over 4

=item * C<constant>

An integer set by the database driver to represent the constant

=item * C<name>

The constant name, e.g. C<PG_JSONB>

=item * C<type>

The data type, e.g. C<jsonb>

=back

=head2 check_name

Sets or gets the optional name of the check constraint associated with this field.

=head2 comment

Sets or gets the optional comment that may have been set for this table field.

=head2 database

Sets or gets the name of the database this field is attached to.

=head2 database_object

Returns the database object, ie the one used to make sql queries

=head2 default

Sets or gets the default value, if any, for that field.

=head2 foreign_name

Sets or gets the optional name of the foreign key constraint associated with this field.

=head2 first

Returns the first field in the table.

=head2 index_name

Sets or gets the index name to which this field is related. Defaults to C<undef>

=head2 is_array

Sets or gets true if the field is an array, or false otherwise.

=head2 is_check

Sets or gets true if the field is associated with a check constraint, or false otherwise.

=head2 is_foreign

Sets or gets true if the field is associated with a foreign key constraint, or false otherwise.

=head2 is_nullable

Sets or gets true if the field can be null, or false otherwise.

=head2 is_primary

Sets or gets true if the field is the primary key of the table, or false otherwise.

=head2 is_unique

Sets or gets true if the field is part of a unique index, or false otherwise.

If it is, check out the value for L<index_name|/index_name>

=head2 last

Returns the last field in the table.

=head2 name

Sets or gets the field name. This is also what is returned when object is stringified. For example

    my $c = $tbl_object->fo->last_name;
    print( "$c\n" );
    # will produce "last_name"

The output is altered by the use of B<prefixed>. See below.

=head2 next

Returns the next field object.

=head2 pos

Sets or gets the position of the field in the table. This is an integer starting from 1.

=head2 prefixed

Called without argument, this will instruct the field name to be returned prefixed by the table name.

    print( $tbl_object->fo->last_name->prefixed, "\n" );
    # would produce my_shop.last_name

B<prefixed> can also be called with an integer as argument. 1 will prefix it with the table name, 2 with the schema name and 3 with the database name.

=head2 prev

Returns the previous field object.

=head2 query_object

Sets or gets the query object (L<DB::Object::Query> or one of its descendant)

=head2 schema

Returns the table schema to which this field is attached.

=head2 size

Sets or gets the size of the field when appropriate, such as when the type is C<varchar> or C<char>

=head2 table

Returns the table name for this field.

=head2 table_name

Same as above. This returns the table name.

=head2 table_object

Sets or gets the table object which is a L<DB::Object::Tables> object.

=head2 type

Returns the field type such as C<jsonb>, C<json>, C<varchar>, C<integer>, etc.

See also L</constant> for an even more accurate data type, and the driver associated constant that is used for binding values to placeholders.

=head2 _find_siblings

Given a field position from 1 to n, this will find and return the field object. It returns undef or empty list if none could be found.

=head1 OVERLOADING

The following operators are overloaded:

    +, -, *, /, %, <, <=, >, >=, !=, <<, >>, lt, gt, le, ge, ne, &, |, ^, ==, eq, ~~

Thus a field named "dummy" could be used like:

    $f + 10

which would become:

    dummy + 10

And this works too:

    10 + $f # 10 + dummy

Another example, which works in PostgreSQL:

    $ip_tbl->where( 'inet 192.16.1.20' << $ip_tbl->fo->ip_addr );
    my $ref = $ip_tbl->select->fetchrow_hashref;

The equal operator C<==> would become C<=>:

    $f == 'NULL' # dummy = NULL

but, if you use perl's C<eq> instead of C<==>, you would get:

    $f eq 'NULL' # dummy IS NULL

Note that you have to take care of quotes yourself, because there is no way to tell if the right hand side is a string or a function

    $f == q{'JPY'} # dummy IS 'JPY'

or, to insert a placeholder

    $f == '?' # dummy = ?
    # or;
    $f eq '?' # dummy IS ?
    my $sth = $table->select( $f eq '?' ); # SELECT dummy IS ? FROM some_table
    my $row = $sth->exec( 'JPY' )->fetchrow;

of course

    my $sth = $table->select( dummy => '?' );

also works

The C<=~> and C<!~> operators cannot be overloaded in perl, so for regular expressions, use the C<REGEXP> function if available, or provided the expression directly as a string:

    $table->select( "currency ~ '^[A-Z]{3}$'" );

If you want to use placeholder in the value provided, you will have to provide a C<?> in the value next to the operator. This module will not parse the value used with the operation, so if you wanted to use a placeholder in:

    $f == "'JPY'"

Simply provide:

    $f == '?'

You can use the search operator C<~~> for SQL Full Text Search and it would be converted into C<@@>:

Let's imagine a table C<articles> in a L<PostgreSQL database|https://www.postgresql.org/docs/current/textsearch.html>, such as:

    CREATE TABLE articles (
        id SERIAL PRIMARY KEY,
        title TEXT NOT NULL,
        content TEXT NOT NULL,
        ts TSVECTOR GENERATED ALWAYS AS
            (setweight(to_tsvector('english', coalesce(title, '')), 'A') || 
            setweight(to_tsvector('english', coalesce(content, '')), 'B')) STORED
    );

them you coud do:

    $tbl->where(
        \"websearch_to_tsquery(?)" ~~ $tbl->fo->ts,
    );

and this would create a C<WHERE> clause, such as:

    WHERE websearch_to_tsquery(?) @@ ts

See L<PostgreSQL documentation|https://www.postgresql.org/docs/current/textsearch.html> for more details.

but, under L<SQLite|https://www.sqlite.org/fts5.html>, this is not necessary, because the Full Text Search syntax is different:

Create a FTS-enabled virtual table.

    CREATE VIRTUAL TABLE articles 
    USING FTS5(title, content);

then query it:

    SELECT * FROM articles WHERE articles MATCH(?);

See L<SQLite documentation|https://www.sqlite.org/fts5.html> for more details.

and, in a L<MySQL database|https://dev.mysql.com/doc/refman/8.0/en/fulltext-search.html>, also unnecessary, because a bit different:

    CREATE TABLE articles (
        id INT UNSIGNED AUTO_INCREMENT NOT NULL PRIMARY KEY,
        title TEXT NOT NULL,
        content TEXT NOT NULL,
        FULLTEXT (title,content)
    ) ENGINE=InnoDB;

then:

    SELECT * FROM articles WHERE MATCH(title,content) AGAINST(? IN NATURAL LANGUAGE MODE);

See L<MySQL documentation|https://dev.mysql.com/doc/refman/8.0/en/fulltext-search.html> for more details.

=head1 SEE ALSO

L<perl>

=head1 AUTHOR

Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2020-2021 DEGUEST Pte. Ltd.

You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.

=cut
