package # D - Database
	D;  # Hide from PAUSE

use strict;
use warnings;


use C;
use DDP;

# Helper to revive next and count methods to access data
{
	package D::Iterator;
	sub next   { shift  $_[0]->@*            }
	sub count  { scalar $_[0]->@*            }
	sub D::Arr { bless [ @_ ], 'D::Iterator' }
}


sub db  { CORE::state $schema //=  ref $_[0] && $_[0]  || D::connect(@_) }
sub dbh { db->storage->dbh                  }
# https://metacpan.org/pod/DBIx::Class::Storage#txn_scope_guard
sub txn { db->txn_scope_guard }

# Prepare and execute a single statement. See DBI::do
sub do  { dbh->do( @_ ) }
sub q   { dbh->selectall_arrayref( @_ )     }   # query -> array of arrays
sub q00 { D::q( @_ )->[0][0]                }   # the first field from the first row
sub rs  { my $rs = dbh->prepare(shift);
	$rs->execute( @_ );
	return $rs;
}
sub qh  { my( $st, $a ) =  (shift,shift);                    # query hashes
	$a? $a->{ Slice }= {} : $a= { Slice => {} };
	D::q $st, $a, @_;
}


# Run arbitrary SQL, list columns and get DBIx::Class::ResultSet
use DBIx::Class::Report;
sub report {
	my $report = DBIx::Class::Report->new(
		schema  =>  D::db(),
		sql     =>  shift,
		columns =>  shift,
	);

	return $report->fetch( @_ );
}



sub dsn {
	my $DB =  shift;

	# Return DSN or autogenerate it
	return $DB->{ DSN }  ||  $DB->{ PORT }?
		sprintf "dbi:%s:dbname=%s;host=%s;port=%s", @$DB{ qw/ DRVR NAME HOST PORT / }:
		sprintf "dbi:%s:dbname=%s;host=%s",         @$DB{ qw/ DRVR NAME HOST      / };
}

sub connect {
	if( !@_ ) {
		my $DB =  C::config->{ DbAccess };
		# Do not setup and do not cache DSN. This cause issues if user does not work with it.
		# Eg. DRVR/NAME/HOST/PORT were changed, but DSN still cached.
		local $DB->{ DSN } =  dsn( $DB );
		@_ =  @$DB{ qw/ schema DSN USER PASS / }
	}

	my $schema =  shift->connect( @_,  {
		AutoCommit         =>  1,
		RaiseError         =>  1,
		PrintError         =>  1,
		ShowErrorStatement =>  1,
		auto_savepoint     =>  1,
		# Required to prevent syntax error: SELECT User.id because of reserwed 'user' word
		quote_char         =>  '"',
		# HandleError      =>  sub{ DB::x; 1; },
		# unsafe           =>  1,
	});
	$schema->can( 'storage' )
		&& $schema->storage->dbh->do( 'SET timezone TO ?', {},
			$ENV{ PGTZ }  // $ENV{ TZ }  // 'Europe/Zaporozhye'
		);


	return $schema;
}



# Tries to find data by ID or condition provided via hashref as $cond
# Found row will be returned. It dies if many rows were found.
# If you provide hashref as third parameter then
# 1. Found row will be updated by this data.
# 2. Or, if nothing was found and search was done without ID then
#    a new record will be created with { %$cond, %$data } merged together.
#

sub obtain_data {
	my( $table, $cond, $data, $update ) =  @_;


	## Try to find by ID or condition
	my $row =  defined $cond  &&  eval{
		D::SS( $table, ref $cond? $cond : { id => $cond } );
	}   or do{
		## OR  if no error happened ...
		!$@     or do{ # just for debugging purpose
			warn( sprintf "%s %s %s",
				$table, $@, DDP::np $cond
			);
			my $e =  $@; die;
		};

		# ... create row if data provided and searching was done not by ID.
		# Note: This would be not correct to create row with the provided ID or the
		# provided data and ignored its ID at $cond.
		$data  &&  (!defined $cond || ref $cond)   or return;

		ref $cond eq 'HASH'   && ($data =  { %$cond, %$data });

		# TODO: If value for PK is detected -> die
		!exists $data->{id}   or return; # SECURITY: Prohibit custom IDs during creation

		my $row =  D::C( $table, $data );
		return $row;
	};


	## If requested then update the found row by a provided $data
	# TODO? We should not read more fields then it was provided during update.
	# TODO: Test D::T Test => { name => 'John' }, undef, 'update'
	if( $update && $data ) { D::RU( $row, $data ); $row->discard_changes }


	return $row;
}



# Get resultset by name, aka pointer to table


our $SECURE =  1;
sub INSECURE {
	## Return whole table or try to obtain data
	return @_ == 1?
		(ref $_[0]? shift : db->resultset( shift )):
		do{ local $SECURE =  0; obtain_data( @_ ) }
}



sub INSECURE_C { D::INSECURE( shift )->create   ( @_ ) }
sub INSECURE_S { D::INSECURE( shift )->search_rs( @_ ) }



# Entry point to manipulate table's data
sub T {
	local $SECURE =  1;
	## Return whole table or try to obtain data
	return @_ == 1? D::S( shift ) : obtain_data( @_ );
}



# Fetch permission policies
sub perm {
	my( $table, $action ) =  @_;

	# my $ctx =  C::C();
	# return my $rules = T Policy => { %$ctx, ... };
}



# CRUD
sub C { # create
	my( $table, $data ) =  @_;

	my $defaults =  {};
	my $rs =  D::INSECURE( $table );
	# TODO: Select security rules and restrict data accessibility
	if( $SECURE ) {
		# my $rules = T Policy => { ... }   or return;
		# delete $data->%{ @list }
		# $defaults =  ...
		$rs =  $rs->guard( C::C );
	}

	my $row =  $rs->create({ %$data, %$defaults });
	$row->{ _created } =  1;

	return $row;
}



sub S { # search
	my( $table, $cond ) =  (shift,shift);

	my $rs =  D::INSECURE( $table );
	# TODO: Select security rules and restrict data accessibility
	if( $SECURE ) {
		# 	my $rules = T Policy => { ... }   or return;
		# 	$cond =  ...
		$rs =  $rs->guard( C::C );
	}
	$rs->search_rs( $cond, @_ );
}



sub SS { # search single
	my( $table, $cond ) =  @_;

	my $rs =  D::INSECURE( $table );
	# TODO: Select security rules and restrict data accessibility
	if( $SECURE ) {
		# 	my $rules = T Policy => { ... }   or return;
		# 	$cond =  ...
		$rs =  $rs->guard( C::C );
	}

	if( D::INSECURE( $table )->search( $cond )->count > 1 ) {
		warn 'Multiple rows returned', $table .DDP::np $cond;
	}

	$rs->single( $cond );
}



sub RU { # record update
	my( $record, $data ) =  @_;

	# TODO: Select security rules and restrict data accessibility
	# if( $SECURE ) {
	# 	my $rules = T Policy => { ... }   or return;
	# 	delete $data->%{ @list }
	# }

	$record->update( $data );
}



sub RD { # record delete
	my( $record ) =  @_;
	# NOTICE: For only one parameter D::T will return pointer to table,
	# which will cause huge DATA LOSS: ->resultset( 'XXX' )->delete
	# So we require more then one parameter
	ref $record   or @_ > 1  &&  ($record =  D::T @_);


	# TODO: Select security rules
	# if( $SECURE ) {
	# 	my $rules = T Policy => { ... }   or return;
	# }

	$record->delete;
}



# MISC
sub columns_info {
	my( $table, $opts ) =  @_;

	# It is OK. We do not access data, only metadata.
	$table =  D::INSECURE( $table );


	my $cols    =  $table->result_source->columns_info;
	my $exclude =  $table->can( 'internal_columns' )  &&  $table->internal_columns;

	my $row;
	for my $col ( keys $cols->%* ) {
		# SKIP excluded columns
		next   if exists $exclude->{ $col };

		my $info =  $cols->{ $col };
		## SKIP not required columns: nullable or with defaults
		next   if $opts->{ required }  &&  $info->{ is_nullable };
		next   if $opts->{ required }  &&  exists $info->{ default_value };


		$row->{ $col } =  $info;
	}

	return wantarray?
		map{ exists $row->{$_}?($_, $row->{$_}):() } $table->result_source->columns:
		$row;
}



1;

=encoding utf8

=head1 NAME

D - Simple interface to work with DB tables

=head1 SYNOPSIS

  use D;

  my $schema =  D::db;      # DBIx::Class::Schema
  my $dbh    =  D::dbh;     # DBI handle

  my $users  =  D::S  User => { active => 1 };
  my $user   =  D::SS User => 1;

  my $count  =  D::q00 'SELECT count(*) FROM "User"';

  # Find by ID, another PK or set of conditions
  my $row =  D::T User =>  7;
  my $row =  D::T User =>  { id => 7 };
  my $row =  D::T User =>  { email => 'a@example.com' };
  my $row =  D::T User =>  [ { f1 => 'v1' }, { f2 => 'v2' } ]; # See SQL::Abstract
  my $row =  D::T User =>  { field1 => 'cond1', field2 => 'cond2' };

  # Find existing or create by merging COND and DATA. COND merged only if it is a HASH.
  # The create dies if user will try to use custom values for PKs
  my $row =  D::T User =>  { email => 'a@example.com' }, { name => 'Alice' };
  my $row =  D::T User =>  undef, { name => 'Alice' }  # Save as D::C User => { name => 'Alice' };

  # Find and update. If not found `{ f2 => 'v2' }` will be created.
  # NOTE: It is still not clear should we create when nothing was found and 'update'
  # flag is true. Or should we return `undef`.
  my $row =  D::T User =>  { f1 => 'value1' }, { f2 => 'v2' }, 'update';


  # Update $row
  D::RU $row, { f1 => 'v1' };

  # Delete $row
  D::RD $row;


  # Work with transaction
  my $atomic =  D::txn;        # ->txn_scope_guard
  ...
  if( ... ) { return; }        # transaction will be rolled back automatically
  $atomic->commit;


  # All methods from DBIx::Class::Storage are available
  my $db =  D::db;
  $db->txn_begin;
  $db->svp_begin;
  $db->txn_do( $coderef );
  $db->svp_release;
  $db->svp_rollback;
  $db->txn_rollback;
  $db->txn_commit;


=head1 DESCRIPTION

L<D> is a small convenience layer around L<DBIx::Class> and L<DBI>.

It provides shortcuts for:

- Getting a schema/DBI handle
- Running raw SQL queries
- Basic CRUD helpers using a DBIx::Class resultset

Most helpers accept a table name (Result class moniker) as the first argument.


=head1 CONFIGURATION

If you call L</db> or L</connect> without arguments, configuration is read from
C<C::config-E<gt>{DbAccess}>.

Expected keys:

  schema   DBIx::Class::Schema class name (required)
  DRVR     DBI driver name (for example: Pg)
  NAME     database name
  HOST     database host
  PORT     database port (optional)
  USER     database user
  PASS     database password
  DSN      optional prebuilt DBI DSN (will be generated if missing)

Timezone:

- If possible, L</connect> sets PostgreSQL timezone from C<$ENV{PGTZ}> or
  C<$ENV{TZ}>; otherwise it defaults to C<Europe/Zaporozhye>.


=head1 FUNCTIONS

=head2 db

  my $schema =  D::db;
  my $schema =  D::db $schema;

Return (and cache) a L<DBIx::Class::Schema> instance. When called without
arguments, it calls L</connect>.


=head2 dbh

  my $dbh = D::dbh;

Shortcut for C<D::db-E<gt>storage-E<gt>dbh>.


=head2 txn

  my $guard =  D::txn;

Return a transaction scope guard (see
L<DBIx::Class::Storage/txn_scope_guard>).


=head2 do

  D::do $statement, @bind;

Shortcut for C<D::dbh-E<gt>do>. See L<DBI/do>.


=head2 q

  my $rows =  D::q $statement, \%attr, @bind;
  my $rows =  D::q 'SELECT * FROM users';

Shortcut for C<DBI::selectall_arrayref>.


=head2 q00

  my $value =  D::q00 $statement, \%attr, @bind;

Return the first field of the first row from L</q>. This is useful for queries
like:

  SELECT count(*) FROM table
  SELECT name FROM table LIMIT 1


=head2 rs

  my $result_set = D::rs $statement, @bind;

Prepare and execute a statement and return resultset.


=head2 qh

  my $rows = D::qh $statement, \%attr, @bind;

Query and return an array of hashes.


=head2 report

  my $rs = D::report $sql, \@columns, @bind;

Run arbitrary SQL using L<DBIx::Class::Report> and return its resultset.


=head2 dsn

  my $dsn = D::dsn \%db_conf;

Build a DBI DSN from config keys.


=head2 connect

  my $schema = D::connect;   # Pass through to DBI->connect
  my $schema = D::connect( $schema_class, $dsn, $user, $pass );

Connect to the database and return a schema instance. See L<DBI/connect>.
Here `$schema_class` is DBIx::Class schema of your application. See L<Schema>.


=head2 obtain_data

  my $row = D::obtain_data($table, $cond, $data, $update);

Try to find a row by:

- ID (when C<$cond> is a scalar)
- Condition (when C<$cond> is a hashref)

If C<$update> is true and C<$data> is provided, the found row is updated.

If nothing was found, and the search was not done by ID, a new row is created
from the merged C<$cond> and C<$data>.

This helper refuses to create rows with an explicit primary key C<id>.


=head2 T

  my $rs  =  D::T 'User';
  my $row =  D::T 'User', $id;
  my $row =  D::T 'User', \%cond, \%data;
  my $row =  D::T 'User', \%cond, \%data, 'update';

Entry point for table access:

- With one argument returns a resultset (see L</S>).
- With more arguments calls L</obtain_data>.


=head2 INSECURE

  my $rs  =  D::INSECURE 'User';
  my $row =  D::INSECURE 'User', \%cond, \%data;

Like L</T>, but disables security guard logic for the duration of the call.


=head2 C

  my $row = D::C $table, \%data;

Create a row in C<$table>.


=head2 S

  my $rs = D::S $table, \%cond, @attrs;

Search rows in C<$table> and return a resultset.


=head2 SS

  my $row =  D::SS $table, \%cond;

Search and return a single row.


=head2 RU

  D::RU $row, \%data;

Update a row with provided data.


=head2 RD

  D::RD $row;
  D::RD $table, \%cond;

Delete a row.

In secure mode, table access routes through C<< $rs->guard(C::C) >> (see
L</SECURITY NOTES>).


=head2 columns_info

  my $info =  D::columns_info 'User';
  my $req  =  D::columns_info 'User', { required => 1 };

Return column metadata from the result source. If C<required> is true, nullable
columns and columns with defaults are excluded. See L<DBIx::Class::ResultSource/columns_info>.


=head1 SECURITY NOTES

Secure mode is enabled by default and is meant to restrict data access and
mutations through per-resultset C<guard> logic.

This distribution includes only a stub C<guard> implementation in
L<Schema::ResultSet>; applications are expected to override it.

Even in insecure mode, L</obtain_data> refuses to create rows with an explicit
primary key C<id>.


=head1 SEE ALSO

L<Mojolicious::Plugin::DbAccess>, L<DBIx::Class>, L<DBI>


=head1 COPYRIGHT AND LICENSE

Copyright (c) 2026 Eugen Konkov.

This program is free software, you can redistribute it and/or modify it under
the terms of the MIT License.

=cut
