package Mojolicious::Plugin::ORM::DBIx 0.02;
use v5.26;
use warnings;

# ABSTRACT: Easily load and access DBIx::Class functionality in Mojolicious apps

=encoding UTF-8
 
=head1 NAME
 
Mojolicious::Plugin::ORM::DBix - Easily load and access DBIx::Class functionality in Mojolicious apps
 
=head1 SYNOPSIS

  # Register plugin
  $self->plugin('ORM::DBIx' => {
    dsn                  => $conf->{dsn},
    username             => $conf->{user},
    password             => $conf->{pass},
  });

  ...

  # access in controller
  sub get_user($self) {
    my $user = $self->model("User")->find($self->req->param('id'));
    $self->render(json => {user => $user->username});
  }

  ..

  # use from command-line during development, following schema migration
  
  tyrrminal@devserver:/app$ script/myapp schema-load --noquiet
  Dumping manual schema for Myapp::Model to directory /app/lib ...
  Schema dump completed.

=head1 DESCRIPTION

Mojolicious::Plugin::ORM::DBIx streamlines the process of getting DBIC classes
generated and accessible from within a Mojolicious application.

=head1 METHODS

L<Mojolicious::Plugin::ORM::DBIx> inherits all methods from L<Mojolicious::Plugin>
and implements the following new ones

=cut

use Mojo::Base 'Mojolicious::Plugin';

use DBIx::Class::Schema::Loader qw(make_schema_at);
use Mojo::Util                  qw(class_to_path);
use Module::Load::Conditional   qw(check_install);
use Readonly;
use Syntax::Keyword::Try;
use version;

use experimental qw(signatures);

Readonly::Scalar my $DEFAULT_DSN => 'dbi:SQLite:dbname=:memory:';
Readonly::Array my @DEFAULT_DBIX_COMPONENTS => qw(Relationship::Predicate InflateColumn::DateTime);

=pod

=head2 register( $args )

Register plugin in L<Mojolicious> application. The following keys are supported
in C<$args>

=head4 dsn

The L<data source name|https://en.wikipedia.org/wiki/Data_source_name> for connecting
to the database. Defaults to C<dbi:SQLite:dbname=:memory:> if omitted.

=head4 namespace

The perl class name of the root schema object for the application. Defaults to
C<$Moniker::Model> if omitted, where C<$Moniker> is the mojolicious moniker with the 
first letter capitalized. This class does not need to be manually created, as 
L</run_schema_load> can create it along with the rest of the schema.

=head4 username

The database connection username

=head4 password

The database connection password

=head4 connect_params

An optional HashRef of additional connection parameters to be passed to DBI at
connection time.

I<The following parameters pertain to DBIx schema loader code generation>

=head4 lib

The directory where the schema loader files will be written to. 
Default C<$MOJO_HOME/lib>

=head4 codegen_filters

An optional ordered ArrayRef of functions for filtering/modifying the code 
generated by the schema loader. See 
L<DBIx::Class::Schema::Loader::Base/filter_generated_code> for details.

=head4 overwrite

A proxy value for L<DBIx::Class::Schema::Loader::Base/overwrite_modifications>.
B<N.B.> defaults to true

=head4 feature_bundle

When generating code, add a C<use vX.XX;> line near the end of the file, such 
that it applies to manual additions to the Result class files (but not to the
generated code itself). Defaults to the perl version being used to generate the
code. Any value that is not a valid perl 
L<version|https://perldoc.perl.org/version> will cause this option to be disabled
with a warning written to the mojolicious log. Pass undef to disable this option
without a warning.

See L<FEATURE-BUNDLES|https://perldoc.perl.org/feature#FEATURE-BUNDLES> for 
more information on valid values.

If enabled, this line is added to the code before running any custom 
L</codegen_filters>

=head4 tidy_format_skipping

When using L<Perl::Tidy> you may wind up with formatting disagreements between
the generated code and perltidy's ruleset. This option allows you to add lines
around the generated code to disable perltidy formatting, while leaving it 
enabled for any custom code added to the end of the Result class files.

Takes an ArrayRef containing two strings: C<[$disable_formatting, $enable_formatting]>.
Default is C<['#E<lt>E<lt>E<lt>','#E<gt>E<gt>E<gt>']>

See L<https://perltidy.sourceforge.net/perltidy.html#Skipping-Selected-Sections-of-Code>.

Pass undef to disable this behavior.

If enabled, these lines are added after running any custom L</codegen_filters>

=head4 dbix_components

An optional ArrayRef of DBIx components to load into generated classes. Defaults 
to C<[>L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>C<,>L<Relationship::Predicate|DBIx::Class::Relationship::Predicate>C<]>

The defaults will be prepended to the contents of the passed ArrayRef; to 
circumvent this behavior, pass C<undef> as the first element of the array.

