UR::BoolExpr::Util - Non-OO module to collect utility functions used by the BoolExpr modules


UR documentation Contained in the UR distribution.

Index


Code Index:

NAME

Top

UR::BoolExpr::Util - Non-OO module to collect utility functions used by the BoolExpr modules


UR documentation Contained in the UR distribution.

package UR::BoolExpr::Util;

# Non-OO Utility methods for the rule modules.

use strict;
use warnings;

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

# Because the id is actually a full data structure we need some separators.
# Note that these are used for the common case, where FreezeThaw is for arbitrarily complicated rule identifiers.

our $id_sep = chr(29);          # spearetes id property values instead of the old \t
our $record_sep = chr(30);      # within an property value, delimits a distinct values
our $unit_sep = chr(31);        # seperates items within a single value

our $null_value = chr(21);      # used for undef/null
our $empty_string = chr(28);    # used for ""
our $empty_list = chr(20);      # used for []

# These are used when there is any sort of complicated data in the rule.

sub values_to_value_id_frozen {
    my $self = shift;
    my $frozen = FreezeThaw::safeFreeze(@_);
    return "F:" . $frozen;
}

sub value_id_to_values_frozen {
    my $self = shift;
    my $value_id = shift;
    return FreezeThaw::thaw($value_id);
}

# These are used for the simple common-case rules.

sub values_to_value_id {
    my $self = shift;
    my $value_id = "";

    for my $value (@_) {

        if (not defined $value ) {
            $value_id .= $null_value . $record_sep;
        }
        elsif ($value eq "") {
            $value_id .= $empty_string . $record_sep;
        }
        elsif (ref($value) eq "ARRAY") {            
            if (@$value == 0) {
                $value_id .= $empty_list;
            }
            else {
                for my $value2 (@$value) {
                    if (not defined $value2 ) {
                        $value_id .= $null_value . $unit_sep;
                    }
                    elsif ($value2 eq "") {
                        $value_id .= $empty_string . $unit_sep;
                    }
                    else {
                        if (ref($value2) or $value2 =~ m/($unit_sep|$record_sep)/) {
                            return $self->values_to_value_id_frozen(@_);
                        }
                        $value_id .= $value2 . $unit_sep;
                    }                
                }
            }
            $value_id .= $record_sep;
        }
        else {
            #if ($value =~ m/($unit_sep|$record_sep)/o) {
            if (ref($value) or index($value,$unit_sep) >= 0 or index($value,$record_sep) >= 0) { 
                return $self->values_to_value_id_frozen(@_);
            }
            $value_id .= $value . $record_sep;
        }        
    }
    return "O:" . $value_id;
}

sub value_id_to_values {
    my $self = shift;
    my $value_id = shift;

    unless (defined $value_id) {
        Carp::confess();
    }

    my $method_identifier = substr($value_id,0,2);
    $value_id = substr($value_id, 2, length($value_id)-2);    
    if ($method_identifier eq "F:") {
        return $self->value_id_to_values_frozen($value_id);
    }

    my @values = ($value_id =~ /(.*?)$record_sep/gs);
    for (@values) {
        if (substr($_,-1) eq $unit_sep) {
            #$_ = [split($unit_sep,$_)]
            my @values2 = /(.*?)$unit_sep/gs;
            $_ = \@values2;
            for (@values2) {
                if ($_ eq $null_value) {
                    $_ = undef;
                }
                elsif ($_ eq $empty_string) {
                    $_ = "";
                }
            }            
        }
        elsif ($_ eq $null_value) {
            $_ = undef;
        }
        elsif ($_ eq $empty_string) {
            $_ = "";
        }
        elsif ($_ eq $empty_list) {
            $_ = [];
        }
    }
    return @values;
}


1;