File Coverage

blib/lib/OData/QueryParams/DBIC.pm

Criterion	Covered	Total	%
statement	128	128	100.0
branch	36	36	100.0
condition	17	20	85.0
subroutine	19	19	100.0
pod	1	1	100.0
total	201	204	98.5

package OData::QueryParams::DBIC;

# ABSTRACT: parse OData style query params and provide info for DBIC queries.

use v5.20;

use strict;
use warnings;

use feature 'signatures';
no warnings 'experimental::signatures';

use parent 'Exporter';

use Carp qw(croak);
use Mojo::Parameters;
use OData::QueryParams::DBIC::FilterUtils qw(parser);
use List::Util qw(any);
use Scalar::Util qw(blessed);

our @EXPORT = qw(params_to_dbic);

our $VERSION = '0.07';

sub params_to_dbic ( $query_string, %opts ) {
    my $query;

    if ( blessed $query_string ) {
        if ( $query_string->isa('Mojo::Parameters') ) {
            $query = $query_string
        }
        else {
            croak 'Invalid object';
        }
    }
    else {
        $query = Mojo::Parameters->new( $query_string );
    }

    my $params = $query->to_hash;

    my $filter_key = $opts{strict} ? '$filter' : 'filter';
    my %filter = _parse_filter( delete $params->{$filter_key}, %opts );

    my %dbic_opts;

    PARAM_KEY:
    for my $param_key ( keys %{ $params } ) {
        my $method = $param_key =~ s{\A\$}{}r;

        next PARAM_KEY if $opts{strict} && $param_key !~ m{\A\$}xms;

        my $sub = __PACKAGE__->can( '_parse_' . $method );
        if ( $sub ) {
            my %key_opts = $sub->( $params->{$param_key} );
            %dbic_opts = (%dbic_opts, %key_opts);
        }
    }

    return \%filter, \%dbic_opts;
}

sub _parse_top ( $top_data ) {
    return if $top_data !~ m{\A[0-9]+\z};
    return ( rows => $top_data );
}

sub _parse_skip ( $skip_data ) {
    return if $skip_data !~ m{\A[0-9]+\z};
    return ( page => $skip_data + 1 );
}

sub _parse_filter ( $filter_data, %opt ) {
    return if !defined $filter_data;
    return if $filter_data eq '';

    my $obj    = parser->( $filter_data );
    my %filter = _flatten_filter( $obj, %opt );

    return %filter;
}

sub _parse_orderby ( $orderby_data ) {
    my @order_bys = split /\s*,\s*/, $orderby_data;

    my @dbic_order_by;

    for my $order_by ( @order_bys ) {
        my $direction;
        $order_by =~ s{\s+(.*?)\z}{$1 && (lc $1 eq 'desc' || lc $1 eq 'asc') && ( $direction = lc $1 ); ''}e;

        $direction //= 'asc';

        push @dbic_order_by, { -$direction => $order_by };
    }

    return order_by => \@dbic_order_by;
}

sub _parse_select ( $select_data ) {
    return if !length $select_data;
    return columns => [ split /\s*,\s*/, $select_data ];
}

sub _flatten_filter ($obj, %opt) {
    my %map = (
        'lt'  => '<',
        'le'  => '<=',
        'gt'  => '>',
        'ge'  => '>=',
        'eq'  => '==',
        'ne'  => '!=',
        'and' => \&_build_bool,
        'or'  => \&_build_bool,
    );

    my $op = $obj->{operator};

    croak 'Unknown op' if !defined $op;

    my %filter;

    if ( !exists $map{$op} ) {
        croak 'Unsupported op: ' . $op;
    }
    else {
        my $rule    = $map{$op};
        my $subject = $obj->{subject};
        my $value   = $obj->{value};

        if ( !defined $subject ) {
            croak 'Unsupported expression';
        }
        elsif ( ref $rule ) {
            my ($filter_key, $filter_value) = $rule->($obj, %opt);
            $filter{$filter_key}            = $filter_value;
        }
        else {
            if ( ref $subject ) {
                croak 'Complex expressions on the left side are not supported (yet)';
            }

            if ( $value =~ m{\A'(.*)'\z} ) {
                $value = $1;
            }

            my $is_field         = $obj->{sub_type} && $obj->{sub_type} eq 'field';
            my $is_foreign_field = $subject =~ m{\A\w+\/};

            if ( $opt{me} && $is_field && !$is_foreign_field ) {
                $subject = 'me.' . $subject;
            }

            $subject =~ s{\A\w+\K/}{.};

            $filter{ $subject } = {
                $rule => $value,
            };
        }
    }

    return %filter;
}

sub _build_bool ($obj, %opt) {
    my $op      = $obj->{operator};
    my $subject = $obj->{subject};
    my $value   = $obj->{value};

    return "-$op" => [
        { _flatten_filter( $subject, %opt ) },
        { _flatten_filter( $value, %opt ) },
    ];
}

1;

__END__