File Coverage

blib/lib/SQL/OrderBy.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	39	44	88.6
condition	10	12	83.3
subroutine	7	7	100.0
pod	4	4	100.0
total	113	120	94.1

package SQL::OrderBy;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Transform an SQL "order by" clause

use strict;
use warnings;

our $VERSION = '0.1000';

# Transform an order by clause.
sub toggle_resort {
    my %args = @_;

    # Set the column name list and the directions.
    my ($columns, $direction, $asc_desc) = get_columns(
        %args,
        name_direction => 1,
        numeric_direction => 1,
    );

    # Handle a selected column.
    if (my $name = $args{selected}) {
        ($name, $direction, $asc_desc) = _name_direction(
            $name, $direction, $asc_desc
        );

        # Toggle if the selected column was already the first one.
         if ($columns && @$columns && $name eq $columns->[0]) {
             $direction->{$name} = $direction->{$name} + 0 ? 0 : 1;
         }

        # Remove the selected column name from its old position.
        @$columns = grep { $_ ne $name } @$columns;
        # And add the selected column name to the beginning.
        unshift @$columns, $name;
    }

    # Convert from numeric, if asked to.
    %$direction = to_asc_desc ($direction, %args)
        unless $args{numeric_direction};

    # Fetch our "name direction" array.
    @$columns = col_dir_list ($columns, $direction);

    # Return the column ordering as an arrayref or string.
    return wantarray ? @$columns : join ', ', @$columns;
}

# Return the column names and directions as either hash/array
# references, or a column array, or an "order by" clause.
sub get_columns {
    my %args = @_;

    # Set the order array from the order_by argument.
    my @order;
    if (ref $args{order_by} eq 'ARRAY') {
        @order = @{ $args{order_by} };
#        warn "Empty order list provided." unless @order;
    }
    else {
        if ($args{order_by}) {
            # Strip off any unneeded SQL clauses.
            $args{order_by} =~ s/^.*?\border by\s+(.*)$/$1/i;
            # Split the order clause.
            @order = split /\s*,\s*/, $args{order_by};
        }
        else {
            @order = ();
#            warn "No statement or clause provided.\n" unless $args{order_by};
        }
    }

    # Hold column names and directions.
    my ($columns, $direction, $asc_desc);

    # Set the column array and direction hashes.
    for (@order) {
        (my $name, $direction, $asc_desc) = _name_direction(
            $_, $direction, $asc_desc
        );

        # Add the column to our columns array.
        push @$columns, $name;
    }

    # Make alpha directions if asked to.
    %$direction = to_asc_desc ($asc_desc, %args)
        unless $args{numeric_direction};

    # NOTE: name_direction only makes sense in an array context.
    if ($args{name_direction}) {
        $columns = [ $columns, $direction, $asc_desc ];
    }
    else {
        @$columns = col_dir_list ($columns, $direction);
    }

    return wantarray ? @$columns : join ', ', @$columns;
}

# Return an array of column names with their respective directions
# concatenated.  This is conditional concatenation.  ASC/DESC vs.
# 1/0 issues do not concern us here.
sub col_dir_list {
    my ($columns, $direction) = @_;
    return map {
        $direction->{$_}
            ? "$_ $direction->{$_}"
            : $_
    } @$columns;
}

# Return alpha directions in place of numeric eqivalents.
sub to_asc_desc {
    my $dir = shift;
    my %args = @_;

    # Set default direction strings.
    my ($asc, $desc) = $args{uc_direction}
        ? ('ASC', 'DESC') : ('asc', 'desc');

    # Replace directions with "proper" values.
    for (keys %$dir) {
        # From numeric
        if (defined $dir->{$_} && $dir->{$_} =~ /^\d+$/) {
            $dir->{$_} = $dir->{$_}
                ? $args{show_ascending} ? $asc : ''
                : $desc;
        }
        # Use existing if present, ascend otherwise.
        else {
            $dir->{$_} = $dir->{$_}
                ? lc ($dir->{$_}) eq 'desc'
                    ? $dir->{$_}
                    : $args{show_ascending} ? $dir->{$_} : ''
                : $args{show_ascending} ? $asc : ''
        }
    }

    return %$dir;
}

sub _name_direction {
    my ($col, $direction, $asc_desc) = @_;

    if ($col =~ /^(.*?)(?:\s+(asc|desc))?$/i) {
        # Use the direction provided; Ascend by default.
        ($col, my $dir) = ($1, $2);
        # Set the numeric directions.
        $direction->{$col} = $dir && lc ($dir) eq 'desc' ? 0 : 1;
        # Set the case sensitive alpha directions.
        $asc_desc->{$col} = $dir ? $dir : '';
    }

    return $col, $direction, $asc_desc;
}

1;

__END__