=head4 loader_options

An optional HashRef of additional parameters to pass to 
L<DBIx::Class::Schema::Loader/make_schema_at>. See 
L<DBIx::Class::Schema::Loader::Base> for possible values and their meanings.

=cut

sub register($self, $app, $conf) {
  push($app->commands->namespaces->@*, 'Mojolicious::Plugin::ORM::DBIx::Command');
  my $conf_dbix_components = $conf->{dbix_components} // [];

  my @credentials     = grep {defined} ($conf->{username}, $conf->{password});
  my $model_directory = $conf->{lib}             // $app->home->child('lib')->to_string;
  my $dsn             = $conf->{dsn}             // $DEFAULT_DSN;
  my $namespace       = $conf->{namespace}       // join(q{::}, ucfirst($app->moniker), 'Model');
  my $connect_params  = $conf->{connect_params}  // {};
  my $codegen_filters = $conf->{codegen_filters} // [];
  my $overwrite       = $conf->{overwrite}       // 1;
  my $loader_options  = $conf->{loader_options}  // {};
  my $feature_bundle  = $conf->{feature_bundle}       // (exists($conf->{feature_bundle})       ? undef : "$^V");
  my $tidy_fs         = $conf->{tidy_format_skipping} // (exists($conf->{tidy_format_skipping}) ? undef : ['#<<<', '#>>>']);
  my $dbix_components = [@DEFAULT_DBIX_COMPONENTS, $conf_dbix_components->@*];
  splice($dbix_components->@*, 0, scalar(@DEFAULT_DBIX_COMPONENTS))
    if (scalar($conf_dbix_components->@*) && !defined($conf_dbix_components->[0]));

  try {
    version->declare($feature_bundle);    #ensure feature_bundle is a properly-formed version number/string
  } catch ($e) {
    $app->log->warn("ORM::DBIx ignoring feature_bundle due to invalid version format: $feature_bundle");
    $feature_bundle = undef;
  }

  my $schema;
  if (check_install(module => $namespace)) {
    require(class_to_path($namespace));
    $schema = $namespace->connect($dsn, @credentials, $connect_params);
  } else {
    $app->log->fatal(
      "ORM::DBIx error: '$namespace' could not be loaded. ORM functions unavailable; do you need to run schema-load?");
  }

=pod

=head2 db

Returns the root schema object for the application, a subclass of L<DBIx::Class::Schema>

=cut

  $app->helper(
    db => sub($c) {
      return $schema;
    }
  );

=pod

=head2 model( $model_name )

Returns the resultset object for the specified model name. Identical to C<app-E<gt>db-E<gt>resultset($model_name)>

=cut

  $app->helper(
    model => sub($c, $model) {
      return undef unless (defined($schema));
      return $schema->resultset($model);
    }
  );

=pod

=head2 run_schema_load( $debug, $quiet )

Generate (or regenerate) model classes from database schema. More or less, this
just runs L<DBIx::Class::Schema::Loader/make_schema_at> with options set at the
time of plugin registration.

Parameters:

=head4 $debug

Write generated classes to C<STDERR>. Default: false

See L<DBIx::Class::Schema::Loader::Base/debug>

=head4 $quiet

Don't print the C<Dumping manual schema...>, C<Schema dump completed> messages. 
Default: true

See L<DBIx::Class::Schema::Loader::Base/quiet>

=cut

  $app->helper(
    run_schema_load => sub($c, $debug = 0, $quiet = 1) {
      $c->log->debug("Creating model from database schema");
      my @filters = $codegen_filters->@*;
      if (defined($feature_bundle)) {
        unshift(@filters, sub($type, $class, $text) {$text .= sprintf("\nuse %s;", $feature_bundle)});
      }
      if (defined($tidy_fs)) {
        my ($end, $start) = (reverse($tidy_fs->@*))[0, 1];
        push(@filters, sub($type, $class, $text) {join("\n", $start, $text, $end)});
      }
      make_schema_at(
        $namespace, {
          $loader_options->%*,
          debug                   => $debug,
          quiet                   => $quiet,
          overwrite_modifications => $overwrite,
          dump_directory          => $model_directory,
          components              => $dbix_components,
          filter_generated_code   => sub ($type, $class, $text) {
            $text = $_->($type, $class, $text) foreach (@filters);
            return $text;
          },
        },
        [$dsn, @credentials]
      );
    }
  );

}

=pod

=head1 COMMANDS

=head2 schema-load [--debug] [--[no]quiet]

Mojolicious command to execute L</run_schema_load>

=head1 AUTHOR

Mark Tyrrell C<< <mark@tyrrminal.dev> >>

=head1 LICENSE

Copyright (c) 2024 Mark Tyrrell

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

=cut

1;

__END__
