UR::BoolExpr::Template - an UR::BoolExpr minus specific values


UR documentation Contained in the UR distribution.

Index


Code Index:

NAME

Top

UR::BoolExpr::Template - an UR::BoolExpr minus specific values

SYNOPSIS

Top

DESCRIPTION

Top


UR documentation Contained in the UR distribution.

package UR::BoolExpr::Template;

use warnings;
use strict;

use Scalar::Util qw(blessed);
use Data::Dumper;
use UR;

UR::Object::Type->define(
    class_name  => __PACKAGE__, 
    is_transactional => 0,
    composite_id_separator => '/',
    id_by => [
        subject_class_name              => { is => 'Text' },
        logic_type                      => { is => 'Text' },
        logic_detail                    => { is => 'CSV' },
        constant_value_id               => { is => 'Text' }
    ],
    has => [
        is_normalized                   => { is => 'Boolean' },
        is_id_only                      => { is => 'Boolean' },
        is_partial_id                   => { is => 'Boolean' },  # True if at least 1, but not all the ID props are mentioned
        is_unique                       => { is => 'Boolean' },
        matches_all                     => { is => 'Boolean' },
        key_op_hash                     => { is => 'HASH' },
        num_values                      => { is => 'Integer' },
        id_position                     => { is => 'Integer' },
        normalized_id                   => { is => 'Text' },        
        normalized_positions_arrayref   => { is => 'ARRAY' },        
        normalization_extender_arrayref => { is => 'ARRAY' },
        _property_meta_hash             => { is => 'HASH' },
        _property_names_arrayref        => { is => 'ARRAY' },
    ],
    has_optional => [
        hints                           => { is => 'ARRAY' },
        recursion_desc                  => { is => 'ARRAY' },
        is_paged                        => { is => "Boolean" },  # FIXME - this isn't set by anything below, shouldn't it be 'page'?
        order_by                        => { is => 'ARRAY' },
        group_by                        => { is => 'ARRAY' },
    ]
);

our $VERSION = $UR::VERSION;;

# Borrow from the util package.
# This will go away with refactoring.

our $id_sep         = $UR::BoolExpr::Util::id_sep;
our $record_sep     = $UR::BoolExpr::Util::record_sep;
our $unit_sep       = $UR::BoolExpr::Util::unit_sep;
our $null_value     = $UR::BoolExpr::Util::null_value;
our $empty_string   = $UR::BoolExpr::Util::empty_string;
our $empty_list     = $UR::BoolExpr::Util::empty_list;

# Names of the optional flags you can add to a rule
our @meta_param_names = qw(recursion_desc hints is_paged order_by group_by);

# Wrappers for regular properties

sub _property_names {
    return @{ $_[0]->{_property_names_arrayref} };
}

sub _constant_values {
    my $self = shift;
    if (@_) {
        $self->constant_value_id(UR::BoolExpr::Util->values_to_value_id(@_));
    }
    my $constant_value_id = $self->constant_value_id;
    return unless $constant_value_id;
    return UR::BoolExpr::Util->value_id_to_values($constant_value_id);
}


# This is set lazily currently

sub is_unique {
    my $self = $_[0];
    if (defined $self->{is_unique}) {
        return $self->{is_unique}
    }

    # since this requires normalization, we don't set the value at construction time
    my $normalized_self;
    if ($self->is_normalized) {
        $normalized_self = $self;
    }
    else {
        $normalized_self = $self->get_normalized_template_equivalent($self);
    }

    my $op = $normalized_self->operator_for('id');
    if (defined($op) and ($op eq '' or $op eq '=')) {
        return $self->{is_unique} = 1;
    }
    else {
        $self->{is_unique} = 0;
        
        # if some combination of params can combine to
        # satisfy at least one unique constraint,
        # then we have uniqueness in the parameters.

        if (my @ps = $self->subject_class_name->__meta__->unique_property_sets) {  
            my $property_meta_hash = $self->_property_meta_hash;      
            for my $property_set (@ps) 
            {
                my $property_set = (ref($property_set) ? $property_set : [$property_set]);
                my @properties_used_from_constraint =  
                    grep { defined($_) } 
                    (ref($property_set) ? @$property_meta_hash{@$property_set} : $property_meta_hash->{$property_set});
                    
                if (@properties_used_from_constraint == @$property_set) {
                    # filter imprecise operators
                    @properties_used_from_constraint = 
                        grep {  
                            $_->{operator} !~ /^(not |)like(-.|)$/i
                            and
                            $_->{operator} ne '[]'
                            and
                            $_->{operator} !~ /^(not |)in/i
                        }                                              
                        @properties_used_from_constraint;
                        
                    if (@properties_used_from_constraint == @$property_set) {
                        $self->{is_unique} = 1;
                        last;
                    }
                    else {
                        ## print "some properties use bad operators: @properties_used_from_constraint\n";
                    }
                }
                else {
                    ## print "too few properties in @properties_used_from_constraint\n";
                }
            }
        }

        return $self->{is_unique};
    }
}


