package Dancer2::Plugin::QuickORM 0.0001;
use strict;
use warnings;
use Dancer2::Core::DSL;
use Dancer2::Plugin;
use Carp qw/croak/;
use Lingua::EN::Inflect::Phrase;

our $AUTHORITY = 'cpan:GEEKRUTH';    # AUTHORITY

my $_orms = {};

plugin_keywords qw/orm/;

sub BUILD {
   my ($self)       = @_;
   my $config       = $self->config;
   my $new_keywords = {};
   foreach my $name ( keys %$config ) {
      my $orm_config = $config->{$name};
      my $class      = $orm_config->{class}
         or croak "ORM '$name' is missing 'class' in the configuration";
      $ENV{"QuickORM_${name}_name"} = $name;
      foreach my $key ( keys %$orm_config ) {
         $ENV{"QuickORM_${name}_$key"} = $orm_config->{$key};
      }
      ( my $class_file = "$class.pm" ) =~ s{::}{/}g;
      eval { require $class_file }
         or croak "Failed to load ORM class '$class': $@";
      my $orm = $class->orm($name);
      $_orms->{$name} = $orm;
      foreach my $table ( $orm->schema($name)->tables ) {
         my $table_name = $table->name;
         my $singular   = $self->_source_name_to_method_name($table_name);
         my $plural     = $self->_source_name_to_plural_name($table_name);

         # scalar/arrayref: fetch the single row by primary key.
         # Dancer2::Plugin always calls keyword subs as ($plugin, @args), so
         # the plugin instance itself is shifted off and discarded here.
         my $row_sub = sub {
            my ( undef, $id ) = @_;
            croak "'$table_name' requires a primary key value"
               unless defined $id;
            croak
               "'$table_name' expects a single primary key value, not a hashref of search conditions"
               if ref($id) eq 'HASH';
            return $orm->handle($table_name)->by_id($id);
         };

         # hashref: run it through SQL::Abstract as search conditions.
         # no argument: return every row.
         my $set_sub = sub {
            my ( undef, $where ) = @_;
            my $handle = $orm->handle($table_name);
            return $handle->all unless defined $where;
            croak "'$table_name' expects a hashref of search conditions"
               unless ref($where) eq 'HASH';
            return $handle->where($where)->all;
         };

         my @words;
         if ( $singular eq $plural ) {

            # words like "moose" only get one keyword, so it has to
            # tell a row lookup from a search by the shape of its argument.
            my $smart_sub = sub {
               my ( undef, $arg ) = @_;
               croak
                  "'$table_name' requires a primary key value or a hashref of search conditions"
                  unless defined $arg;
               return $orm->handle($table_name)->where($arg)->all
                  if ref($arg) eq 'HASH';
               croak "'$table_name' does not accept a reference of type '"
                  . ref($arg) . q/'/
                  if ref($arg) && ref($arg) ne 'ARRAY';
               return $orm->handle($table_name)->by_id($arg);
            };
            @words = ( [ $singular => $smart_sub ] );
         }
         else {
            @words = ( [ $singular => $row_sub ], [ $plural => $set_sub ] );
         }

         foreach my $pair (@words) {
            my ( $word, $sub ) = @$pair;
            if ( defined $new_keywords->{$word} ) {

               # it already exists, so let's make that one an error
               $new_keywords->{$word} = sub {
                  croak "$word is ambiguous; use <schema>_$word instead!";
               };
            }
            else {
               $new_keywords->{$word} = $sub;
            }
            $new_keywords->{"${name}_${word}"} = $sub;
         }
      }
   }
   foreach my $dsl_keyword ( keys %{ Dancer2::Core::DSL->dsl_keywords } ) {
      delete $new_keywords->{$dsl_keyword};
   }
   foreach my $new_keyword ( keys %$new_keywords ) {
      next if defined $self->keywords->{$new_keyword};
      $self->keywords->{$new_keyword} = $new_keywords->{$new_keyword};
   }
   return;
}

sub orm {
   my ( $self, $name ) = @_;
   $name //= 'default';
   if ( !$_orms->{$name} ) {
      croak "ORM '$name' is not defined in the configuration";
   }
   return $_orms->{$name};
}

sub _source_name_to_method_name {
   my ( $class, $source_name ) = @_;
   my $phrase       = $class->_source_name_to_phrase($source_name);
   my $singularised = Lingua::EN::Inflect::Phrase::to_S($phrase);
   return join '_', split q{ }, $singularised;
}

sub _source_name_to_phrase {
   my ( $class, $source_name ) = @_;
   return join q{ }, map {
      join( q{ }, map {lc} grep {length} split /([A-Z]{1}[^A-Z]*)/ )
   } split /::/, $source_name;
}

sub _source_name_to_plural_name {
   my ( $class, $source_name ) = @_;
   my $phrase     = $class->_source_name_to_phrase($source_name);
   my $pluralised = Lingua::EN::Inflect::Phrase::to_PL($phrase);
   return join '_', split q{ }, $pluralised;
}
1;

=pod

=encoding UTF-8

=head1 NAME

Dancer2::Plugin::QuickORM - Adds QuickORM syntactic sugar to Dancer2

=head1 VERSION

version 0.0001

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 SUBROUTINES/METHODS

=head1 ATTRIBUTES

=head1 DIAGNOSTICS

=head1 CONFIGURATION AND ENVIRONMENT

=head1 DEPENDENCIES

=head1 INCOMPATIBILITIES

=head1 BUGS AND LIMITATIONS

=head1 SEE ALSO

=head1 AUTHOR

D Ruth Holloway <ruth@hiruthie.me>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2026 by D Ruth Holloway.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__

# ABSTRACT: Adds QuickORM syntactic sugar to Dancer2

