view release on metacpan or  search on metacpan

lib/DBIx/Class/Smooth/Functions.pm  view on Meta::CPAN

use 5.20.0;
use strict;
use warnings;

package DBIx::Class::Smooth::Functions;

# ABSTRACT: Specify columns
our $AUTHORITY = 'cpan:CSSON'; # AUTHORITY
our $VERSION = '0.0108';

use Carp qw/croak/;
use List::Util qw/uniq/;
use List::SomeUtils qw/any/;
use boolean;
use Ref::Util qw/is_scalarref is_refref is_arrayref/;
use Sub::Exporter::Progressive -setup => {
    exports => [qw/
        Ascii
        Bin
        Char
        CharLength
        Concat
        ConcatWS
        Elt
        ExportSet
        Hex
        Substring
    /]
};

use experimental qw/postderef signatures/;

sub first_is_voc($function_name, @params) {
    if (!scalar @params) {
        return { uc $function_name => undef };
    }
    my $first = shift @params;
    # If an inner call requires a rendered sql string, the outer call needs to do that as well
    if (is_refref $first && is_arrayref $$first) {
        my $inner_sql_string = $$first->[0];
        my $sql_string = $inner_sql_string . (scalar @params ? ', ' . join ', ' => @params : '');
        return \["@{[ uc $function_name ]}($sql_string)"];
    }
    # If you pass the $value_or_columnname as a string ref, then we render an sql string
    elsif (is_scalarref $first) {
        my $sql_string = "'$$first'" . (scalar @params ? ', ' . join ', ' => @params : '');
        return \["@{[ uc $function_name ]}($sql_string)"];
    }
    unshift @params => $first;
    return { uc $function_name => \@params };
}

sub all_is_voc($function_name, @params) {
    my $any_is_ref = scalar grep { is_scalarref $_ } @params;

    if ($any_is_ref) {
        my $sql_string = join ', ' => map { is_scalarref $_ ? "'$$_'" : $_ } @params;
        return \["@{[ uc $function_name ]}($sql_string)"];
    }
    else {
        return { uc $function_name => \@params };
    }
}

sub drop_last_if_undef(@params) {
    if (!defined $params[-1]) {
        pop @params;
    }
    return @params;
}

# $voc = Value or column name
sub Ascii($voc) { return first_is_voc ascii => $voc; }

sub Bin($voc) { return first_is_voc bin => $voc; }