# Derivative of the ID. 

sub rule_template_subclass_name {    
    return "UR::BoolExpr::Template::" . shift->logic_type;
}

sub get_normalized_template_equivalent {
    UR::BoolExpr::Template->get($_[0]->{normalized_id});
}

sub get_rule_for_values {
    my $self = shift;
    my $value_id = UR::BoolExpr::Util->values_to_value_id(@_);    
    my $rule_id = UR::BoolExpr->__meta__->resolve_composite_id_from_ordered_values($self->id,$value_id);
    return UR::BoolExpr->get($rule_id);
}

sub get_normalized_rule_for_values {
    my $self = shift;
    my @unnormalized_values = @_;

    if ($self->is_normalized) {
        return $self->get_rule_for_values(@unnormalized_values);
    }

    my $normalized_rule_template = $self->get_normalized_template_equivalent;

    # The normalized rule set may have more values than were actually
    # passed-in.  These 'extenders' will add to the @values array
    # before re-ordering it.
    my $extenders = $self->normalization_extender_arrayref;
    if (@$extenders) {
        my $subject_class = $self->subject_class_name->__meta__;
        for my $extender (@$extenders) {
            my ($input_positions_arrayref,$subref) = @$extender;
            my @more_values = @unnormalized_values[@$input_positions_arrayref];            
            if ($subref) {
                ## print "calling $subref on \n\t" . join("\n\t",@more_values) . "\n";
                @more_values = $subject_class->$subref(@more_values);
                ## print "got: \n\t" . join("\n\t",@more_values) . "\n";
            }
            push @unnormalized_values, @more_values;
        }
    }
    
    # Normalize the values.  Since the normalized template may have added properties, 
    # and a different order we may need to re-order and expand the values list.
    my $normalized_positions_arrayref = $self->normalized_positions_arrayref;
    my @normalized_values = @unnormalized_values[@$normalized_positions_arrayref];

    my $rule = $normalized_rule_template->get_rule_for_values(@normalized_values);
    return $rule;
}


sub value_position_for_property_name {
    if (exists $_[0]{_property_meta_hash}{$_[1]}) {
        return $_[0]{_property_meta_hash}{$_[1]}{value_position};
    } else {
        return undef;
    }
}

sub operator_for {
    if (exists $_[0]{_property_meta_hash}{$_[1]}) {
        return $_[0]{_property_meta_hash}{$_[1]}{operator} || '=';
    } else {
        return undef;
    }
}

sub add_filter {
    my $self = shift;
    my $property_name = shift;
    my $op = shift;    
    my $new_key = $property_name;
    $new_key .= ' ' . $op if defined $op;    
    my ($subject_class_name, $logic_type, $logic_detail) = split("/",$self->id);
    unless ($logic_type eq 'And') {
        die "Attempt to add a filter to a rule besides an 'And' rule!";
    }
    my @keys = split(',',$logic_detail);
    my $new_id = join('/',$subject_class_name,$logic_type,join(',',@keys,$new_key));
    return $self->class->get($new_id);
}

sub remove_filter {
    my $self = shift;
    my $filter = shift;
    my ($subject_class_name, $logic_type, $logic_detail) = split("/",$self->id);
    my @keys = grep { $_ !~ /^${filter}\b/ } split(',',$logic_detail);
    my $new_id = join('/',$subject_class_name,$logic_type,join(',',@keys));
    #print "$new_id\n";
    return $self->class->get($new_id);
}

sub sub_classify {
    my ($self,$subclass_name) = @_;
    my $new_id = $self->id;
    $new_id =~ s/^.*?\//$subclass_name\//;
    return $self->class->get($new_id);    
}


# flyweight constructor
# NOTE: this caches outside of the regular system since these are stateless objects

