<commit_before>=pod
This file is a rip-off of Frew's excellent DBIx::Class::Helpers, but is used to
provide a concatentation function. It would be nice to release this separately,
but for the time being this file only remains copyright (c) 2016 by <NAME>
"fREW" Schmidt.

The original licence for this file only is:
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

package GADS::Helper::Concat;

use parent 'DBIx::Class::ResultSet';

use strict;
use warnings;

use DBIx::Introspector;
use Safe::Isa;

sub _flatten_thing {
   my ($self, $thing) = @_;

   die 'you dummy' unless defined $thing;
   my $ref = ref $thing;

   return ('?', $thing) if !$ref;

   if ($ref eq 'HASH' && exists $thing->{'-ident'}) {
      my $thing = $thing->{'-ident'};
      $thing = $self->current_source_alias . $thing if $thing =~ m/^\./;
      return $self->result_source->storage->sql_maker->_quote($thing)
   }

   return ${$thing} if $ref eq 'SCALAR';

   return @{${$thing}};
}

sub _introspector {

   my $d = DBIx::Introspector->new(drivers => '2013-12.01');

   SQLITE: {
      $d->decorate_driver_unconnected(SQLite => concat => sub {
         sub {
             my @fields = map { "COALESCE($_, '')" } @_;
             [ join ' || ', @fields ];
         }
      });
   }

   PG: {
      $d->decorate_driver_unconnected(Pg => concat => sub {
         sub {
             my $fields = join ', ', @_;
             [ "CONCAT( $fields )" ];
         }
      });
   }

   MYSQL: {
      $d->decorate_driver_unconnected(mysql => concat => sub {
         sub {
             my $fields = join ', ', @_;
             [ "CONCAT( $fields )" ];
         }
      });
   }

   return $d;
}

sub helper_concat {
   my ($self, @things) = @_;

   my $storage = $self->result_source->storage;
   $storage->ensure_connected;

   my $d = _introspector();

   @things = map { _flatten_thing $self, $_ } @things;

   return \(
      $d->get($storage->dbh, undef, 'concat')->(
          @things
      )
   );
}

1;<commit_msg>Add least() functionality to DBIx helpers<commit_after>=pod
This file is a rip-off of Frew's excellent DBIx::Class::Helpers, but is used to
provide a concatentation function. It would be nice to release this separately,
but for the time being this file only remains copyright (c) 2016 by <NAME>
"fREW" Schmidt.

The original licence for this file only is:
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

package GADS::Helper::Concat;

use parent 'DBIx::Class::ResultSet';

use strict;
use warnings;

use DBIx::Introspector;
use Log::Report 'linkspace';
use Safe::Isa;

sub _flatten_thing
{
    my ($self, $thing) = @_;

    die 'you dummy' unless defined $thing;
    my $ref = ref $thing;

    return ('?', $thing) if !$ref;

    if ($ref eq 'HASH') {
        if (exists $thing->{'-ident'}) {
            my $thing = $thing->{'-ident'};
            $thing = $self->current_source_alias . $thing if $thing =~ m/^\./;
            return $self->result_source->storage->sql_maker->_quote($thing)
        }
        else {
            my ($func, $thing2) = %$thing;
            return "$func(".$self->_flatten_thing($thing2).")";
        }
    }

    return ${$thing} if $ref eq 'SCALAR';

    return @{${$thing}};
}

sub _introspector
{
    my $d = DBIx::Introspector->new(drivers => '2013-12.01');

    SQLITE: {
        $d->decorate_driver_unconnected(SQLite =>
            concat => sub {
                sub {
                    my @fields = map { "COALESCE($_, '')" } @_;
                    [ join ' || ', @fields ];
                },
            }
        );
        $d->decorate_driver_unconnected(SQLite =>
            least => sub {
                sub {
                    my $fields = join ', ', @_;
                    [ "MIN( $fields )" ];
                },
            }
        );
    }

    PG: {
        $d->decorate_driver_unconnected(Pg =>
            concat => sub {
                sub {
                    my $fields = join ', ', @_;
                    [ "CONCAT( $fields )" ];
                },
            }
        );
        $d->decorate_driver_unconnected(Pg =>
            least => sub {
                sub {
                    my $fields = join ', ', @_;
                    [ "LEAST( $fields )" ];
                },
            }
        );
    }

    MYSQL: {
        $d->decorate_driver_unconnected(mysql =>
            concat => sub {
                sub {
                    my $fields = join ', ', @_;
                    [ "CONCAT( $fields )" ];
                },
            }
        );
        $d->decorate_driver_unconnected(mysql =>
            least => sub {
                sub {
                    my $fields = join ', ', @_;
                    [ "LEAST( $fields )" ];
                }
            }
        );
    }

    return $d;
}

sub _helper
{   my ($self, $type, @things) = @_;

    $type eq 'concat' || $type eq 'least'
        or panic "Invalid type $type";

    my $storage = $self->result_source->storage;
    $storage->ensure_connected;

    my $d = _introspector();

    @things = map { _flatten_thing $self, $_ } @things;

    return \(
        $d->get($storage->dbh, undef, $type)->(
            @things
        )
    );
}

sub helper_concat
{   my $self = shift;
    $self->_helper('concat', @_);
}

sub helper_least
{   my $self = shift;
    $self->_helper('least', @_);
}

1;
{'fraction_non_alphanumeric': 0.1502534395365677, 'fraction_numerical': 0.005430847212165098, 'mean_word_length': 1.8059928897917725, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 65, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5077407', 'n_tokens_mistral': 1834, 'n_tokens_neox': 1711, 'n_words': 452}