#------------------------------------------------------------------------------
#$Author: andrius $
#$Date: 2020-01-07 07:54:59 -0500 (Tue, 07 Jan 2020) $ 
#$Revision: 5482 $
#$URL: svn://saulius-grazulis.lt/restful/tags/v0.15.2/lib/Database/Order.pm $
#------------------------------------------------------------------------------
#*
#  An object to encapsulate a table order.
#**

package Database::Order;

use strict;
use warnings;
use List::Util qw(any);

#=======================================================================
# Constructors

sub new
{
    my( $class, @order ) = @_;
    return bless [ map { ref $_ eq 'HASH' ? $_ :
                         { table  => $_->[0],
                           column => $_->[1],
                           order  => $_->[2] } } @order ],
                 $class;
}

## @function new_from_string ($order_string)
# Builds data structure describing the required ordering of the results.
# @param order_string serialised order information
# @retval order =
# \code{Perl}
# $order = [
#   { table => 'table1', column => 'column1', order => 'a' },
#   { table => 'table1', column => 'column2', order => 'd' },
#   ...
# ]
# \endcode
sub new_from_string
{
    my( $class, $order_string, $main_table ) = @_;
    my $self = [];
    return bless $self, $class if !$order_string;

    for my $clause (split /,/, $order_string) {
        my( $table_column, $order ) = split /:/, $clause;
        my( $column, $table ) = reverse split /\./, $table_column;
        if( !defined $table ) {
            # Columns are not prefixed by table names
            die "Cannot order by column '$column': table of its origin " .
                'is not known' if !defined $main_table;

            $table = $main_table;
        }
        push @$self, { table  => $table,
                       column => $column,
                       order  => $order };
    }

    return bless $self, $class;
}

# Produce a sub-order for a specific table
sub order_for_table
{
    my( $self, $table ) = @_;
    return bless [ grep { $_->{table} eq $table } @$self ];
}

#=======================================================================
# Methods

## @method order_clause ($order, $delim)
# Generate an "ORDER BY" SQL clause for all ordered tables
sub order_clause
{
    my( $self, $delim ) = @_;

    return '' if !@$self;
    $delim = '' unless $delim;

    return 'ORDER BY ' .
           join ', ', map { $delim . $_->{table} . $delim . '.' .
                            $delim . $_->{column} . $delim .
                            ' ' . (!defined $_->{order} ? '' :
                                   $_->{order} eq 'a' ? 'ASC'  :
                                   $_->{order} eq 'd' ? 'DESC' : '') }
                          @$self;
}

sub query_string
{
    my( $self ) = @_;
    return join ',', map { "$_->{table}.$_->{column}" .
                           (defined $_->{order} ? ":$_->{order}" : '') }
                         @$self;
}

## @function column_is_selected ($dbcolumn, $order, $letter)
# Returns 1 if table column is selected for sorting.
sub column_is_selected
{
    my( $self, $table, $column, $letter ) = @_;
    return any { $_->{table} eq $table &&
                 $_->{column} eq $column &&
                 defined $_->{order} &&
                 $_->{order} eq $letter } @$self;
}

# @method column_is_ordered
# Returns 1 if table column is used for sorting.
sub column_is_ordered
{
    my( $self, $table, $column ) = @_;
    return any { $_->{table} eq $table &&
                 $_->{column} eq $column } @$self;
}

sub order_ascending
{
    my( $self, $table, $column ) = @_;
    my( $position ) = grep { $_->{table} eq $table &&
                             $_->{column} eq $column } @$self;
    if( $position ) {
        $position->{order} = 'a';
    } else {
        push @$self, { table => $table, column => $column, order => 'a' };
    }
}

sub order_descending
{
    my( $self, $table, $column ) = @_;
    my( $position ) = grep { $_->{table} eq $table &&
                             $_->{column} eq $column } @$self;
    if( $position ) {
        $position->{order} = 'd';
    } else {
        push @$self, { table => $table, column => $column, order => 'd' };
    }
}

sub unorder
{
    my( $self, $table, $column ) = @_;
    @$self = grep { $_->{table} ne $table ||
                    $_->{column} ne $column } @$self;
}

1;