sub get_by_subject_class_name_logic_type_and_logic_detail {
    my $class = shift;
    my $subject_class_name = shift;
    my $logic_type = shift;
    my $logic_detail = shift;
    my $constant_value_id = UR::BoolExpr::Util->values_to_value_id(); # intentionally an empty list of values
    return $class->get(join('/',$subject_class_name,$logic_type,$logic_detail,$constant_value_id));
}


# The analogue of resolve in UR::BoolExpr.  @params_list is a list if
# strings containing properties and operators separated by a space.  For ex: "some_param ="
sub resolve {
    my($class,$subject_class_name, @params_list) = @_;

    return $class->get_by_subject_class_name_logic_type_and_logic_detail($subject_class_name, "And", join(',',@params_list));
}

    

sub get {
    my $class = shift;
    my $id = shift;    
    die "Non-id params not supported for " . __PACKAGE__ . " yet!" if @_;

    # get if possible
    my $self = $UR::Object::rule_templates->{$id};
    return $self if $self;     

    my ($subject_class_name,$logic_type,$logic_detail,$constant_value_id,@extra) = split('/',$id);  
    if (@extra) {
        # account for a possible slash in the constant value id
        $constant_value_id = join('/',$constant_value_id,@extra);
    }

    my $sub_class_name = (
        $class eq __PACKAGE__ 
            ? __PACKAGE__ . "::" . $logic_type
            : $class    
    );

    unless ($logic_type) {
        Carp::confess($id);
    }

    my @constant_values;
    @constant_values = UR::BoolExpr::Util->value_id_to_values($constant_value_id) if defined $constant_value_id;;

    my $subject_class_meta = $subject_class_name->__meta__;

    my @extra_params;
    if ($logic_type eq "And") {
        # TODO: move into subclass
        my (@keys, $num_values);
            
        @keys = split(',',$logic_detail || '');
        $num_values = scalar(@keys);
    
        # See what properties are id-related for the class
        my $id_related = $UR::Object::id_related{$subject_class_name};
        my $id_pos = $UR::Object::id_pos{$subject_class_name};
        my $id_translations = $UR::Object::id_translations{$subject_class_name};    
        
        unless ($id_related) {
            $id_related = {};
            $id_translations = [];
            $id_pos = {};
            for my $iclass ($subject_class_name, $subject_class_meta->ancestry_class_names) {
                last if $iclass eq "UR::Object";
                next unless $iclass->isa("UR::Object");
                my $iclass_meta = $iclass->__meta__;
                my @id_props = $iclass_meta->id_property_names;
                next unless @id_props;
                next if @id_props == 1 and $id_props[0] eq "id";
                push @$id_translations, \@id_props;
                @$id_related{@id_props} = @id_props;
                @$id_pos{@id_props} = (0..$#id_props);
            }
            $UR::Object::id_related{$subject_class_name} = $id_related;
            $UR::Object::id_translations{$subject_class_name} = $id_translations;
            $UR::Object::id_pos{$subject_class_name} = $id_pos;
        }
        
        # Make a hash to quick-validate the params for duplication
        no warnings; 
        my %check_for_duplicate_rules;
        for (my $n=0; $n < @keys; $n++) {
            my ($property,$op) = ($keys[$n] =~ /^(\w+)\b(.*)$/);
            $check_for_duplicate_rules{$property}++;
        }

        my $id_position = undef;
        my $var_pos = 0;
        my $const_pos = 0;
        my $property_meta_hash = {};        
        my $property_names = [];
        for my $key (@keys) {
            if ($key =~ /^id\b/) {
                $id_position = $var_pos;
            }
            if (substr($key,0,1) eq '-') {
                $property_meta_hash->{$key} = {
                    name => $key,
                    value_position => $const_pos
                };
                $const_pos++;
            }
            else {
                my ($name, $op) = ($key =~ /^(.+?)\b\s*(.*)$/);
                $property_meta_hash->{$name} = {
                    name => $name,
                    operator => $op,
                    value_position => $var_pos
                };        
                $var_pos++;
                push @$property_names, $name;
            }
    
        }

    
        # Add value extenders for any cases of id-related properties,
        # or aliases.
        my $extenders = [];    
        my $template_id;    
        
        # Note whether there are properties not involved in the ID
        my $id_only = 1;
        my $partial_id = 0;
        
        my $key_op_hash = {};
        if (@$id_translations and @{$id_translations->[0]} == 1) {
            # single-property ID
            ## use Data::Dumper;
            ## print "single property id\n". Dumper($id_translations);
            my ($key_pos,$key,$property,$op,$x);
            my $original_key_count = @keys;
    
            # Presume we are only getting id properties until another is found.
            # If a multi-property is partially specified, we'll zero this out too.
            
            for ($key_pos = 0; $key_pos < $original_key_count; $key_pos++) {
                $key = $keys[$key_pos];
    
                ($property,$op) = ($key =~ /^(\w+)\b(.*)$/);  # /^(\w+)\b\S*(.*)$/
                $op ||= "";
                $op =~ s/\s+//;
                $key_op_hash->{$property} ||= {};
                $key_op_hash->{$property}{$op}++;
                
                ## print "> $key_pos- $key: $property/$op\n";
                if ($property eq "id" or $id_related->{$property}) {
                    # Put an id key into the key list.
                    for my $alias (["id"], @$id_translations) {
                        next if $alias->[0] eq $property;
                        next if $check_for_duplicate_rules{$alias->[0]};
                        $op ||= "";
                        push @keys, $alias->[0] . ($op ? " $op" : ""); 
                        push @$extenders, [ [$key_pos], undef ];
                        $key_op_hash->{$alias->[0]} ||= {};
                        $key_op_hash->{$alias->[0]}{$op}++;
                        ## print ">> extend for @$alias with op $op.\n";
                    }
                    unless ($op =~ m/^(=|eq|in|\[\]|)$/) {
                        $id_only = 0;
                    }
                }    
                else {
                    $id_only = 0;
                    ## print "non id single property $property on $subject_class\n";
                }
            }            
        }
        else {
            # multi-property ID
            ## print "multi property id\n". Dumper($id_translations);
            my ($key_pos,$key,$property,$op);
            my $original_key_count = @keys;
            my %id_parts;
            for ($key_pos = 0; $key_pos < $original_key_count; $key_pos++) {
                $key = $keys[$key_pos];                
                ($property,$op) = ($key =~ /^(\w+)\b(.*)$/);  # /^(\w+)\b\S*(.*)$/
                $op ||= "";
                $op =~ s/\s+//;                
                $key_op_hash->{$property} ||= {};
                $key_op_hash->{$property}{$op}++;
                
                ## print "> $key_pos- $key: $property/$op\n";
                if ($property eq "id") {
                    $key_op_hash->{id} ||= {};
                    $key_op_hash->{id}{$op}++;                    
                    # Put an id-breakdown key into the key list.
                    for my $alias (@$id_translations) {
                        my @new_keys = map {  $_ . ($op ? " $op" : "") } @$alias; 
                        if (grep { $check_for_duplicate_rules{$_} } @new_keys) {
                            #print "up @new_keys with @$alias\n";
                        }
                        else {
                            push @keys, @new_keys; 
                            push @$extenders, [ [$key_pos], "resolve_ordered_values_from_composite_id" ];
                            for (@$alias) {
                                $key_op_hash->{$_} ||= {};
                                $key_op_hash->{$_}{$op}++;
                            }
                            # print ">> extend for @$alias with op $op.\n";
                        }
                    }
                }    
                elsif ($id_related->{$property}) {
                    #if ($op eq "" or $op eq "eq" or $op eq "=" or $op eq '[]') {
                    if ($op eq "" or $op eq "eq" or $op eq "=") {
                        $id_parts{$id_pos->{$property}} = $key_pos;                        
                    }
                    else {
                        # We're doing some sort of gray-area comparison on an ID                        
                        # field, and though we could possibly resolve an ID
                        # from things like an [] op, it's more than we've done
                        # before.
                        $id_only = 0;
                    }
                }
                else {
                    ## print "non id multi property $property on class $subject_class\n";
                    $id_only = 0;
                }
            }            
            
            if (my $parts = (scalar(keys(%id_parts)))) {
                # some parts are id-related                
                if ($parts ==  @{$id_translations->[0]}) { 
                    # all parts are of the id are there 
                    if (@$id_translations) {
                        if (grep { $_ eq 'id' } @keys) {
                            #print "found id already\n";
                        }
                        else {
                            #print "no id\n";
                            # we have translations of that ID into underlying properties
                            #print "ADDING ID for " . join(",",keys %id_parts) . "\n";
                            my @id_pos = sort { $a <=> $b } keys %id_parts;
                            push @$extenders, [ [@id_parts{@id_pos}], "resolve_composite_id_from_ordered_values" ]; #TODO was this correct?
                            $key_op_hash->{id} ||= {};
                            $key_op_hash->{id}{$op}++;                        
                            push @keys, "id"; 
                        }   
                    }
                }
                else {
                    # not all parts of the id are there
                    ## print "partial id property $property on class $subject_class\n";
                    $id_only = 0;
                    $partial_id = 1;
                }
            }
        }
        
        # Determine the positions of each key in the parameter list.                        
        my %key_positions;
        my $pos = 0;
        for my $key (@keys) {
            next if substr($key,0,1) eq '-';
            $key_positions{$key} ||= [];
            push @{ $key_positions{$key} }, $pos++;    
        }
    
        # Sort the keys, and make an arrayref which will 
        # re-order the values to match.
        my @keys_sorted = sort @keys;
        my $matches_all = scalar(@keys_sorted) == 0 ? 1 : 0;
        my $normalized_positions_arrayref = [];
        my $constant_value_normalized_positions = [];
        my $recursion_desc = undef;
        my $hints = undef;
        my $order_by = undef;
        my $group_by = undef;
        my $page = undef;
        for my $key (@keys_sorted) {
            my $pos_list = $key_positions{$key};
            my $pos = shift @$pos_list;
            if (substr($key,0,1) eq '-') {
                push @$constant_value_normalized_positions, $pos;
                if ($key eq '-recurse') {
                    $recursion_desc = shift @constant_values;
                }
                elsif ($key eq '-hint' or $key eq '-hints') {
                    $hints = shift @constant_values; 
                }
                elsif ($key eq '-order' or $key eq '-order_by') {
                    $order_by = shift @constant_values;
                }
                elsif ($key eq '-group_by') {
                    $group_by = shift @constant_values;
                }
                elsif ($key eq '-page') {
                    $page = shift @constant_values;
                }
                else {
                    die "Unknown special param $key.  Expected one of: @meta_param_names";
                }
            }
            else {
                push @$normalized_positions_arrayref, $pos;
            }
        }

        $id_only = 0 if ($matches_all);
    
        #if (@$constant_value_normalized_positions > 1) {
        #    Carp::confess("Not Implemented: multiple '-' options.  Fix me!");
        #}
        
        # Determine the rule template's ID.
        # The normalizer will store this.  Below, we'll
        # find or create the template for this ID.
        my $normalized_id = UR::BoolExpr::Template->__meta__->resolve_composite_id_from_ordered_values($subject_class_name, "And", join(",",@keys_sorted), $constant_value_id);
        
        @extra_params = (
            id_position                     => $id_position,        
            is_id_only                      => $id_only,
            is_partial_id                   => $partial_id,
            is_unique                       => undef, # assigned on first use
            matches_all                     => $matches_all,
    
            key_op_hash                     => $key_op_hash,
            num_values                      => $num_values,
            _property_names_arrayref        => $property_names,
            _property_meta_hash             => $property_meta_hash,
    
            recursion_desc                  => $recursion_desc,
            hints                           => $hints,
            order_by                        => $order_by,
            page                            => $page,
            group_by                        => $group_by,
    
            is_normalized                   => ($id eq $normalized_id ? 1 : 0),
            normalized_id                   => $normalized_id,        
            normalized_positions_arrayref   => $normalized_positions_arrayref,
            normalization_extender_arrayref => $extenders,
        );
    } # done generating special data for the "And" rule to normalize itself
    else {
        @extra_params = (normalized_id => $id);
    }
    
    $self = bless {
        id                              => $id,
        subject_class_name              => $subject_class_name,
        logic_type                      => $logic_type,
        logic_detail                    => $logic_detail,
        constant_value_id               => $constant_value_id,
        @extra_params
    }, $sub_class_name;
    $UR::Object::rule_templates->{$id} = $self;  
    return $self;
}


# Return true if the template has recursion_desc, hints, order or page set
sub has_meta_options {
    my $self = shift;
    foreach my $opt ( @meta_param_names ) {
        return 1 if (defined $self->$opt);
    }
    return 0;
}


# This is the basis for the hash used by the existing UR::Object system for each rule.
# this is created upon first request and cached in the object

sub legacy_params_hash {
    my $self = shift;
    my $legacy_params_hash = $self->{legacy_params_hash};
    return $legacy_params_hash if $legacy_params_hash;
    
    $legacy_params_hash = {};    
    
    my $template_id = $self->id;
    my $key_op_hash = $self->key_op_hash;
    my $id_only = $self->is_id_only;    
        
    my $subject_class_name  = $self->subject_class_name;
    my $logic_type          = $self->logic_type;    
    my $logic_detail        = $self->logic_detail;    
    my @keys_sorted         = $self->_underlying_keys;
    
    my $subject_class_meta  = $subject_class_name->__meta__;
    
    if (
        (@keys_sorted and not $logic_detail)
        or
        ($logic_detail and not @keys_sorted)        
    ) {
        Carp::confess();
    }
    
    if (!$logic_detail) {
        %$legacy_params_hash = (_unique => 0, _none => 1);            
    }
    else {        
        # _id_only
        if ($id_only) {
            $legacy_params_hash->{_id_only} = 1;
        }
        else {
            $legacy_params_hash->{_id_only} = 0;
            $legacy_params_hash->{_param_key} = undef;
        }
        
        # _unique
        if (my $id_op = $key_op_hash->{id}) {
            if ($id_op->{""} or $id_op->{"="}) {
                $legacy_params_hash->{_unique} = 1;
                unless ($self->is_unique) {
                    warn "is_unique false unexpectedly for $self->{id}"
                }
            }
        }

                

        unless ($legacy_params_hash->{_unique}) {         
            if (defined $legacy_params_hash->{id} and not ref $legacy_params_hash->{id})
            {
                # if we have the id, then we have uniqueness
                $legacy_params_hash->{_unique} = 1;
            }
            else
            {
                # default to non-unique
                $legacy_params_hash->{_unique} = 0;   
               
                # if some combination of params can combine to
                # satisfy at least one unique constraint,
                # then we have uniqueness in the parameters.
                
                my @ps = $subject_class_meta->unique_property_sets;
                for my $property_set (@ps) 
                {                            
                    my $property_set = (ref($property_set) ? $property_set : [$property_set]);
                    my @properties_used_from_constraint =  
                        grep { defined($_) } 
                        (ref($property_set) ? @$key_op_hash{@$property_set} : $key_op_hash->{$property_set});
                        
                    if (@properties_used_from_constraint == @$property_set) {
                        # filter imprecise operators
                        @properties_used_from_constraint = 
                            grep {                                                
				                not (
                                    grep { /^(not |)like(-.|)$/i or /^\[\]/}
                                    keys %$_
                                )
                            }
                            @properties_used_from_constraint;
                            
                        if (@properties_used_from_constraint == @$property_set) {
                            $legacy_params_hash->{_unique} = 1;
                            last;
                        }
                        else {
                            ## print "some properties use bad operators: @properties_used_from_constraint\n";
                        }
                    }
                    else {
                        ## print "too few properties in @properties_used_from_constraint\n";
                    }
                }
            }
            
            # _param_key gets re-set as long as this has a true value
            $legacy_params_hash->{_param_key} = undef unless $id_only;
        }
    }

    if ($self->is_unique and not $legacy_params_hash->{_unique}) {
        warn "is_unique IS set but legacy params hash is NO for $self->{id}";
        $DB::single = 1;
        $self->is_unique; 
    }
    if (!$self->is_unique and $legacy_params_hash->{_unique}) {        
        warn "is_unique NOT set but legacy params hash IS for $self->{id}";
        $DB::single = 1;
        $self->is_unique; 
    }       

    $self->{legacy_params_hash} = $legacy_params_hash;
    return $legacy_params_hash;
}

sub sorter {
    my $self = shift;

    # return a standard sorter for expressions using this template
    # the template might contain a group_by or order_by clause which affects it...

    die "this method takes no paramters!" if @_;

    my $class = $self->subject_class_name;

    my $sort_meta;
    if ($self->group_by) {
        my $set_class = $class . "::Set";
        $sort_meta = $set_class->__meta__;
    }
    else {
        $sort_meta = $class->__meta__;
    }

    my $sorter;
    if (my $order_by = $self->order_by) {
        $sorter = $sort_meta->sorter(@$order_by);
    }
    else {
        $sorter = $sort_meta->sorter();
    }

    return $sorter;
}

1;